gistfile1.hs

{-# LANGUAGE 
  GADTs,
  FlexibleInstances, FlexibleContexts, UndecidableInstances,
  StandaloneDeriving, TypeOperators, Rank2Types,
  MultiParamTypeClasses,
  DeriveTraversable, DeriveFunctor, DeriveFoldable,
  TypeFamilies, FunctionalDependencies,
  ScopedTypeVariables, GeneralizedNewtypeDeriving
 #-}
 
import Control.Monad
import Control.Monad.Identity


{- Higher order functors
   from http://www.timphilipwilliams.com/posts/2013-01-16-fixing-gadts.html
-}
 
newtype HFix h a = HFix { unHFix :: h (HFix h) a }
deriving instance (Show (h (HFix h) a)) => Show (HFix h a)
 
-- Natural transformation
type f :~> g = forall a. f a -> g a
 
-- Higher order functor
class HFunctor (h :: (* -> *) -> * -> *) where
    hfmap :: (f :~> g) -> h f :~> h g

class (HFunctor f, Monad m) => Monadic f d m where
  construct :: f d a -> m   (d a)
  destruct  ::   d a -> m (f d a)

instance (HFunctor f) => Monadic f (HFix f) Identity where
  construct = return . HFix
  destruct = return . unHFix

instance (HFunctor f, Show a, Show (HFix f a)) => Monadic f (HFix f) IO where
  construct = m . HFix where m x = do { putStrLn . show $ x ; return x }
  destruct = return . unHFix