6 people like it.

Simple typeclass implementation

I learned how to implement this by reading this great good project http://code.google.com/p/fsharp-typeclasses/ But I can't understand why the project needs ternary operator. I used binary operator and seems it's okay.

Monad

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
type Return() = 
    static member (?) (_:Return, _:'a option) = fun (x:'a) -> Some x
    static member (?) (_:Return, _:'a list)   = fun (x:'a) -> [x]
let inline return' x : ^R = Return() ? (Unchecked.defaultof< ^R>) x


type Bind() = 
    static member (?) (_:Bind, m:option<_>) = fun f -> Option.bind  f m
    static member (?) (_:Bind, m:list<_>  ) = fun f -> List.collect f m
let inline (>>=) m f : ^R = Bind() ? (m) f


type DoNotationBuilder() =
    member inline b.Return(x)    = return' x
    member inline b.Bind(p,rest) = p >>= rest
let do' = new DoNotationBuilder()


[4;5;6] >>= (fun x -> [x;x*10]) |> printfn "%A"
// [4; 40; 5; 50; 6; 60]
Some 7 >>= (fun x -> List.tryFind((=)x) [7;8;9]) |> printfn "%A"
// Some 7


do' {
  let! greeting = ["Good morning";"Good evening"]
  let! name = ["Alice";"Bob"]
  return printfn "%s, %s." greeting name
}
// Good morning, Alice.
// Good morning, Bob.
// Good evening, Alice.
// Good evening, Bob.


do' {
  let! id = Some "Carol123"
  let! password = Some "*****"
  return printfn "Hi, %s" id
}
// Hi, Carol123

Applicative

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
type Fmap() = 
  static member (?) (_:Fmap , m:_ option) = fun f -> Option.map f m
  static member (?) (_:Fmap , m:_ list)   = fun f -> List.map    f m
let inline (<%>) f x = Fmap() ? (x) f


type Ap() = 
  static member (?) (_:Ap , mf:_ option) = fun (m:_ option) -> 
    match mf , m with Some f , Some x -> Some (f x) | _ -> None
  static member (?) (_:Ap , mf:_ list)   = fun (m:_ list) -> 
    [ for f in mf do for x in m -> f x]
let inline (<*>) mf m = Ap() ? (mf) m


(+) <%> ["a";"b"] <*> ["x";"y";"z"]  |> printfn "%A"
// ["ax"; "ay"; "az"; "bx"; "by"; "bz"]

(fun a b c -> a + b + c) <%> [100;200] <*> [10;20] <*> [1;2] |> printfn "%A"
// [111; 112; 121; 122; 211; 212; 221; 222]

let a = (printf "%s, %s") <%> Some "hello" <*> Some "applicative"
// hello, applicative
Multiple items
type Return =
  new : unit -> Return
  static member ( ? ) : Return * 'a option -> ('a -> 'a option)
  static member ( ? ) : Return * 'a list -> ('a -> 'a list)

Full name: Script.Return

--------------------
new : unit -> Return
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>
val x : 'a
union case Option.Some: Value: 'T -> Option<'T>
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val return' : x:'a -> 'R (requires member ( ? ))

Full name: Script.return'
module Unchecked

from Microsoft.FSharp.Core.Operators
val defaultof<'T> : 'T

Full name: Microsoft.FSharp.Core.Operators.Unchecked.defaultof
Multiple items
type Bind =
  new : unit -> Bind
  static member ( ? ) : Bind * m:'c option -> (('c -> 'd option) -> 'd option)
  static member ( ? ) : Bind * m:'a list -> (('a -> 'b list) -> 'b list)

Full name: Script.Bind

--------------------
new : unit -> Bind
val m : 'c option
val f : ('c -> 'd option)
module Option

from Microsoft.FSharp.Core
val bind : binder:('T -> 'U option) -> option:'T option -> 'U option

Full name: Microsoft.FSharp.Core.Option.bind
val m : 'a list
val f : ('a -> 'b list)
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val collect : mapping:('T -> 'U list) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.collect
val m : 'a (requires member ( ? ))
val f : 'b
Multiple items
type DoNotationBuilder =
  new : unit -> DoNotationBuilder
  member Bind : p:'a * rest:'b -> 'c (requires member ( ? ))
  member Return : x:'d -> 'e (requires member ( ? ))

Full name: Script.DoNotationBuilder

--------------------
new : unit -> DoNotationBuilder
val b : DoNotationBuilder
Multiple items
member DoNotationBuilder.Return : x:'d -> 'e (requires member ( ? ))

Full name: Script.DoNotationBuilder.Return

--------------------
type Return =
  new : unit -> Return
  static member ( ? ) : Return * 'a option -> ('a -> 'a option)
  static member ( ? ) : Return * 'a list -> ('a -> 'a list)

Full name: Script.Return

--------------------
new : unit -> Return
val x : 'd
Multiple items
member DoNotationBuilder.Bind : p:'a * rest:'b -> 'c (requires member ( ? ))

Full name: Script.DoNotationBuilder.Bind

--------------------
type Bind =
  new : unit -> Bind
  static member ( ? ) : Bind * m:'c option -> (('c -> 'd option) -> 'd option)
  static member ( ? ) : Bind * m:'a list -> (('a -> 'b list) -> 'b list)

Full name: Script.Bind

--------------------
new : unit -> Bind
val p : 'a (requires member ( ? ))
val rest : 'b
val do' : DoNotationBuilder

Full name: Script.do'
val x : int
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val tryFind : predicate:('T -> bool) -> list:'T list -> 'T option

Full name: Microsoft.FSharp.Collections.List.tryFind
val greeting : string
val name : string
val id : string
val password : string
Multiple items
type Fmap =
  new : unit -> Fmap
  static member ( ? ) : Fmap * m:'c option -> (('c -> 'd) -> 'd option)
  static member ( ? ) : Fmap * m:'a list -> (('a -> 'b) -> 'b list)

Full name: Script.Fmap

--------------------
new : unit -> Fmap
val f : ('c -> 'd)
val map : mapping:('T -> 'U) -> option:'T option -> 'U option

Full name: Microsoft.FSharp.Core.Option.map
val f : ('a -> 'b)
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
val f : 'a
val x : 'b (requires member ( ? ))
Multiple items
type Ap =
  new : unit -> Ap
  static member ( ? ) : Ap * mf:('c -> 'd) option -> ('c option -> 'd option)
  static member ( ? ) : Ap * mf:('a -> 'b) list -> ('a list -> 'b list)

Full name: Script.Ap

--------------------
new : unit -> Ap
val mf : ('c -> 'd) option
val x : 'c
union case Option.None: Option<'T>
val mf : ('a -> 'b) list
val mf : 'a (requires member ( ? ))
val m : 'b
val a : int
val b : int
val c : int
val a : unit option

Full name: Script.a
val printf : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printf
Next Version Raw view Test code New version

More information

Link:http://fssnip.net/9B
Posted:12 years ago
Author:nagat01
Tags: monad , applicative , typeclass