eilenberg moore category (wip)

em.lhs

Given a class representing covariant functors between categories

> import Control.Category

> class (Category hom, Category hom') => Covariant f hom hom' where
>   cmap :: hom a b -> hom' (f a) (f b)

and a class for adjunctions

> class (Covariant f hom hom', Covariant g hom' hom) => Adjunction f g hom hom' where
>   unit   :: a  -> g (f a)
>   counit :: f (g a) -> a

I am trying to implement the Eilenberg-Moore adjunction for a monad. I've got as far as defining the objects of the category, which are algebras over the monad

> newtype Algebra m a = Algebra (m a -> a)

and the morphisms, which are algebra homomorphisms

> newtype AlgHom m a b = AlgHom (a -> b)

where if `h :: m a -> a` and `k :: m b -> b` then `f :: a -> b` is an algebra homomorphism iff

    k . fmap f = f . h

But I'm having trouble writing the `Category` instance, and the corresponding functor instances. I have

> instance Monad m => Category (AlgHom m) where
>   id = AlgHom Prelude.id
>   AlgHom f . AlgHom g = AlgHom (Prelude.compose f g)
>
> newtype Id a = Id { runId :: a }

> instance Monad m => Covariant Id (AlgHom m) (->) where
>   -- cmap :: AlgHom m a b -> Id a -> Id b
>   cmap (AlgHom f) = Id . f . runId

> instance Monad m => Covariant (Algebra m) (->) (AlgHom m) where
>   -- cmap :: (a -> b) -> AlgHom m (Algebra a) (Algebra b)
>   cmap = undefined -- ??

> instance Monad m => Adjunction (Algebra m) Id (->) (AlgHom m) where
>   unit   = undefined -- ??
>   counit = undefined -- ??

What's supposed to replace all the `undefined`s?