details in CCCat

core/CCCat.ml

@@ -46,13 +46,17 @@ module type APPLICATIVE = sig
   val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
 end
 
-module type MONAD = sig
+module type MONAD_BARE = sig
   type +'a t
-  include APPLICATIVE with type 'a t := 'a t
   val return : 'a -> 'a t
   val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
 end
 
+module type MONAD = sig
+  include MONAD_BARE
+  include APPLICATIVE with type 'a t := 'a t
+end
+
 module type MONAD_TRANSFORMER = sig
   include MONAD
   module M : MONAD
@@ -76,8 +80,6 @@ module type TRAVERSE = functor(M : MONAD) -> sig
   val map_m : ('a -> 'b M.t) -> 'a t -> 'b t M.t
 end
 
-(** {2 Some Implementations} *)
-
 module type FREE_MONAD = sig
   module F : FUNCTOR
 
@@ -89,6 +91,19 @@ module type FREE_MONAD = sig
   val inj : 'a F.t -> 'a t
 end
 
+(** {2 Some Implementations} *)
+
+module WrapMonad(M : MONAD_BARE) = struct
+  include M
+
+  let map f x = x >>= (fun x -> return (f x))
+
+  let pure = return
+
+  let (<*>) f x = f >>= fun f -> x >>= fun x -> return (f x)
+end
+
+
 module MakeFree(F : FUNCTOR) = struct
   module F = F
 

core/CCCat.mli

@@ -48,13 +48,17 @@ module type APPLICATIVE = sig
   val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
 end
 
-module type MONAD = sig
+module type MONAD_BARE = sig
   type +'a t
-  include APPLICATIVE with type 'a t := 'a t
   val return : 'a -> 'a t
   val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
 end
 
+module type MONAD = sig
+  include MONAD_BARE
+  include APPLICATIVE with type 'a t := 'a t
+end
+
 module type MONAD_TRANSFORMER = sig
   include MONAD
   module M : MONAD
@@ -79,8 +83,6 @@ module type TRAVERSE = functor(M : MONAD) -> sig
   val map_m : ('a -> 'b M.t) -> 'a t -> 'b t M.t
 end
 
-(** {2 Some Implementations} *)
-
 (** The free monad is built by nesting applications of a functor [F].
 
 For instance, Lisp-like nested lists can be built and dealt with like this:
@@ -100,6 +102,11 @@ module type FREE_MONAD = sig
   val inj : 'a F.t -> 'a t
 end
 
+(** {2 Some Implementations} *)
+
+(** Implement the applicative and functor modules from only return and bind *)
+module WrapMonad(M : MONAD_BARE) : MONAD with type 'a t = 'a M.t
+
 module MakeFree(F : FUNCTOR) : FREE_MONAD with module F = F
 
 module MakeFreeFold(FM : FREE_MONAD)(Fold : FOLDABLE with type 'a t = 'a FM.F.t)