IO Monad in OCaml

Monad.ml

module type FUNCTOR = sig
    type 'v f
    val map : ('a -> 'b) -> 'a f -> 'b f
end

module type MONAD = sig
    type 'v f
    val map : ('a -> 'b) -> 'a f -> 'b f
    val pure : 'a -> 'a f
    val join : ('a f) f -> 'a f
end

(* Monad transformers! *)
module type MONADTRANS = functor (M: MONAD) -> sig
    type 'v f
    val lift : 'a M.f -> 'a f
end

(* Creates a type 'a IO, which is a wrapper around (unit -> 'a) *)
module IOMonad = struct
    type 'v f = IO of (unit -> 'v)
    let map f m = let (IO m') = m in IO (fun () -> f (m' ()))
    let pure x = IO (fun () -> x)
    let join m = IO (fun () -> let (IO m') = m in let (IO m') = m' () in m' ())

    let runIO m = let (IO m') = m in m'
end

module MonadUtil = functor (Monad: MONAD) -> struct
    type 'a f = 'a Monad.f
    let bind m f = Monad.join (Monad.map f m)
    let seq m n = bind m (fun _ -> n)
    let ap fm mx = bind fm (fun f -> Monad.map f mx)

    let rec while_ cond action =
        let (>>=) = bind in
        let (>>) = seq in
        cond >>= fun c ->
        if c
            then action >> while_ cond action
            else Monad.pure ()

    let until cond action = while_ (Monad.map not cond) action
    let forever action = while_ (Monad.pure true) action
end

module IOUtil = MonadUtil(IOMonad)

let main =
    let (>>) = IOUtil.seq in
    let mprint_string s = IOMonad.IO (fun () -> print_string s) in
    IOUtil.forever begin
        mprint_string "Hello, " >>
        mprint_string "world!\n"
    end

let _ = IOMonad.runIO main ()