Fork me on GitHub

Real World Code Snippet

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
42
module RealWorld =

type World = private | World
and 'a Pure = private | Pure of 'a
and 'a IO = World -> ('a Pure * World)

let bind : 'a IO -> 'b IO -> 'b IO =
fun a1 a2 world0 ->
let (a,world1) = a1 world0 in
let (b,world2) = a2 world1 in
(b,world2)

let lift : 'a IO -> ('a Pure -> 'b IO) -> 'b IO =
fun a1 a2 world0 ->
let (a,world1) = a1 world0 in
let (b,world2) = a2 a world1 in
(b,world2)

let ( >> ) : 'a IO -> 'b IO -> 'b IO = bind
let ( >>= ) : 'a IO -> ('a Pure -> 'b IO) -> 'b IO = lift

let unit : unit Pure = Pure ()

let effect : ('a -> 'b) -> 'a Pure -> 'b IO =
fun f (Pure a) ->
fun world -> Pure (f a), world

let eval : unit IO -> unit Pure * World =
fun main -> main World

[<AutoOpen>]
module Don =

[<Sealed>]
type DonBuilder () =
member __.Yield (()) : unit IO = fun world -> unit,world
[<CustomOperation("bind")>]
member __.Bind' (a1, a2) = bind a1 a2
[<CustomOperation("lift")>]
member __.LiftM (a1, a2) = lift a1 a2

let don = new DonBuilder ()

Real World Code output:

module RealWorld = begin
type World = private | World
and 'a Pure = private | Pure of 'a
and 'a IO = World -> 'a Pure * World
val bind : a1:'a IO -> a2:'b IO -> world0:World -> 'b Pure * World
val lift :
a1:'a IO -> a2:('a Pure -> 'b IO) -> world0:World -> 'b Pure * World
val ( >> ) : ('a IO -> 'b IO -> 'b IO)
val ( >>= ) : ('a IO -> ('a Pure -> 'b IO) -> 'b IO)
val unit : unit Pure = Pure ()
val effect : f:('a -> 'b) -> 'a Pure -> 'b IO
val eval : main:unit IO -> unit Pure * World
module Don = begin
type DonBuilder =
class
new : unit -> DonBuilder
member Bind' : a1:'c IO * a2:'d IO -> 'd IO
member LiftM : a1:'a IO * a2:('a Pure -> 'b IO) -> 'b IO
member Yield : unit -> unit IO
end
val don : DonBuilder
end
end

Utils Code Snippet

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
module Util =

open RealWorld

module Random =
let private r = new System.Random ()
let next ( ) = r.Next ()

module Read =
let readInt () = System.Console.Read ()
let readKey () = System.Console.ReadKey ()
let readLine () = System.Console.ReadLine ()

let (!) : 'a -> 'a IO =
fun a -> effect (fun _ -> a) unit

let getRand : int IO =
effect Random.next unit

let putInt : int Pure -> unit IO =
effect <| printf "%i"

let readLn : string IO =
effect Read.readLine unit

let putStr : string Pure -> unit IO =
effect <| printf "%s"

let putStrLn : string Pure -> unit IO =
effect <| printfn "%s"

let sample1 : unit IO =
! "What is your name?"
>>= putStrLn
>> readLn
>>= fun a ->
! "How old are you?"
>>= putStrLn
>> readLn
>>= fun b ->
putStr a
>> ! ","
>>= putStr
>> putStrLn b

let sample2 : unit IO = don {
bind ! "What is your name?"
lift putStrLn
bind readLn

lift (fun a -> don {
bind ! "How old are you?"
lift putStrLn
bind readLn

lift (fun b -> don {
bind (putStr a)
bind ! ","
lift putStr
bind (putStrLn b)

})
})
}

Utils Code output:

module Util = begin
module Random = begin
val private r : System.Random
val next : unit -> int
end
module Read = begin
val readInt : unit -> int
val readKey : unit -> System.ConsoleKeyInfo
val readLine : unit -> string
end
val ( ! ) : a:'a -> 'a RealWorld.IO
val getRand : int RealWorld.IO
val putInt : (int RealWorld.Pure -> unit RealWorld.IO)
val readLn : string RealWorld.IO
val putStr : (string RealWorld.Pure -> unit RealWorld.IO)
val putStrLn : (string RealWorld.Pure -> unit RealWorld.IO)
val sample1 : unit RealWorld.IO
val sample2 : unit RealWorld.IO
end

Execution Code Snippet

let _ = Util.sample1 |> RealWorld.eval, Util.sample2 |> RealWorld.eval
mon@razerRamon:~/tmp/realWorld$ ./RealWorld.fsx

Execution Code output:

What is your name?
John Doe
How old are you?
42
John Doe,42
What is your name?
John Doe
How old are you?
42
John Doe,42

References:

comments powered by Disqus