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 ()

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

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)
    
    })
    })
  }

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

let _ = Util.sample1 |> RealWorld.eval, Util.sample2 |> RealWorld.eval

mon@razerRamon:~/tmp/realWorld$ ./RealWorld.fsx

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