module type Functor = sig
type 'a t
val map : ('a -> 'b) -> 'a t -> 'b t
end
module type Apply = sig
include Functor
val apply : ('a -> 'b) t -> 'a t -> 'b t
end
module type Applicative = sig
include Apply
val pure : 'a -> 'a t
end
module type Bind = sig
include Apply
val bind : 'a t -> ('a -> 'b t) -> 'b t
end
module type Monad = sig
include Applicative
include Bind with type 'a t := 'a t
end
(* Examples: *)
module Option_monad : Monad = struct
type 'a t = 'a option
let map f x =
match x with
| Some x -> Some (f x)
| None -> None
let apply f x =
match (f, x) with
| (Some f', Some x') -> Some (f' x')
| _ -> None
let pure x = Some x
let bind x k =
match x with
| Some x -> k x
| None -> None
end
module IO : sig
include Monad
val make : (unit -> 'a) -> 'a t
val unsafe_perform : 'a t -> 'a
end = struct
type 'a t = unit -> 'a
let make f = f
let unsafe_perform x = x ()
let map f x () = f (x ())
let apply f x () =
let f' = f () in
f' (x ())
let pure x () = x
let bind x k = k (x ())
end
module Main : sig
val main : unit IO.t
end = struct
let print s = IO.make (fun _ -> print_endline s)
let main = IO.bind (print "Hello") (fun _ -> print "World")
end
let () = IO.unsafe_perform Main.main
