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: