{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeHoles #-} -- OMG!
module Main
       ( main -- :: IO ()
       ) where

-------------------------------------------------------------------------------
-- Binary trees

data Tree a = Leaf a | Node (Tree a) (Tree a)
  deriving (Eq, Show)

instance Monad Tree where
  return         = Leaf
  Leaf x   >>= f = f x
  Node l r >>= f = Node (l >>= f) (r >>= f)

-------------------------------------------------------------------------------
-- Free monads

data Free f a
  = Pure a
  | Free (f (Free f a))

instance Functor f => Monad (Free f) where
  return       = Pure
  Pure a >>= f = f a
  Free f >>= g = Free _

-------------------------------------------------------------------------------
-- Trees through free monads

data F a = N a a

instance Functor f where
  fmap f (N a b) = N (f a) (f b)

toFree :: Tree a -> Free F a
toFree (Leaf a)   = Pure a
toFree (Node l r) = undefined

fromFree :: Free F a -> Tree a
fromFree (Pure a)       = Leaf a
fromFree (Free (N a b)) = undefined

-------------------------------------------------------------------------------
-- Codensity transformation

newtype Codensity m a
  = C { runCodensity :: forall r. (a -> m r) -> m r}

instance Monad (Codensity m) where
  return x  = C undefined
  C f >>= g = C undefined

-- Monad homomorphisms

toCodensity :: Monad m => m a -> Codensity m a
toCodensity x = C (x >>=)

fromCodensity :: Monad m => Codensity m a -> m a
fromCodensity (C f) = f return

-------------------------------------------------------------------------------
-- Test driver & Examples

main :: IO ()
main = return ()

{-
*Main> :r
[1 of 1] Compiling Main             ( holes.hs, interpreted )

holes.hs:29:23: Warning:
    Found hole `_' with type f (Free f b)
    Where: `f' is a rigid type variable bound by
               the instance declaration at holes.hs:26:10
           `b' is a rigid type variable bound by
               the type signature for
                 >>= :: Free f a -> (a -> Free f b) -> Free f b
               at holes.hs:28:10
    Relevant bindings include
      >>= :: Free f a -> (a -> Free f b) -> Free f b
        (bound at holes.hs:28:3)
      f :: f (Free f a) (bound at holes.hs:29:8)
      g :: a -> Free f b (bound at holes.hs:29:14)
    In the first argument of `Free', namely `_'
    In the expression: Free (_)
    In an equation for `>>=': (Free f) >>= g = Free (_)
Ok, modules loaded: Main.
*Main> 
-}