diff --git a/objective.cabal b/objective.cabal
--- a/objective.cabal
+++ b/objective.cabal
@@ -1,5 +1,5 @@
 name:                objective
-version:             0.6.3.2
+version:             0.6.3.3
 synopsis:            Extensible objects
 description:         Stateful effect transducer
 homepage:            https://github.com/fumieval/objective
@@ -16,16 +16,23 @@
 cabal-version:       >=1.10
 
 library
-  exposed-modules:     Control.Object
-                     , Control.Monad.Objective
-                     , Control.Monad.Objective.Class
-                     , Control.Monad.Objective.IO
-                     , Control.Monad.Objective.ST
-                     , Data.Functor.Request
-                     , Data.Functor.PushPull
+  exposed-modules:
+    Control.Object
+      , Control.Object.Object
+      , Control.Object.Mortal
+      , Control.Object.Process
+      , Control.Object.Extra
+      , Control.Object.Stream
+      , Control.Monad.Objective
+      , Control.Monad.Objective.Class
+      , Control.Monad.Objective.IO
+      , Control.Monad.Objective.ST
+      , Data.Functor.Request
+      , Data.Functor.PushPull
   -- other-modules:
   other-extensions:    MultiParamTypeClasses, KindSignatures, TypeFamilies
   build-depends:       base >=4.5 && <5
+    , comonad
     , clean-unions < 0.2
     , elevator >= 0.1.2 && <0.2
     , containers
@@ -37,9 +44,9 @@
     , unordered-containers
     , hashable >= 1.2 && <1.4
     , either
+    , void
     , adjunctions >= 4.0 && <5
-    , transformers >= 0.2 && <0.5
-    , transformers-compat >= 0.3
+    , transformers >= 0.3 && <0.5
   ghc-options: -Wall
   hs-source-dirs:      src
   default-language:    Haskell2010
diff --git a/src/Control/Monad/Objective/Class.hs b/src/Control/Monad/Objective/Class.hs
--- a/src/Control/Monad/Objective/Class.hs
+++ b/src/Control/Monad/Objective/Class.hs
@@ -21,7 +21,7 @@
 --
 -----------------------------------------------------------------------------
 module Control.Monad.Objective.Class where
-import Control.Object
+import Control.Object.Object
 import Control.Elevator
 import Control.Monad.Trans.State.Strict
 import Control.Monad.Operational.Mini
diff --git a/src/Control/Monad/Objective/IO.hs b/src/Control/Monad/Objective/IO.hs
--- a/src/Control/Monad/Objective/IO.hs
+++ b/src/Control/Monad/Objective/IO.hs
@@ -16,7 +16,7 @@
 module Control.Monad.Objective.IO  where
 import Control.Monad.Objective.Class
 import Control.Concurrent
-import Control.Object
+import Control.Object.Object
 import Control.Monad.IO.Class
 
 instance ObjectiveBase IO where
diff --git a/src/Control/Monad/Objective/ST.hs b/src/Control/Monad/Objective/ST.hs
--- a/src/Control/Monad/Objective/ST.hs
+++ b/src/Control/Monad/Objective/ST.hs
@@ -18,7 +18,7 @@
 
 import Control.Monad.Objective.Class
 import Control.Monad.ST
-import Control.Object
+import Control.Object.Object
 import Data.STRef
 import Control.Elevator
 
diff --git a/src/Control/Object.hs b/src/Control/Object.hs
--- a/src/Control/Object.hs
+++ b/src/Control/Object.hs
@@ -1,7 +1,6 @@
+{-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE Rank2Types, FlexibleInstances, FlexibleContexts, TypeOperators, CPP, ConstraintKinds #-}
-#if __GLASGOW_HASKELL__ >= 707
-{-# LANGUAGE DeriveDataTypeable #-}
-#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Control.Object
@@ -15,481 +14,20 @@
 -- Stateful effect transducer: The Mealy machine for effects.
 --
 -----------------------------------------------------------------------------
-module Control.Object (
-  -- * Construction
-  Object(..),
-  (@-),
-  liftO,
-  echo,
-  oneshot,
-  stateful,
-  variable,
-  Variable,
-  unfoldO,
-  unfoldOM,
-  foldP,
-  foldP',
-  sharing,
-  animate,
-  transit,
-  -- * Composition
-  (@>>@),
-  (@>>^),
-  (^>>@),
-  (@**@),
-  (@||@),
-  loner,
-  (@|>@),
-  transObject,
-  adaptObject,
-  -- * Stream
-  ($$),
-  ($$!),
-  (!$$),
-  (!$$!),
-  -- * Monads
-  (@!),
-  (@!!),
-  sequential,
-  sequentialT,
-  iterObject,
-  iterTObject,
-  iterative,
-  iterativeT,
-  -- * Patterns
-  flyweight,
-  flyweight',
-  announce,
-  announceMaybe,
-  announceMaybeT,
-  announceMortal,
-  Process(..),
-  _Process,
-  Mortal(..),
-  runMortal,
-  )
-where
+module Control.Object
+  ( module Control.Object.Object,
+    module Control.Object.Stream,
+    module Control.Object.Mortal,
+    module Control.Object.Process,
+    module Control.Object.Extra,
+    module Data.Functor.Request,
+    module Data.Functor.PushPull
+  ) where
 
-import Control.Applicative
-import Control.Arrow as A
-import Control.Elevator
-import Control.Monad
-import Control.Monad.Free
-import Control.Monad.Operational.Mini
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.State.Strict
-import Control.Monad.Trans.Writer.Strict
-import Data.Functor.Day
-import Data.Functor.PushPull
+import Control.Object.Object
+import Control.Object.Stream
+import Control.Object.Mortal
+import Control.Object.Process
+import Control.Object.Extra
 import Data.Functor.Request
-import Data.Functor.Sum as F
-import Data.Hashable
-import Data.Monoid
-import Data.OpenUnion1.Clean
-import Data.Profunctor
-import Data.Typeable
-import Data.Witherable
-import qualified Control.Category as C
-import qualified Control.Monad.Trans.Free as T
-import qualified Control.Monad.Trans.Operational.Mini as T
-import qualified Data.HashMap.Strict as HM
-import qualified Data.Map.Strict as Map
-import qualified Data.Traversable as T
-import Control.Monad.Trans.Either as E
-import Unsafe.Coerce
-
-import Data.Functor.Rep
-import Data.Functor.Adjunction
-
--- | The type @Object f g@ represents objects which can handle messages @f@, perform actions in the environment @g@.
--- It can be thought of as an automaton that converts effects.
--- 'Object's can be composed just like functions using '@>>@'; the identity element is 'echo'.
--- Objects are morphisms of the category of functors
-newtype Object f g = Object { runObject :: forall x. f x -> g (x, Object f g) }
-#if __GLASGOW_HASKELL__ >= 707
-  deriving (Typeable)
-#else
-instance (Typeable1 f, Typeable1 g) => Typeable (Object f g) where
-  typeOf t = mkTyConApp objectTyCon [typeOf1 (f t), typeOf1 (g t)] where
-    f :: Object f g -> f a
-    f = undefined
-    g :: Object f g -> g a
-    g = undefined
-
-objectTyCon :: TyCon
-#if __GLASGOW_HASKELL__ < 704
-objectTyCon = mkTyCon "Control.Object.Object"
-#else
-objectTyCon = mkTyCon3 "object" "Control.Object" "Object"
-#endif
-{-# NOINLINE objectTyCon #-}
-#endif
-
--- | An alias for 'runObject'.
-(@-) :: Object f g -> f x -> g (x, Object f g)
-(@-) = runObject
-{-# INLINE (@-) #-}
-infixr 3 @-
-
--- | The identity object
-echo :: Functor f => Object f f
-echo = Object (fmap (\x -> (x, echo)))
-
--- | Object-object composition
-(@>>@) :: Functor h => Object f g -> Object g h -> Object f h
-Object m @>>@ Object n = Object $ fmap (\((x, m'), n') -> (x, m' @>>@ n')) . n . m
-infixr 1 @>>@
-
--- | Object-function composition
-(@>>^) :: Functor h => Object f g -> (forall x. g x -> h x) -> Object f h
-m0 @>>^ g = go m0 where go (Object m) = Object $ fmap (fmap go) . g . m
-infixr 1 @>>^
-
--- | Function-object composition
-(^>>@) :: Functor h => (forall x. f x -> g x) -> Object g h -> Object f h
-f ^>>@ m0 = go m0 where go (Object m) = Object $ fmap (fmap go) . m . f
-infixr 1 ^>>@
-
-(@**@) :: Applicative m => Object f m -> Object g m -> Object (Day f g) m
-a @**@ b = Object $ \(Day f g r) -> (\(x, a') (y, b') -> (r x y, a' @**@ b')) <$> runObject a f <*> runObject b g
-infixr 3 @**@
-
-(@||@) :: Functor m => Object f m -> Object g m -> Object (F.Sum f g) m
-a @||@ b = Object $ \r -> case r of
-  InL f -> fmap (fmap (@||@b)) (runObject a f)
-  InR g -> fmap (fmap (a@||@)) (runObject b g)
-infixr 2 @||@
-
--- | Lift a natural transformation into an object.
-liftO :: Functor g => (forall x. f x -> g x) -> Object f g
-liftO f = go where go = Object $ fmap (\x -> (x, go)) . f
-{-# INLINE liftO #-}
-
--- | Change the workspace of the object.
-transObject :: Functor g => (forall x. f x -> g x) -> Object e f -> Object e g
-transObject f = (@>>^f)
-
--- | Apply a function to the messages coming into the object.
-adaptObject :: Functor m => (forall x. g x -> f x) -> Object f m -> Object g m
-adaptObject f = (f^>>@)
-
--- | Build an object using continuation passing style.
-oneshot :: (Functor f, Monad m) => (forall a. f (m a) -> m a) -> Object f m
-oneshot m = go where
-  go = Object $ \e -> m (fmap return e) >>= \a -> return (a, go)
-{-# INLINE oneshot #-}
-
--- | Build a stateful object.
---
--- @stateful t s = t ^>>@ variable s@
-stateful :: Monad m => (forall a. f a -> StateT s m a) -> s -> Object f m
-stateful h = go where
-  go s = Object $ liftM (\(a, s') -> (a, go s')) . flip runStateT s . h
-{-# INLINE stateful #-}
-
--- | The unwrapped analog of 'stateful'
---     @unfoldO runObject = id@
---     @unfoldO runSequential = sequential@
---     @unfoldO iterObject = iterable@
-unfoldO :: Functor g => (forall a. r -> f a -> g (a, r)) -> r -> Object f g
-unfoldO h = go where go r = Object $ fmap (fmap go) . h r
-{-# INLINE unfoldO #-}
-
-unfoldOM :: Monad m => (forall a. r -> f a -> m (a, r)) -> r -> Object f m
-unfoldOM h = go where go r = Object $ liftM (fmap go) . h r
-{-# INLINE unfoldOM #-}
-
-type Variable s = forall m. Monad m => Object (StateT s m) m
-
--- | A mutable variable.
-variable :: s -> Variable s
-variable s = Object $ \m -> liftM (fmap variable) $ runStateT m s
-
--- | Build a stateful object, sharing out the state.
-sharing :: Monad m => (forall a. f a -> StateT s m a) -> s -> Object (State s |> f |> Nil) m
-sharing m = go where
-  go s = Object $ \k -> liftM (fmap go) $ ($k)
-    $ (\n -> return $ runState n s)
-    ||> (\e -> runStateT (m e) s)
-    ||> exhaust
-{-# INLINE sharing #-}
-
--- | An object that won't accept any messages.
-loner :: Functor f => Object Nil f
-loner = liftO exhaust
-
--- | Extend an object by adding another independent object.
-(@|>@) :: Functor g => Object f g -> Object (Union s) g -> Object (f |> Union s) g
-p @|>@ q = Object $ fmap (fmap (@|>@q)) . runObject p ||> fmap (fmap (p @|>@)) . runObject q
-infixr 3 @|>@
-
--- | The flyweight pattern.
-flyweight :: (Monad m, Ord k) => (k -> m a) -> Object (Request k a) m
-flyweight f = go Map.empty where
-  go m = Object $ \(Request k cont) -> case Map.lookup k m of
-    Just a -> return (cont a, go m)
-    Nothing -> f k >>= \a -> return (cont a, go $ Map.insert k a m)
-
--- | Like 'flyweight', but it uses 'Data.HashMap.Strict' internally.
-flyweight' :: (Monad m, Eq k, Hashable k) => (k -> m a) -> Object (Request k a) m
-flyweight' f = go HM.empty where
-  go m = Object $ \(Request k cont) -> case HM.lookup k m of
-    Just a -> return (cont a, go m)
-    Nothing -> f k >>= \a -> return (cont a, go $ HM.insert k a m)
-
-(@!) :: Monad m => Object e m -> ReifiedProgram e a -> m (a, Object e m)
-obj @! Return a = return (a, obj)
-obj @! (e :>>= cont) = runObject obj e >>= \(a, obj') -> obj' @! cont a
-infixr 3 @!
-
-(@!!) :: Monad m => Object e m -> T.ReifiedProgramT e m a -> m (a, Object e m)
-obj @!! T.Return a = return (a, obj)
-obj @!! T.Lift m cont = m >>= (obj @!!) . cont
-obj @!! (e T.:>>= cont) = runObject obj e >>= \(a, obj') -> obj' @!! cont a
-infixr 3 @!!
-
-iterObject :: Monad m => Object f m -> Free f a -> m (a, Object f m)
-iterObject obj (Pure a) = return (a, obj)
-iterObject obj (Free f) = runObject obj f >>= \(cont, obj') -> iterObject obj' cont
-
-iterTObject :: Monad m => Object f m -> T.FreeT f m a -> m (a, Object f m)
-iterTObject obj m = T.runFreeT m >>= \r -> case r of
-  T.Pure a -> return (a, obj)
-  T.Free f -> runObject obj f >>= \(cont, obj') -> iterTObject obj' cont
-
--- | Let object handle sequential methods.
-sequential :: Monad m => Object e m -> Object (ReifiedProgram e) m
-sequential = unfoldOM (@!)
-
--- | Let object handle sequential methods.
-sequentialT :: Monad m => Object e m -> Object (T.ReifiedProgramT e m) m
-sequentialT = unfoldOM (@!!)
-
-iterative :: Monad m => Object f m -> Object (Free f) m
-iterative = unfoldOM iterObject
-
-iterativeT :: Monad m => Object f m -> Object (T.FreeT f m) m
-iterativeT = unfoldOM iterTObject
-
-foldP :: Applicative f => (a -> r -> f r) -> r -> Object (PushPull a r) f
-foldP f = go where
-  go r = Object $ \pp -> case pp of
-    Push a c -> fmap (\z -> (c, z `seq` go z)) (f a r)
-    Pull cont -> pure (cont r, go r)
-{-# INLINE foldP #-}
-
-foldP' :: Applicative f => (a -> r -> r) -> r -> Object (PushPull a r) f
-foldP' f = go where
-  go r = Object $ \pp -> case pp of
-    Push a c -> let z = f a r in pure (c, z `seq` go z)
-    Pull cont -> pure (cont r, go r)
-{-# INLINE foldP' #-}
-
-animate :: (Applicative m, Num t) => (t -> m a) -> Object (Request t a) m
-animate f = go 0 where
-  go t = Object $ \(Request dt cont) -> (\x -> (cont x, go (t + dt))) <$> f t
-
-transit :: (Alternative m, Fractional t, Ord t) => t -> (t -> m a) -> Object (Request t a) m
-transit len f = go 0 where
-  go t
-    | t >= len = Object $ const empty
-    | otherwise = Object $ \(Request dt cont) -> (\x -> (cont x, go (t + dt))) <$> f (t / len)
-
-announce :: (T.Traversable t, Monad m, Elevate (State (t (Object f g))) m, Elevate g m) => f a -> m [a]
-announce f = do
-  t <- elevate get
-  (t', Endo e) <- runWriterT $ T.mapM (\obj -> (lift . elevate) (runObject obj f)
-      >>= \(x, obj') -> writer (obj', Endo (x:))) t
-  elevate (put t')
-  return (e [])
-
-announceMaybe :: (Witherable t
-    , Monad m
-    , Elevate (State (t (Object f Maybe))) m) => f a -> m [a]
-announceMaybe f = elevate $ state
-  $ \t -> let (t', Endo e) = runWriter
-                $ witherM (\obj -> case runObject obj f of
-                  Just (x, obj') -> lift $ writer (obj', Endo (x:))
-                  Nothing -> mzero) t in (e [], t')
-
-announceMaybeT :: (Witherable t
-  , Monad m
-  , State (t (Object f (MaybeT g))) ∈ Floors1 m
-  , g ∈ Floors1 m
-  , Tower m) => f a -> m [a]
-announceMaybeT f = do
-  t <- elevate get
-  (t', Endo e) <- runWriterT $ witherM (\obj -> mapMaybeT (lift . elevate) (runObject obj f)
-      >>= \(x, obj') -> lift (writer (obj', Endo (x:)))) t
-  elevate (put t')
-  return (e [])
-
-announceMortal :: (Witherable t
-  , Monad m
-  , State (t (Mortal f g ())) ∈ Floors1 m
-  , g ∈ Floors1 m
-  , Tower m) => f a -> m [a]
-announceMortal f = do
-  t <- elevate get
-  (t', Endo e) <- runWriterT $ witherM (\obj -> MaybeT (lift $ liftM is $ elevate $ runMortal obj f)
-      >>= \(x, obj') -> lift (writer (obj', Endo (x:)))) t
-  elevate (put t')
-  return (e [])
-  where
-    is (Left ()) = Nothing
-    is (Right a) = Just a
-
--- | An object which is specialized to be a Mealy machine
-newtype Process m a b = Process { unProcess :: Object (Request a b) m }
-
--- | @_Process :: Iso' (Object (Request a b) m) (Process m a b)@
-_Process :: (Profunctor p, Functor f) => p (Process m a b) (f (Process m a b)) -> p (Object (Request a b) m) (f (Object (Request a b) m))
-_Process = dimap Process (fmap unProcess)
-
-instance Functor f => Functor (Process f a) where
-  fmap f (Process o0) = Process $ go o0 where
-    go o = Object $ \(Request a cont) -> fmap (cont *** go) $ runObject o (Request a f)
-
-instance Applicative f => Applicative (Process f a) where
-  pure a = Process go where
-    go = Object $ \(Request _ cont) -> pure (cont a, go)
-  Process f0 <*> Process a0 = Process $ go f0 a0 where
-    go mf ma = Object $ \(Request a cont) -> (\(f, mf') (x, ma') -> (cont (f x), go mf' ma'))
-      <$> runObject mf (Request a id)
-      <*> runObject ma (Request a id)
-
-instance (Applicative f, Monoid b) => Monoid (Process f a b) where
-  mempty = pure mempty
-  mappend = liftA2 mappend
-
-instance Monad m => C.Category (Process m) where
-  id = arr id
-  Process g0 . Process f0 = Process $ go f0 g0 where
-    go f g = Object $ \(Request a cont) -> runObject f (Request a id)
-      >>= \(b, f') -> liftM (\(c, g') -> (cont c, go f' g')) $ runObject g (Request b id)
-
-instance Monad m => Arrow (Process m) where
-  arr f = Process go where
-    go = Object $ \(Request a cont) -> return (cont (f a), go)
-  first (Process f0) = Process $ go f0 where
-    go f = Object $ \(Request (a, c) cont) -> liftM (\(b, f') -> (cont (b, c), go f')) $ runObject f (Request a id)
-  second (Process f0) = Process $ go f0 where
-    go f = Object $ \(Request (a, c) cont) -> liftM (\(d, f') -> (cont (a, d), go f')) $ runObject f (Request c id)
-
-instance Monad m => ArrowChoice (Process m) where
-  left (Process f0) = Process $ go f0 where
-    go f = Object $ \(Request e cont) -> case e of
-      Left a -> liftM (\(b, f') -> (cont (Left b), go f')) $ runObject f (Request a id)
-      Right c -> return (cont (Right c), go f)
-  right (Process f0) = Process $ go f0 where
-    go f = Object $ \(Request e cont) -> case e of
-      Right a -> liftM (\(b, f') -> (cont (Right b), go f')) $ runObject f (Request a id)
-      Left c -> return (cont (Left c), go f)
-
-instance Monad m => Profunctor (Process m) where
-  dimap f g (Process f0) = Process (go f0) where
-    go m = Object $ \(Request a cont) -> liftM (\(b, m') -> (cont (g b), go m')) $ runObject m (Request (f a) id)
-  {-# INLINE dimap #-}
-
-instance Monad m => Strong (Process m) where
-  first' = first
-  {-# INLINE first' #-}
-  second' = second
-  {-# INLINE second' #-}
-
-instance Monad m => Choice (Process m) where
-  left' = A.left
-  {-# INLINE left' #-}
-  right' = A.right
-  {-# INLINE right' #-}
-
-instance (Applicative m, Num o) => Num (Process m i o) where
-  (+) = liftA2 (+)
-  {-# INLINE (+) #-}
-  (-) = liftA2 (-)
-  {-# INLINE (-) #-}
-  (*) = liftA2 (*)
-  {-# INLINE (*) #-}
-  abs = fmap abs
-  {-# INLINE abs #-}
-  signum = fmap signum
-  {-# INLINE signum #-}
-  fromInteger = pure . fromInteger
-  {-# INLINE fromInteger #-}
-
-instance (Applicative m, Fractional o) => Fractional (Process m i o) where
-  (/) = liftA2 (/)
-  {-# INLINE (/) #-}
-  recip = fmap recip
-  fromRational = pure . fromRational
-
--- | Object with a final result.
---
--- @Object f g ≡ Mortal f g Void@
---
-newtype Mortal f g a = Mortal { unMortal :: Object f (EitherT a g) }
-
-instance (Functor m, Monad m) => Functor (Mortal f m) where
-  fmap f (Mortal obj) = Mortal (obj @>>^ bimapEitherT f id)
-
-instance (Functor m, Monad m) => Applicative (Mortal f m) where
-  pure = return
-  (<*>) = ap
-
-instance Monad m => Monad (Mortal f m) where
-  return a = mortal $ const $ E.left a
-  m >>= k = mortal $ \f -> lift (runMortal m f) >>= \r -> case r of
-    Left a -> EitherT $ runMortal (k a) f
-    Right (x, m') -> return (x, m' >>= k)
-
-mortal :: (forall x. f x -> EitherT a m (x, Mortal f m a)) -> Mortal f m a
-mortal f = unsafeCoerce f
-{-# INLINE mortal #-}
-
-runMortal :: Mortal f m a -> f x -> m (Either a (x, Mortal f m a))
-runMortal = unsafeCoerce
-{-# INLINE runMortal #-}
-
--- | For every adjunction f ⊣ g, we can "connect" @Object g m@ and @Object f m@ permanently.
-($$) :: (Monad m, Adjunction f g) => Object g m -> Object f m -> m x
-a $$ b = do
-  (x, a') <- runObject a askRep
-  ((), b') <- runObject b (unit () `index` x)
-  a' $$ b'
-infix 0 $$
-
--- | Like '$$', but kept until the right 'Mortal' dies.
-($$!) :: (Monad m, Adjunction f g) => Object g m -> Mortal f m a -> m (Object g m, a)
-o $$! m = do
-  (x, o') <- runObject o askRep
-  r <- runMortal m (unit () `index` x)
-  case r of
-    Left a -> return (o', a)
-    Right ((), m') -> o' $$! m'
-infix 0 $$!
-
--- | Like '$$', but kept until the left 'Mortal' dies.
-(!$$) :: (Monad m, Adjunction f g) => Mortal g m a -> Object f m -> m (a, Object f m)
-m !$$ o = do
-  r <- runMortal m askRep
-  case r of
-    Left a -> return (a, o)
-    Right (x, m') -> do
-      ((), o') <- runObject o (unit () `index` x)
-      m' !$$ o'
-infix 0 !$$
-
--- | Connect two 'Mortal's.
-(!$$!) :: (Monad m, Adjunction f g) => Mortal g m a -> Mortal f m b -> m (Either (a, Mortal f m b) (Mortal g m a, b))
-m !$$! n = do
-  r <- runMortal m askRep
-  case r of
-    Left a -> return (Left (a, n))
-    Right (x, m') -> do
-      s <- runMortal n (unit () `index` x)
-      case s of
-        Left b -> return (Right (m', b))
-        Right ((), n') -> m' !$$! n'
-
-infix 0 !$$!
+import Data.Functor.PushPull
diff --git a/src/Control/Object/Extra.hs b/src/Control/Object/Extra.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Object/Extra.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE Rank2Types, TypeOperators, FlexibleContexts, ConstraintKinds #-}
+module Control.Object.Extra where
+import Control.Object.Object
+import Control.Object.Mortal
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Map.Strict as Map
+import Data.Witherable
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Writer.Strict
+import Control.Monad.Trans.State.Strict
+import Control.Monad.Trans.Class
+import Control.Monad
+import Control.Elevator
+import Data.Functor.Request
+import Data.Functor.PushPull
+import Control.Applicative
+import Data.OpenUnion1.Clean
+import Data.Monoid
+import Data.Hashable
+import Data.Traversable as T
+
+-- | Build an object using continuation passing style.
+oneshot :: (Functor f, Monad m) => (forall a. f (m a) -> m a) -> Object f m
+oneshot m = go where
+  go = Object $ \e -> m (fmap return e) >>= \a -> return (a, go)
+{-# INLINE oneshot #-}
+
+-- | The flyweight pattern.
+flyweight :: (Monad m, Ord k) => (k -> m a) -> Object (Request k a) m
+flyweight f = go Map.empty where
+  go m = Object $ \(Request k cont) -> case Map.lookup k m of
+    Just a -> return (cont a, go m)
+    Nothing -> f k >>= \a -> return (cont a, go $ Map.insert k a m)
+
+-- | Like 'flyweight', but it uses 'Data.HashMap.Strict' internally.
+flyweight' :: (Monad m, Eq k, Hashable k) => (k -> m a) -> Object (Request k a) m
+flyweight' f = go HM.empty where
+  go m = Object $ \(Request k cont) -> case HM.lookup k m of
+    Just a -> return (cont a, go m)
+    Nothing -> f k >>= \a -> return (cont a, go $ HM.insert k a m)
+
+animate :: (Applicative m, Num t) => (t -> m a) -> Object (Request t a) m
+animate f = go 0 where
+  go t = Object $ \(Request dt cont) -> (\x -> (cont x, go (t + dt))) <$> f t
+
+transit :: (Alternative m, Fractional t, Ord t) => t -> (t -> m a) -> Object (Request t a) m
+transit len f = go 0 where
+  go t
+    | t >= len = Object $ const empty
+    | otherwise = Object $ \(Request dt cont) -> (\x -> (cont x, go (t + dt))) <$> f (t / len)
+
+announce :: (T.Traversable t, Monad m, Elevate (State (t (Object f g))) m, Elevate g m) => f a -> m [a]
+announce f = do
+  t <- elevate get
+  (t', Endo e) <- runWriterT $ T.mapM (\obj -> (lift . elevate) (runObject obj f)
+      >>= \(x, obj') -> writer (obj', Endo (x:))) t
+  elevate (put t')
+  return (e [])
+
+announceMaybe :: (Witherable t
+    , Monad m
+    , Elevate (State (t (Object f Maybe))) m) => f a -> m [a]
+announceMaybe f = elevate $ state
+  $ \t -> let (t', Endo e) = runWriter
+                $ witherM (\obj -> case runObject obj f of
+                  Just (x, obj') -> lift $ writer (obj', Endo (x:))
+                  Nothing -> mzero) t in (e [], t')
+
+announceMaybeT :: (Witherable t
+  , Monad m
+  , State (t (Object f (MaybeT g))) ∈ Floors1 m
+  , g ∈ Floors1 m
+  , Tower m) => f a -> m [a]
+announceMaybeT f = do
+  t <- elevate get
+  (t', Endo e) <- runWriterT $ witherM (\obj -> mapMaybeT (lift . elevate) (runObject obj f)
+      >>= \(x, obj') -> lift (writer (obj', Endo (x:)))) t
+  elevate (put t')
+  return (e [])
+
+announceMortal :: (Witherable t
+  , Monad m
+  , State (t (Mortal f g ())) ∈ Floors1 m
+  , g ∈ Floors1 m
+  , Tower m) => f a -> m [a]
+announceMortal f = do
+  t <- elevate get
+  (t', Endo e) <- runWriterT $ witherM (\obj -> MaybeT (lift $ liftM is $ elevate $ runMortal obj f)
+      >>= \(x, obj') -> lift (writer (obj', Endo (x:)))) t
+  elevate (put t')
+  return (e [])
+  where
+    is (Left ()) = Nothing
+    is (Right a) = Just a
+
+type Variable s = forall m. Monad m => Object (StateT s m) m
+
+-- | A mutable variable.
+variable :: s -> Variable s
+variable s = Object $ \m -> liftM (fmap variable) $ runStateT m s
+
+moore :: Applicative f => (a -> r -> f r) -> r -> Object (PushPull a r) f
+moore f = go where
+  go r = Object $ \pp -> case pp of
+    Push a c -> fmap (\z -> (c, z `seq` go z)) (f a r)
+    Pull cont -> pure (cont r, go r)
+{-# INLINE moore #-}
+
+foldPP :: Applicative f => (a -> r -> r) -> r -> Object (PushPull a r) f
+foldPP f = go where
+  go r = Object $ \pp -> case pp of
+    Push a c -> let z = f a r in pure (c, z `seq` go z)
+    Pull cont -> pure (cont r, go r)
+{-# INLINE foldPP #-}
diff --git a/src/Control/Object/Mortal.hs b/src/Control/Object/Mortal.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Object/Mortal.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE Rank2Types #-}
+module Control.Object.Mortal (
+    Mortal(..),
+    mortal,
+    mortal_,
+    runMortal,
+    immortal,
+    reincarnation
+    ) where
+
+import Control.Object.Object
+import Control.Applicative
+import Control.Monad.Trans.Either
+import Control.Monad
+import Control.Monad.Trans.Class
+import Unsafe.Coerce
+
+-- | Object with a final result.
+--
+-- @Object f g ≡ Mortal f g Void@
+--
+newtype Mortal f g a = Mortal { unMortal :: Object f (EitherT a g) }
+
+instance (Functor m, Monad m) => Functor (Mortal f m) where
+  fmap f (Mortal obj) = Mortal (obj @>>^ bimapEitherT f id)
+  {-# INLINE fmap #-}
+
+instance (Functor m, Monad m) => Applicative (Mortal f m) where
+  pure = return
+  {-# INLINE pure #-}
+  (<*>) = ap
+  {-# INLINE (<*>) #-}
+
+instance Monad m => Monad (Mortal f m) where
+  return a = mortal $ const $ left a
+  {-# INLINE return #-}
+  m >>= k = mortal $ \f -> lift (runMortal m f) >>= \r -> case r of
+    Left a -> EitherT $ runMortal (k a) f
+    Right (x, m') -> return (x, m' >>= k)
+
+mortal :: (forall x. f x -> EitherT a m (x, Mortal f m a)) -> Mortal f m a
+mortal f = unsafeCoerce f
+{-# INLINE mortal #-}
+
+runMortal :: Mortal f m a -> f x -> m (Either a (x, Mortal f m a))
+runMortal = unsafeCoerce
+{-# INLINE runMortal #-}
+
+-- | Restricted 'Mortal' constuctor, which can be applied to 'transit', 'fromFoldable' without ambiguousness.
+mortal_ :: Object f (EitherT () g) -> Mortal f g ()
+mortal_ = Mortal
+{-# INLINE mortal_ #-}
+
+immortal :: Monad m => Object f m -> Mortal f m x
+immortal obj = mortal $ \f -> EitherT $ runObject obj f >>= \(a, obj') -> return $ Right (a, immortal obj')
+
+reincarnation :: Monad m => (a -> Mortal f m a) -> a -> Object f m
+reincarnation g a0 = go (g a0) where
+  go m = Object $ \f -> runMortal m f >>= \r -> case r of
+    Left a -> runObject (go (g a)) f
+    Right (a, m') -> return (a, go m')
diff --git a/src/Control/Object/Object.hs b/src/Control/Object/Object.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Object/Object.hs
@@ -0,0 +1,170 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE Rank2Types, CPP, TypeOperators #-}
+#if __GLASGOW_HASKELL__ >= 707
+{-# LANGUAGE DeriveDataTypeable #-}
+#endif
+module Control.Object.Object where
+import Data.Functor.Day
+import Data.Functor.Coproduct
+import Control.Monad
+import Control.Monad.Free
+import Control.Monad.Operational.Mini
+import qualified Control.Monad.Trans.Free as T
+import qualified Control.Monad.Trans.Operational.Mini as T
+import Control.Monad.Trans.State.Strict
+import Data.OpenUnion1.Clean
+import Data.Typeable
+import Control.Applicative
+
+-- | The type @Object f g@ represents objects which can handle messages @f@, perform actions in the environment @g@.
+-- It can be thought of as an automaton that converts effects.
+-- 'Object's can be composed just like functions using '@>>@'; the identity element is 'echo'.
+-- Objects are morphisms of the category of functors
+newtype Object f g = Object { runObject :: forall x. f x -> g (x, Object f g) }
+#if __GLASGOW_HASKELL__ >= 707
+  deriving (Typeable)
+#else
+instance (Typeable1 f, Typeable1 g) => Typeable (Object f g) where
+  typeOf t = mkTyConApp objectTyCon [typeOf1 (f t), typeOf1 (g t)] where
+    f :: Object f g -> f a
+    f = undefined
+    g :: Object f g -> g a
+    g = undefined
+
+objectTyCon :: TyCon
+#if __GLASGOW_HASKELL__ < 704
+objectTyCon = mkTyCon "Control.Object.Object"
+#else
+objectTyCon = mkTyCon3 "objective" "Control.Object" "Object"
+#endif
+{-# NOINLINE objectTyCon #-}
+#endif
+
+-- | An alias for 'runObject'.
+(@-) :: Object f g -> f x -> g (x, Object f g)
+(@-) = runObject
+{-# INLINE (@-) #-}
+infixr 3 @-
+
+-- | The identity object
+echo :: Functor f => Object f f
+echo = Object (fmap (\x -> (x, echo)))
+
+-- | Lift a natural transformation into an object.
+liftO :: Functor g => (forall x. f x -> g x) -> Object f g
+liftO f = go where go = Object $ fmap (\x -> (x, go)) . f
+{-# INLINE liftO #-}
+
+-- | The unwrapped analog of 'stateful'
+--     @unfoldO runObject = id@
+--     @unfoldO runSequential = sequential@
+--     @unfoldO iterObject = iterable@
+unfoldO :: Functor g => (forall a. r -> f a -> g (a, r)) -> r -> Object f g
+unfoldO h = go where go r = Object $ fmap (fmap go) . h r
+{-# INLINE unfoldO #-}
+
+unfoldOM :: Monad m => (forall a. r -> f a -> m (a, r)) -> r -> Object f m
+unfoldOM h = go where go r = Object $ liftM (fmap go) . h r
+{-# INLINE unfoldOM #-}
+
+-- | Build a stateful object.
+--
+-- @stateful t s = t ^>>@ variable s@
+stateful :: Monad m => (forall a. f a -> StateT s m a) -> s -> Object f m
+stateful h = go where
+  go s = Object $ liftM (\(a, s') -> (a, go s')) . flip runStateT s . h
+{-# INLINE stateful #-}
+
+-- | Object-object composition
+(@>>@) :: Functor h => Object f g -> Object g h -> Object f h
+Object m @>>@ Object n = Object $ fmap (\((x, m'), n') -> (x, m' @>>@ n')) . n . m
+infixr 1 @>>@
+
+-- | Reversed '(@>>@)'
+(@<<@) :: Functor h => Object g h -> Object f g -> Object f h
+(@<<@) = flip (@>>@)
+{-# INLINE (@<<@) #-}
+infixl 1 @<<@
+
+
+-- | Object-function composition
+(@>>^) :: Functor h => Object f g -> (forall x. g x -> h x) -> Object f h
+m0 @>>^ g = go m0 where go (Object m) = Object $ fmap (fmap go) . g . m
+infixr 1 @>>^
+
+-- | Function-object composition
+(^>>@) :: Functor h => (forall x. f x -> g x) -> Object g h -> Object f h
+f ^>>@ m0 = go m0 where go (Object m) = Object $ fmap (fmap go) . m . f
+infixr 1 ^>>@
+
+-- | Parallel composition
+(@**@) :: Applicative m => Object f m -> Object g m -> Object (Day f g) m
+a @**@ b = Object $ \(Day f g r) -> (\(x, a') (y, b') -> (r x y, a' @**@ b')) <$> runObject a f <*> runObject b g
+infixr 3 @**@
+
+-- | Objective fanin
+(@||@) :: Functor m => Object f m -> Object g m -> Object (Coproduct f g) m
+a @||@ b = Object $ \(Coproduct r) -> case r of
+  Left f -> fmap (fmap (@||@b)) (runObject a f)
+  Right g -> fmap (fmap (a@||@)) (runObject b g)
+infixr 2 @||@
+
+-- | An object that won't accept any messages.
+loner :: Functor f => Object Nil f
+loner = liftO exhaust
+
+-- | Extend an object by another independent object.
+(@|>@) :: Functor g => Object f g -> Object (Union s) g -> Object (f |> Union s) g
+p @|>@ q = Object $ fmap (fmap (@|>@q)) . runObject p ||> fmap (fmap (p @|>@)) . runObject q
+infixr 3 @|>@
+
+-- | Build a stateful object, sharing out the state.
+sharing :: Monad m => (forall a. f a -> StateT s m a) -> s -> Object (State s |> f |> Nil) m
+sharing m = go where
+  go s = Object $ \k -> liftM (fmap go) $ ($k)
+    $ (\n -> return $ runState n s)
+    ||> (\e -> runStateT (m e) s)
+    ||> exhaust
+{-# INLINE sharing #-}
+
+(@!) :: Monad m => Object e m -> ReifiedProgram e a -> m (a, Object e m)
+obj @! Return a = return (a, obj)
+obj @! (e :>>= cont) = runObject obj e >>= \(a, obj') -> obj' @! cont a
+infixr 3 @!
+
+(@!!) :: Monad m => Object e m -> T.ReifiedProgramT e m a -> m (a, Object e m)
+obj @!! T.Return a = return (a, obj)
+obj @!! T.Lift m cont = m >>= (obj @!!) . cont
+obj @!! (e T.:>>= cont) = runObject obj e >>= \(a, obj') -> obj' @!! cont a
+infixr 3 @!!
+
+iterObject :: Monad m => Object f m -> Free f a -> m (a, Object f m)
+iterObject obj (Pure a) = return (a, obj)
+iterObject obj (Free f) = runObject obj f >>= \(cont, obj') -> iterObject obj' cont
+
+iterTObject :: Monad m => Object f m -> T.FreeT f m a -> m (a, Object f m)
+iterTObject obj m = T.runFreeT m >>= \r -> case r of
+  T.Pure a -> return (a, obj)
+  T.Free f -> runObject obj f >>= \(cont, obj') -> iterTObject obj' cont
+
+-- | Let object handle 'ReifiedProgram'.
+sequential :: Monad m => Object e m -> Object (ReifiedProgram e) m
+sequential = unfoldOM (@!)
+
+-- | Let object handle 'ReifiedProgramT'.
+sequentialT :: Monad m => Object e m -> Object (T.ReifiedProgramT e m) m
+sequentialT = unfoldOM (@!!)
+
+iterative :: Monad m => Object f m -> Object (Free f) m
+iterative = unfoldOM iterObject
+
+iterativeT :: Monad m => Object f m -> Object (T.FreeT f m) m
+iterativeT = unfoldOM iterTObject
+
+-- | Change the workspace of the object.
+transObject :: Functor g => (forall x. f x -> g x) -> Object e f -> Object e g
+transObject f = (@>>^f)
+
+-- | Apply a function to methods coming into an object.
+adaptObject :: Functor m => (forall x. g x -> f x) -> Object f m -> Object g m
+adaptObject f = (f^>>@)
diff --git a/src/Control/Object/Process.hs b/src/Control/Object/Process.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Object/Process.hs
@@ -0,0 +1,94 @@
+{-# LANGUAGE Trustworthy #-}
+module Control.Object.Process where
+import Control.Object.Object
+import Control.Arrow as A
+import qualified Control.Category as C
+import Data.Profunctor
+import Control.Applicative
+import Control.Monad
+import Data.Monoid
+import Data.Functor.Request
+
+-- | An object which is specialized to be a Mealy machine
+newtype Process m a b = Process { unProcess :: Object (Request a b) m }
+
+-- | @_Process :: Iso' (Object (Request a b) m) (Process m a b)@
+_Process :: (Profunctor p, Functor f) => p (Process m a b) (f (Process m a b)) -> p (Object (Request a b) m) (f (Object (Request a b) m))
+_Process = dimap Process (fmap unProcess)
+
+instance Functor f => Functor (Process f a) where
+  fmap f (Process o0) = Process $ go o0 where
+    go o = Object $ \(Request a cont) -> fmap (cont *** go) $ runObject o (Request a f)
+
+instance Applicative f => Applicative (Process f a) where
+  pure a = Process go where
+    go = Object $ \(Request _ cont) -> pure (cont a, go)
+  Process f0 <*> Process a0 = Process $ go f0 a0 where
+    go mf ma = Object $ \(Request a cont) -> (\(f, mf') (x, ma') -> (cont (f x), go mf' ma'))
+      <$> runObject mf (Request a id)
+      <*> runObject ma (Request a id)
+
+instance (Applicative f, Monoid b) => Monoid (Process f a b) where
+  mempty = pure mempty
+  mappend = liftA2 mappend
+
+instance Monad m => C.Category (Process m) where
+  id = arr id
+  Process g0 . Process f0 = Process $ go f0 g0 where
+    go f g = Object $ \(Request a cont) -> runObject f (Request a id)
+      >>= \(b, f') -> liftM (\(c, g') -> (cont c, go f' g')) $ runObject g (Request b id)
+
+instance Monad m => Arrow (Process m) where
+  arr f = Process go where
+    go = Object $ \(Request a cont) -> return (cont (f a), go)
+  first (Process f0) = Process $ go f0 where
+    go f = Object $ \(Request (a, c) cont) -> liftM (\(b, f') -> (cont (b, c), go f')) $ runObject f (Request a id)
+  second (Process f0) = Process $ go f0 where
+    go f = Object $ \(Request (a, c) cont) -> liftM (\(d, f') -> (cont (a, d), go f')) $ runObject f (Request c id)
+
+instance Monad m => ArrowChoice (Process m) where
+  left (Process f0) = Process $ go f0 where
+    go f = Object $ \(Request e cont) -> case e of
+      Left a -> liftM (\(b, f') -> (cont (Left b), go f')) $ runObject f (Request a id)
+      Right c -> return (cont (Right c), go f)
+  right (Process f0) = Process $ go f0 where
+    go f = Object $ \(Request e cont) -> case e of
+      Right a -> liftM (\(b, f') -> (cont (Right b), go f')) $ runObject f (Request a id)
+      Left c -> return (cont (Left c), go f)
+
+instance Monad m => Profunctor (Process m) where
+  dimap f g (Process f0) = Process (go f0) where
+    go m = Object $ \(Request a cont) -> liftM (\(b, m') -> (cont (g b), go m')) $ runObject m (Request (f a) id)
+  {-# INLINE dimap #-}
+
+instance Monad m => Strong (Process m) where
+  first' = first
+  {-# INLINE first' #-}
+  second' = second
+  {-# INLINE second' #-}
+
+instance Monad m => Choice (Process m) where
+  left' = A.left
+  {-# INLINE left' #-}
+  right' = A.right
+  {-# INLINE right' #-}
+
+instance (Applicative m, Num o) => Num (Process m i o) where
+  (+) = liftA2 (+)
+  {-# INLINE (+) #-}
+  (-) = liftA2 (-)
+  {-# INLINE (-) #-}
+  (*) = liftA2 (*)
+  {-# INLINE (*) #-}
+  abs = fmap abs
+  {-# INLINE abs #-}
+  signum = fmap signum
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
+
+instance (Applicative m, Fractional o) => Fractional (Process m i o) where
+  (/) = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip = fmap recip
+  fromRational = pure . fromRational
diff --git a/src/Control/Object/Stream.hs b/src/Control/Object/Stream.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Object/Stream.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE Trustworthy #-}
+module Control.Object.Stream where
+
+import Data.Functor.Rep
+import Data.Functor.Adjunction
+import Control.Object.Object
+import Data.Foldable as F
+import Control.Applicative
+import Data.Functor.Request
+import Control.Monad
+import Control.Monad.Trans.Either
+import Control.Object.Mortal
+
+-- | For every adjunction f ⊣ g, we can "connect" @Object g m@ and @Object f m@ permanently.
+($$) :: (Monad m, Adjunction f g) => Object g m -> Object f m -> m x
+a $$ b = do
+  (x, a') <- runObject a askRep
+  ((), b') <- runObject b (unit () `index` x)
+  a' $$ b'
+infix 1 $$
+
+($?$) :: (Monad m, Adjunction f g) => Object g (EitherT a m) -> Object f (EitherT a m) -> m a
+a $?$ b = liftM (either id id) $ runEitherT (a $$ b)
+{-# INLINE ($?$) #-}
+
+(!$$!) :: (Monad m, Adjunction f g) => Mortal g m a -> Mortal f m a -> m a
+Mortal a !$$! Mortal b = a $?$ b
+{-# INLINE (!$$!) #-}
+
+-- | Create a source from a 'Foldable' container.
+fromFoldable :: (Foldable t, Alternative m, Representable f) => t (Rep f) -> Object f m
+fromFoldable = F.foldr go $ Object $ const empty where
+  go x m = Object $ \cont -> pure (index cont x, m)
+
+mapL :: (Adjunction f g, Adjunction f' g', Functor m) => (Rep g' -> Rep g) -> Object f m -> Object f' m
+mapL t = (^>>@) $ rightAdjunct $ \x -> tabulate (index (unit x) . t)
+
+mapR :: (Representable f, Representable g, Functor m) => (Rep f -> Rep g) -> Object f m -> Object g m
+mapR t = (^>>@) $ \f -> tabulate (index f . t)
+
+filterL :: (Adjunction f g, Applicative m) => (Rep g -> Bool) -> Object f m -> Object f m
+filterL p obj = Object $ \f -> if counit (tabulate p <$ f)
+  then fmap (filterL p) `fmap` runObject obj f
+  else pure (extractL f, filterL p obj)
+
+filterR :: (Representable f, Monad m) => (Rep f -> Bool) -> Object f m -> Object f m
+filterR p obj = Object $ \f -> go f obj where
+  go f o = do
+    (x, o') <- runObject o askRep
+    if p x
+      then return (index f x, filterR p o')
+      else go f o'
+
+-- | Attack a rank-1 Mealy machine to a source.
+($$@) :: (Representable f, Representable g, Monad m) => Object f m -> Object (Request (Rep f) (Rep g)) m -> Object g m
+obj $$@ pro = Object $ \g -> do
+  (x, obj') <- runObject obj askRep
+  (a, pro') <- runObject pro $ Request x (index g)
+  return (a, obj' $$@ pro')
+
+-- | Attach a rank-1 Mealy machine into a sink.
+(@$$) :: (Adjunction f g, Adjunction f' g', Monad m) => Object (Request (Rep g') (Rep g)) m -> Object f m -> Object f' m
+pro @$$ obj = Object $ \f' -> do
+  let (a, f_) = splitL f'
+  (x, pro') <- runObject pro $ Request (counit (askRep <$ f_)) id
+  ((), obj') <- runObject obj $ unit () `index` x
+  return (a, pro' @$$ obj')
diff --git a/src/Data/Functor/PushPull.hs b/src/Data/Functor/PushPull.hs
--- a/src/Data/Functor/PushPull.hs
+++ b/src/Data/Functor/PushPull.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE DeriveFunctor, DeriveDataTypeable, ConstraintKinds, FlexibleContexts, DataKinds, TypeFamilies, TypeOperators #-}
 -----------------------------------------------------------------------------
 -- |
diff --git a/src/Data/Functor/Request.hs b/src/Data/Functor/Request.hs
--- a/src/Data/Functor/Request.hs
+++ b/src/Data/Functor/Request.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Trustworthy #-}
 {-# LANGUAGE DeriveFunctor, DeriveDataTypeable, ConstraintKinds, FlexibleContexts, TypeOperators, DataKinds, TypeFamilies #-}
 -----------------------------------------------------------------------------
 -- |