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
43
44
45
46
47
48
49
50
module RealWorld : sig                              

type world = private World
type α pure = private Pure of α
type α io = world (α pure * world)

val bind : α io β io β io
val lift : α io (α pure β io) β io

val ( >> ) : α io β io β io
val ( >>= ) : α io (α pure β io) β io

val unit : unit pure

val effect : (α β) α pure β io
val eval : unit io (unit pure * world)

end

= struct

type world = World
type α pure = Pure of α
type α io = world (α pure * world)

let bind : α io β io β io =
λ action1 action2 world0
let (a,world1) = action1 world0 in
let (b,world2) = action2 world1 in
(b,world2)

let lift : α io (α pure β io) β io =
λ action1 action2 world0
let (a,world1) = action1 world0 in
let (b,world2) = action2 a world1 in
(b,world2)

let ( >> ) : α io β io β io = bind
let ( >>= ) : α io (α pure β io) β io = lift

let unit : unit pure = Pure ()

let effect : (α β) α pure β io =
λ f (Pure a)
λ world Pure (f a), world

let eval : unit io (unit pure * world) =
λ main main World

end

Real World Code output:

module RealWorld :
sig
type world = private World
type 'a pure = private Pure of 'a
type 'a io = world -> 'a pure * world
val bind : 'a io -> 'b io -> 'b io
val lift : 'a io -> ('a pure -> 'b io) -> 'b io
val ( >> ) : 'a io -> 'b io -> 'b io
val ( >>= ) : 'a io -> ('a pure -> 'b io) -> 'b io
val unit : unit pure
val effect : ('a -> 'b) -> 'a pure -> 'b io
val eval : unit io -> unit pure * world
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
module Util = struct                                

open RealWorld

let (!) : α α io =
λ a effect (λ _ a) unit

let readLn : string io =
effect read_line unit

let putStr : string pure unit io =
effect print_string

let putStrLn : string pure unit io =
effect print_endline

let sample : unit io =
! "What is your name?"
>>= putStrLn
>> readLn
>>= λ a
! "How old are you?"
>>= putStrLn
>> readLn
>>= λ b
putStr a
>> ! ": "
>>= putStr
>> putStrLn b

end

Utils Code output:

module Util :
sig
val ( ! ) : 'a -> 'a RealWorld.io
val readLn : string RealWorld.io
val putStr : string RealWorld.pure -> unit RealWorld.io
val putStrLn : string RealWorld.pure -> unit RealWorld.io
val sample : unit RealWorld.io
end

Execution Code Snippet

let _ = Util.sample |> RealWorld.eval 
mon@razerRamon:~/tmp/ocaml$ ocaml real_world.ml

Execution Code output:

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

References:

comments powered by Disqus