Cofree j-relative comonad

Cofreer.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Cofreer where

import Data.Kind (Type)
import Data.Functor.Identity

class RelComonad j w where
  extract :: w a -> j a
  extend :: (w a -> j b) -> w a -> w b

data Cofreer :: (k -> Type) -> (k -> Type) -> k -> Type where
  Cofreer :: j a -> (forall b. (Cofreer j f a -> j b) -> f b) -> Cofreer j f a

deriving instance (Functor j, Functor f) => Functor (Cofreer j f)

instance RelComonad j (Cofreer j f) where
  extract (Cofreer j _) = j
  extend h w@(Cofreer j f) = Cofreer (h w) (\k -> f (k . extend h))


data Cofree f a = a :< f (Cofree f a)

toCofree :: Cofreer Identity f a -> Cofree f a
toCofree (Cofreer (Identity a) g) = a :< g (Identity . toCofree)

fromCofree :: Functor f => Cofree f a -> Cofreer Identity f a
fromCofree (a :< fc) = Cofreer (Identity a) (\g -> fmap (runIdentity . g . fromCofree) fc)