(Co)free (Co)monads

free.hs

{-# LANGUAGE Rank2Types #-}

import Control.Monad (join)

data Free f a = Return a | Bind (f (Free f a))

instance (Functor f) => Monad (Free f) where
  return = Return
  (Return x) >>= f = f x
  (Bind xs) >>= f = Bind $ fmap (>>= f) xs

leftAdjunct :: (Functor f, Monad m) => (forall a. f a -> m a) -> Free f a -> m a
leftAdjunct _ (Return x) = return x
leftAdjunct phi (Bind xs) = join $ phi $ fmap (leftAdjunct phi) xs

rightAdjunct :: (Functor f, Monad m) => (forall a. Free f a -> m a) -> f a -> m a
rightAdjunct psi = psi . Bind . (fmap Return)

data CoFree f a = CoFree a (f (CoFree f a))

class Comonad w where
  extract :: w a -> a
  duplicate :: w a -> w (w a)

instance (Functor f) => Comonad (CoFree f) where
  extract (CoFree a _) = a
  duplicate c@(CoFree a xs) = CoFree c $ fmap duplicate xs

leftAdjunct' :: (Functor f, Comonad w) => (forall a. w a -> CoFree f a) -> w a -> f a
leftAdjunct' f x = let CoFree _ xs = f x in fmap extract xs

rightAdjunct' :: (Functor f, Comonad w) => (forall a. w a -> f a) -> w a -> CoFree f a
rightAdjunct' f x = CoFree (extract x) (fmap (rightAdjunct' f) $ f $ duplicate x)