import Control.Monad
import Control.Comonad

newtype (g :. f) a = Composition
  { unComposition :: g (f a)
  }

class (Functor f, Functor g) => f -| g where
  hom  :: (f a -> b) -> a -> g b
  hom' :: (a -> g b) -> f a -> b
  unit :: a -> g (f a)
  counit :: f (g a) -> a
  
  hom  f = fmap f . unit
  hom' f = counit . fmap f
  unit   = hom id
  counit = hom' id

instance (Functor f, Functor g) => Functor (g :. f) where
  fmap f (Composition a) = Composition $ (fmap .fmap) f a

instance f -| g => Applicative (g :. f) where
  pure = Composition . unit
  (<*>) = ap

instance f -| g => Monad (g :. f) where
  Composition m >>= f = Composition $
    let f' = unComposition . f
        gfgfb = (fmap . fmap) f' m
     in fmap counit gfgfb

instance f -| g => Comonad (f :. g) where
  extract (Composition a) = counit a
  extend f (Composition fga) = Composition $
    let f' = f . Composition
        fgfga = fmap unit fga
     in (fmap . fmap) f' fgfga

main :: IO ()
main = pure ()