apply f_ext_eq.
auto.
Qed.
Definition MonadFunctor: Functor.
Proof with auto.
apply (Build_Functor M bind_map).
intros.
apply f_ext_eq.
intro.
unfold bind_map.
rewrite (eta (@ret M X)).
apply mon_runit.
intros.
unfold bind_map.
unfold compose.
rewrite mon_assoc.
replace (fun xv: a => ret (m:=M) (f (g xv))) with (fun x0: a =>
bind (m:=M) (b:=c) (ret (m:=M) (g x0))
(fun xv: b => ret (m:=M) (f xv)))...
apply f_ext_eq.
intros.
rewrite mon_lunit...
Defined.
Definition a_monad_isa_functor T (x: M T): func MonadFunctor T := x.
(* can't make this a coercion: User error: a_monad_isa_functor does not respect the inheritance uniform condition *)
End MonadFunctor.
Module IdMonad.
Definition C (s: Set): Set := s. (* type ctor *)
Definition bind A B (x: C A) (y: A -> C B): C B := y x.
Definition ret (A: Set) (x: A): C A := x.
Definition M: Monad.
Section MonadToys.
Definition liftM (A B: Set) (f: A -> B) (M: Monad) (x: M A): M B :=
xv <- x ; ret (f xv).
Definition liftM2 (A B C: Set) (f: A -> B -> C) (M: Monad) (x: M A) (y: M B): M C :=
xv <- x ; yv <- y ; ret (f xv yv).
Fixpoint foldlM {A B: Set} {M: Monad} (f: A -> B -> M A) (x: A) (l: list B) {struct l}: M A :=
match l with
| nil => ret x
| h :: t => fax <- f x h ; foldlM f fax t
end. (* Haskell's foldM *)
Fixpoint foldrM {A B: Set} {M: Monad} (f: B -> A -> M A) (x: A) (l: list B) {struct l}: M A :=
match l with
| nil => ret x
| h :: t => t' <- foldrM f x t; f h t'
end. (* missing in Haskell.. *)

(* Specifications: *)
Lemma foldlM_cons (A B: Set) (M: Monad) (f: A -> B -> M A) (x: A) (h: B) (t: list B):
foldlM f x (h :: t) = fax <- f x h ; foldlM f fax t.