Fiddling with type synonyms

gistfile1.hs

{-# LANGUAGE KindSignatures #-}
-- http://stackoverflow.com/questions/12717301/haskell-type-synonym-declaration-with-constraint-possible
{-# LANGUAGE Rank2Types #-} -- Necessary for the type synonyms to work!!!!
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}


import Data.Functor.Compose
import Data.Monoid
--import Control.Category
import Control.Error
import Control.Applicative
import Control.Proxy
import Control.Monad
import Control.Monad.Free
import Control.Monad.Logic
import Data.Foldable (Foldable)
import Data.Traversable
import qualified Data.Text as T


-- pipes
type Produ t = Producer ProxyFast t
type Consu t = Consumer ProxyFast t

newtype Nullipotent m a = Nullipotent { runNullipotent :: m a }
   deriving (Eq, Ord, Read, Show, Functor, Foldable, Traversable, Monad)
   
type Tag = T.Text

data Sealed m = Sealed {
       tags :: [Tag],
       unseal :: m ()
   }

addTag :: Tag -> Sealed m -> Sealed m
addTag t (Sealed ts a) = Sealed (t:ts) a

type Glance m l om a = om -> LogicT (Produ l (Nullipotent m)) a

-- type Peek l o a = Monad m => (o m) -> LogicT (Produ l (Nullipotent m)) a
-- A glance whose return value must be independent of the monad m. This rules
-- out returning a Sealed value, for example.
type Peek l o a = Monad m => Glance m l (o m) a

-- type Focus l o a = Monad m => (o m) -> LogicT (Produ l (Nullipotent m)) (a m)
-- A glance whose return value depends on the monad m.
type Focus l o a = Monad m => Glance m l (o m) (a m)

type Poke l o = Focus l o Sealed

newtype Foo m = Foo { getFoo :: Sealed m  }

type ObserverF m l o = Compose ((->) o) (LogicT (Produ l (Nullipotent m)))
type Observer m l o = Free (ObserverF m l o)

fee :: Monad m => Peek l o a -> Observer m l (o m) a
fee p = liftF . Compose $ p

fii :: Monad m => Focus l o a -> Observer m l (o m) (a m)
fii p = liftF . Compose $ p

fum :: Monad m => Poke l o -> Observer m l (o m) (Sealed m)
fum p = liftF . Compose $ p

aaa :: Monad m => Observer m l (Foo m) (Sealed m) 
---aaa = fee $ \foo -> return . getFoo $ foo  -- doesn't work
aaa = fii $ \foo -> return . getFoo $ foo