From 623aa0f2be2a01fe92af54c33577a07a06bb2849 Mon Sep 17 00:00:00 2001
From: Edward Kmett <ekmett@gmail.com>
Date: Sun, 13 Oct 2013 16:04:25 -0400
Subject: [PATCH] Initial merge of `comonad-transformers`

---
 comonad.cabal                          |  28 +++-
 coq/Store.v                            |  96 +++++++++++++
 src/Control/Comonad/Hoist/Class.hs     |  29 ++++
 src/Control/Comonad/Trans/Class.hs     |  26 ++++
 src/Control/Comonad/Trans/Cofree.hs    | 167 +++++++++++++++++++++
 src/Control/Comonad/Trans/Env.hs       | 177 +++++++++++++++++++++++
 src/Control/Comonad/Trans/Identity.hs  |  16 +++
 src/Control/Comonad/Trans/Store.hs     | 192 +++++++++++++++++++++++++
 src/Control/Comonad/Trans/Traced.hs    | 119 +++++++++++++++
 src/Control/Monad/Trans/Free.hs        | 126 ++++++++++++++++
 src/Data/Functor/Composition.hs        |  14 ++
 src/Data/Functor/Coproduct.hs          |  57 ++++++++
 src/Data/Functor/Extend/Trans/Maybe.hs |  50 +++++++
 13 files changed, 1090 insertions(+), 7 deletions(-)
 create mode 100644 coq/Store.v
 create mode 100644 src/Control/Comonad/Hoist/Class.hs
 create mode 100644 src/Control/Comonad/Trans/Class.hs
 create mode 100644 src/Control/Comonad/Trans/Cofree.hs
 create mode 100644 src/Control/Comonad/Trans/Env.hs
 create mode 100644 src/Control/Comonad/Trans/Identity.hs
 create mode 100644 src/Control/Comonad/Trans/Store.hs
 create mode 100644 src/Control/Comonad/Trans/Traced.hs
 create mode 100644 src/Control/Monad/Trans/Free.hs
 create mode 100644 src/Data/Functor/Composition.hs
 create mode 100644 src/Data/Functor/Coproduct.hs
 create mode 100644 src/Data/Functor/Extend/Trans/Maybe.hs

diff --git a/comonad.cabal b/comonad.cabal
index e01f1a7..1075065 100644
--- a/comonad.cabal
+++ b/comonad.cabal
@@ -1,6 +1,6 @@
 name:          comonad
 category:      Control, Comonads
-version:       3.1
+version:       3.2
 license:       BSD3
 cabal-version: >= 1.10
 license-file:  LICENSE
@@ -15,8 +15,11 @@ synopsis:      Haskell 98 compatible comonads
 description:   Haskell 98 compatible comonads
 build-type:    Custom
 extra-source-files:
+  .ghci
   .gitignore
   .travis.yml
+  .vim.custom
+  coq/Store.v
   README.markdown
   CHANGELOG.markdown
   examples/History.hs
@@ -36,14 +39,26 @@ library
   other-extensions: CPP
 
   build-depends:
-    base         >= 4       && < 5,
-    transformers >= 0.2     && < 0.4,
-    containers   >= 0.3     && < 0.6,
-    semigroups   >= 0.8.3   && < 1,
-    tagged       >= 0.1     && < 1
+    base          >= 4       && < 5,
+    containers    >= 0.3     && < 0.6,
+    contravariant >= 0.2.0.1 && < 1,
+    distributive  >= 0.2.2   && < 1,
+    semigroups    >= 0.8.3.1 && < 1,
+    tagged        >= 0.1     && < 1,
+    transformers  >= 0.2     && < 0.4
 
   exposed-modules:
     Control.Comonad
+    Control.Comonad.Hoist.Class
+    Control.Comonad.Trans.Class
+    Control.Comonad.Trans.Env
+    Control.Comonad.Trans.Identity
+    Control.Comonad.Trans.Store
+    Control.Comonad.Trans.Traced
+    Data.Functor.Coproduct
+    Data.Functor.Composition
+
+  extensions: CPP
 
   ghc-options: -Wall
 
@@ -65,4 +80,3 @@ test-suite doctests
 
   if impl(ghc<7.6.1)
     ghc-options: -Werror
-
diff --git a/coq/Store.v b/coq/Store.v
new file mode 100644
index 0000000..5aee85c
--- /dev/null
+++ b/coq/Store.v
@@ -0,0 +1,96 @@
+(* Proof StoreT forms a comonad -- Russell O'Connor *)
+
+Set Implict Arguments.
+Unset Strict Implicit.
+
+Require Import FunctionalExtensionality.
+
+Record Comonad (w : Type -> Type) : Type :=
+ { extract : forall a, w a -> a
+ ; extend : forall a b, (w a -> b) -> w a -> w b
+ ; law1 : forall a x, extend _ _ (extract a) x = x
+ ; law2 : forall a b f x, extract b (extend a _ f x) = f x
+ ; law3 : forall a b c f g x, extend b c f (extend a b g x) = extend a c (fun y => f (extend a b g y)) x
+ }.
+
+Section StoreT.
+
+Variables (s : Type) (w:Type -> Type).
+Hypothesis wH : Comonad w.
+
+Definition map a b f x := extend _ wH a b (fun y => f (extract _ wH _ y)) x.
+
+Lemma map_extend : forall a b c f g x, map b c f (extend _ wH a b g x) = extend _ wH _ _ (fun y => f (g y)) x.
+Proof.
+intros a b c f g x.
+unfold map.
+rewrite law3.
+apply equal_f.
+apply f_equal.
+extensionality y.
+rewrite law2.
+reflexivity.
+Qed.
+
+Record StoreT (a:Type): Type := mkStoreT
+  {store : w (s -> a)
+  ;loc   : s}.
+
+Definition extractST a (x:StoreT a) : a := 
+ extract _ wH _ (store _ x) (loc _ x).
+
+Definition mapST a b (f:a -> b) (x:StoreT a) : StoreT b :=
+ mkStoreT _ (map _ _ (fun g x => f (g x)) (store _ x)) (loc _ x).
+
+Definition duplicateST a (x:StoreT a) : StoreT (StoreT a) :=
+ mkStoreT _ (extend _ wH _ _ (mkStoreT _) (store _ x)) (loc _ x).
+
+Let extendST := fun a b f x => mapST _ b f (duplicateST a x).
+
+Lemma law1ST : forall a x, extendST _ _ (extractST a) x = x.
+Proof.
+intros a [v b].
+unfold extractST, extendST, duplicateST, mapST.
+simpl.
+rewrite map_extend.
+simpl.
+replace (fun (y : w (s -> a)) (x : s) => extract w wH (s -> a) y x)
+ with (extract w wH (s -> a)).
+ rewrite law1.
+ reflexivity.
+extensionality y.
+extensionality x.
+reflexivity.
+Qed.
+
+Lemma law2ST : forall a b f x, extractST b (extendST a _ f x) = f x.
+Proof.
+intros a b f [v c].
+unfold extendST, mapST, extractST.
+simpl.
+rewrite map_extend.
+rewrite law2.
+reflexivity.
+Qed.
+
+Lemma law3ST : forall a b c f g x, extendST b c f (extendST a b g x) = extendST a c (fun y => f (extendST a b g y)) x.
+Proof.
+intros a b c f g [v d].
+unfold extendST, mapST, extractST.
+simpl.
+repeat rewrite map_extend.
+rewrite law3.
+repeat (apply equal_f||apply f_equal).
+extensionality y.
+extensionality x.
+rewrite map_extend.
+reflexivity.
+Qed.
+
+Definition StoreTComonad : Comonad StoreT :=
+ Build_Comonad _ _ _ law1ST law2ST law3ST.
+
+End StoreT.
+
+Check StoreTComonad.
+
diff --git a/src/Control/Comonad/Hoist/Class.hs b/src/Control/Comonad/Hoist/Class.hs
new file mode 100644
index 0000000..a2b85c9
--- /dev/null
+++ b/src/Control/Comonad/Hoist/Class.hs
@@ -0,0 +1,29 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Comonad.Hoist.Class
+-- Copyright   :  (C) 2008-2011 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+----------------------------------------------------------------------------
+module Control.Comonad.Hoist.Class (ComonadHoist(..)) where
+
+import Control.Comonad
+import Control.Monad.Trans.Identity
+import Data.Functor.Identity
+
+class ComonadHoist t where
+  -- | Ideally we would offer a way to lift comonad homomorphisms
+  -- but this isn't Haskell 98, so we settle for the most common case
+  -- here.
+  --
+  -- > liftTrans :: (forall a. w a -> v a) -> t w a -> t v a 
+  -- > cohoist = liftTrans (Identity . extract)
+  cohoist :: Comonad w => t w a -> t Identity a
+
+-- avoiding orphans
+
+instance ComonadHoist IdentityT where
+  cohoist = IdentityT . Identity . extract . runIdentityT
diff --git a/src/Control/Comonad/Trans/Class.hs b/src/Control/Comonad/Trans/Class.hs
new file mode 100644
index 0000000..583428b
--- /dev/null
+++ b/src/Control/Comonad/Trans/Class.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE CPP #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Comonad.Trans.Class
+-- Copyright   :  (C) 2008-2011 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+----------------------------------------------------------------------------
+module Control.Comonad.Trans.Class
+  ( ComonadTrans(..) ) where
+
+import Control.Comonad
+import Control.Monad.Trans.Identity
+
+class ComonadTrans t where
+  lower :: Comonad w => t w a -> w a
+
+-- avoiding orphans
+instance ComonadTrans IdentityT where
+  lower = runIdentityT
diff --git a/src/Control/Comonad/Trans/Cofree.hs b/src/Control/Comonad/Trans/Cofree.hs
new file mode 100644
index 0000000..2226d9e
--- /dev/null
+++ b/src/Control/Comonad/Trans/Cofree.hs
@@ -0,0 +1,167 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Comonad.Trans.Cofree
+-- Copyright   :  (C) 2008-2012 Edward Kmett,
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Haskell 98 cofree comonads
+--
+----------------------------------------------------------------------------
+module Control.Comonad.Trans.Cofree
+  ( Cofree(..)
+  , section
+  , unwrap
+  , coiter
+  , unfold
+  ) where
+
+import Control.Applicative
+import Control.Comonad
+import Control.Comonad.Trans.Class
+import Data.Functor.Bind
+import Data.Distributive
+import Data.Foldable
+import Data.Semigroup
+import Data.Traversable
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+
+#ifdef GHC_TYPEABLE
+import Data.Data
+#endif
+
+infixr 5 :<
+
+data Cofree f a = a :< f (Cofree f a)
+
+unwrap :: Cofree f a -> f (Cofree f a)
+unwrap (_ :< as) = as
+
+coiter :: Functor f => (a -> f a) -> a -> Cofree f a
+coiter psi a = a :< (coiter psi <$> psi a)
+
+unfold :: Functor f => (b -> (a, f b)) -> b -> Cofree f a
+unfold f c = case f c of
+  (x, d) -> x :< fmap (unfold f) d
+
+instance Distributive f => Distributive (Cofree f) where
+  distribute w = fmap extract w :< fmap distribute (collect unwrap w)
+
+instance Functor f => Functor (Cofree f) where
+  fmap f (a :< as) = f a :< fmap (fmap f) as
+  b <$ (_ :< as) = b :< fmap (b <$) as
+
+instance Functor f => Extend (Cofree f) where
+  extended f w = f w :< fmap (extended f) (unwrap w)
+  duplicated w = w :< fmap duplicated (unwrap w)
+
+instance Functor f => Comonad (Cofree f) where
+  extend f w = f w :< fmap (extend f) (unwrap w)
+  duplicate w = w :< fmap duplicate (unwrap w)
+  extract (a :< _) = a
+
+instance ComonadTrans Cofree where
+  lower (_ :< as) = fmap extract as
+
+-- | lower . section = id
+section :: Comonad f => f a -> Cofree f a
+section as = extract as :< extend section as
+
+instance Apply f => Apply (Cofree f) where
+  (f :< fs) <.> (a :< as) = f a :< ((<.>) <$> fs <.> as)
+  (f :< fs) <.  (_ :< as) = f :< ((<. ) <$> fs <.> as)
+  (_ :< fs)  .> (a :< as) = a :< (( .>) <$> fs <.> as)
+
+instance ComonadApply f => ComonadApply (Cofree f) where
+  (f :< fs) <@> (a :< as) = f a :< ((<@>) <$> fs <@> as)
+  (f :< fs) <@  (_ :< as) = f :< ((<@ ) <$> fs <@> as)
+  (_ :< fs)  @> (a :< as) = a :< (( @>) <$> fs <@> as)
+
+instance Applicative f => Applicative (Cofree f) where
+  pure a = as where as = a :< pure as
+  (f :< fs) <*> (a :< as) = f a :< ((<*>) <$> fs <*> as)
+  (f :< fs) <*  (_ :< as) = f :< ((<* ) <$> fs <*> as)
+  (_ :< fs)  *> (a :< as) = a :< (( *>) <$> fs <*> as)
+
+instance (Show (f (Cofree f a)), Show a) => Show (Cofree f a) where
+  showsPrec d (a :< as) = showParen (d > 5) $
+    showsPrec 6 a . showString " :< " . showsPrec 5 as
+
+instance (Read (f (Cofree f a)), Read a) => Read (Cofree f a) where
+  readsPrec d r = readParen (d > 5)
+                          (\r' -> [(u :< v,w) |
+                                  (u, s) <- readsPrec 6 r',
+                                  (":<", t) <- lex s,
+                                  (v, w) <- readsPrec 5 t]) r
+
+instance (Eq (f (Cofree f a)), Eq a) => Eq (Cofree f a) where
+  a :< as == b :< bs = a == b && as == bs
+
+instance (Ord (f (Cofree f a)), Ord a) => Ord (Cofree f a) where
+  compare (a :< as) (b :< bs) = case compare a b of
+    LT -> LT
+    EQ -> compare as bs
+    GT -> GT
+
+instance Foldable f => Foldable (Cofree f) where
+  foldMap f (a :< as) = f a `mappend` foldMap (foldMap f) as
+
+instance Foldable1 f => Foldable1 (Cofree f) where
+  foldMap1 f (a :< as) = f a <> foldMap1 (foldMap1 f) as
+
+instance Traversable f => Traversable (Cofree f) where
+  traverse f (a :< as) = (:<) <$> f a <*> traverse (traverse f) as
+
+instance Traversable1 f => Traversable1 (Cofree f) where
+  traverse1 f (a :< as) = (:<) <$> f a <.> traverse1 (traverse1 f) as
+
+#ifdef GHC_TYPEABLE
+instance (Typeable1 f) => Typeable1 (Cofree f) where
+  typeOf1 dfa = mkTyConApp cofreeTyCon [typeOf1 (f dfa)]
+    where
+      f :: Cofree f a -> f a
+      f = undefined
+
+instance (Typeable1 f, Typeable a) => Typeable (Cofree f a) where
+  typeOf = typeOfDefault
+
+cofreeTyCon :: TyCon
+#if __GLASGOW_HASKELL < 704
+cofreeTyCon = mkTyCon "Control.Comonad.Trans.Cofree.Cofree"
+#else
+cofreeTyCon = mkTyCon3 "comonad-transformers" "Control.Comonad.Trans.Cofree" "Cofree"
+#endif
+{-# NOINLINE cofreeTyCon #-}
+
+instance
+  ( Typeable1 f
+  , Data (f (Cofree f a))
+  , Data a
+  ) => Data (Cofree f a) where
+    gfoldl f z (a :< as) = z (:<) `f` a `f` as
+    toConstr _ = cofreeConstr
+    gunfold k z c = case constrIndex c of
+        1 -> k (k (z (:<)))
+        _ -> error "gunfold"
+    dataTypeOf _ = cofreeDataType
+    dataCast1 f = gcast1 f
+
+cofreeConstr :: Constr
+cofreeConstr = mkConstr cofreeDataType ":<" [] Infix
+{-# NOINLINE cofreeConstr #-}
+
+cofreeDataType :: DataType
+cofreeDataType = mkDataType "Control.Comonad.Trans.Cofree.Cofree" [cofreeConstr]
+{-# NOINLINE cofreeDataType #-}
+#endif
diff --git a/src/Control/Comonad/Trans/Env.hs b/src/Control/Comonad/Trans/Env.hs
new file mode 100644
index 0000000..ae8646f
--- /dev/null
+++ b/src/Control/Comonad/Trans/Env.hs
@@ -0,0 +1,177 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+#if __GLASGOW_HASKELL__ >= 707
+{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}
+#endif
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Comonad.Trans.Env
+-- Copyright   :  (C) 2008-2013 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- The environment comonad holds a value along with some retrievable context.
+--
+-- This module specifies the environment comonad transformer (aka coreader),
+-- which is left adjoint to the reader comonad.
+--
+-- The following sets up an experiment that retains its initial value in the
+-- background:
+--
+-- >>> let initial = env 0 0
+--
+-- Extract simply retrieves the value:
+--
+-- >>> extract initial
+-- 0
+--
+-- Play around with the value, in our case producing a negative value:
+--
+-- >>> let experiment = fmap (+ 10) initial
+-- >>> extract experiment
+-- 10
+--
+-- Oh noes, something went wrong, 10 isn't very negative! Better restore the
+-- initial value using the default:
+--
+-- >>> let initialRestored = experiment =>> ask
+-- >>> extract initialRestored
+-- 0
+----------------------------------------------------------------------------
+module Control.Comonad.Trans.Env
+  (
+  -- * The strict environment comonad
+    Env
+  , env
+  , runEnv
+  -- * The strict environment comonad transformer
+  , EnvT(..)
+  , runEnvT
+  , lowerEnvT
+  -- * Combinators
+  , ask
+  , asks
+  , local
+  ) where
+
+import Control.Comonad
+import Control.Comonad.Hoist.Class
+import Control.Comonad.Trans.Class
+import Data.Foldable
+import Data.Traversable
+import Data.Functor.Identity
+import Data.Semigroup
+
+#ifdef __GLASGOW_HASKELL__
+#if __GLASGOW_HASKELL__ >= 707
+#define Typeable1 Typeable
+#endif
+import Data.Data
+
+#if __GLASGOW_HASKELL__ >= 707
+deriving instance Typeable EnvT
+#else
+instance (Typeable s, Typeable1 w) => Typeable1 (EnvT s w) where
+  typeOf1 dswa = mkTyConApp envTTyCon [typeOf (s dswa), typeOf1 (w dswa)]
+    where
+      s :: EnvT s w a -> s
+      s = undefined
+      w :: EnvT s w a -> w a
+      w = undefined
+#endif
+
+envTTyCon :: TyCon
+#if __GLASGOW_HASKELL__ < 704
+envTTyCon = mkTyCon "Control.Comonad.Trans.Env.EnvT"
+#else
+envTTyCon = mkTyCon3 "comonad-transformers" "Control.Comonad.Trans.Env" "EnvT"
+#endif
+{-# NOINLINE envTTyCon #-}
+
+#if __GLASGOW_HASKELL__ < 707
+instance (Typeable s, Typeable1 w, Typeable a) => Typeable (EnvT s w a) where
+  typeOf = typeOfDefault
+#endif
+
+instance
+  ( Data e
+  , Typeable1 w, Data (w a)
+  , Data a
+  ) => Data (EnvT e w a) where
+    gfoldl f z (EnvT e wa) = z EnvT `f` e `f` wa
+    toConstr _ = envTConstr
+    gunfold k z c = case constrIndex c of
+        1 -> k (k (z EnvT))
+        _ -> error "gunfold"
+    dataTypeOf _ = envTDataType
+    dataCast1 f = gcast1 f
+
+envTConstr :: Constr
+envTConstr = mkConstr envTDataType "EnvT" [] Prefix
+{-# NOINLINE envTConstr #-}
+
+envTDataType :: DataType
+envTDataType = mkDataType "Control.Comonad.Trans.Env.EnvT" [envTConstr]
+{-# NOINLINE envTDataType #-}
+
+#endif
+
+type Env e = EnvT e Identity
+data EnvT e w a = EnvT e (w a)
+
+-- | Create an Env using an environment and a value
+env :: e -> a -> Env e a
+env e a = EnvT e (Identity a)
+
+runEnv :: Env e a -> (e, a)
+runEnv (EnvT e (Identity a)) = (e, a)
+
+runEnvT :: EnvT e w a -> (e, w a)
+runEnvT (EnvT e wa) = (e, wa)
+
+instance Functor w => Functor (EnvT e w) where
+  fmap g (EnvT e wa) = EnvT e (fmap g wa)
+
+instance Comonad w => Comonad (EnvT e w) where
+  duplicate (EnvT e wa) = EnvT e (extend (EnvT e) wa)
+  extract (EnvT _ wa) = extract wa
+
+instance ComonadTrans (EnvT e) where
+  lower (EnvT _ wa) = wa
+
+-- | Gets rid of the environment. This differs from 'extract' in that it will
+--   not continue extracting the value from the contained comonad.
+lowerEnvT :: EnvT e w a -> w a
+lowerEnvT (EnvT _ wa) = wa
+
+instance ComonadHoist (EnvT e) where
+  cohoist (EnvT e wa) = EnvT e (Identity (extract wa))
+
+instance (Semigroup e, ComonadApply w) => ComonadApply (EnvT e w) where
+  EnvT ef wf <@> EnvT ea wa = EnvT (ef <> ea) (wf <@> wa)
+
+instance Foldable w => Foldable (EnvT e w) where
+  foldMap f (EnvT _ w) = foldMap f w
+
+instance Traversable w => Traversable (EnvT e w) where
+  traverse f (EnvT e w) = EnvT e <$> traverse f w
+
+-- | Retrieves the environment.
+ask :: EnvT e w a -> e
+ask (EnvT e _) = e
+
+-- | Like 'ask', but modifies the resulting value with a function.
+--
+--   > asks = f . ask
+asks :: (e -> f) -> EnvT e w a -> f
+asks f (EnvT e _) = f e
+
+-- | Modifies the environment using the specified function.
+local :: (e -> e') -> EnvT e w a -> EnvT e' w a
+local f (EnvT e wa) = EnvT (f e) wa
diff --git a/src/Control/Comonad/Trans/Identity.hs b/src/Control/Comonad/Trans/Identity.hs
new file mode 100644
index 0000000..6aa0cca
--- /dev/null
+++ b/src/Control/Comonad/Trans/Identity.hs
@@ -0,0 +1,16 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Comonad.Trans.Identity
+-- Copyright   :  (C) 2008-2011 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+----------------------------------------------------------------------------
+module Control.Comonad.Trans.Identity
+  ( IdentityT(..)
+  ) where
+
+import Control.Monad.Trans.Identity
diff --git a/src/Control/Comonad/Trans/Store.hs b/src/Control/Comonad/Trans/Store.hs
new file mode 100644
index 0000000..00ba47b
--- /dev/null
+++ b/src/Control/Comonad/Trans/Store.hs
@@ -0,0 +1,192 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 707
+{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}
+#endif
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Comonad.Trans.Store
+-- Copyright   :  (C) 2008-2013 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+--
+-- The store comonad holds a constant value along with a modifiable /accessor/
+-- function, which maps the /stored value/ to the /focus/.
+--
+-- This module defines the strict store (aka state-in-context/costate) comonad
+-- transformer.
+--
+-- @stored value = (1, 5)@, @accessor = fst@, @resulting focus = 1@:
+--
+-- > storeTuple :: Store (Int, Int) Int
+-- > storeTuple = store fst (1, 5)
+--
+-- Add something to the focus:
+--
+-- > addToFocus :: Int -> Store (Int, Int) Int -> Int
+-- > addToFocus x wa = x + extract wa
+-- >
+-- > added3 :: Store (Int, Int) Int
+-- > added3 = extend (addToFocus 3) storeTuple
+--
+-- The focus of added3 is now @1 + 3 = 4@. However, this action changed only
+-- the accessor function and therefore the focus but not the stored value:
+--
+-- >>> pos added3
+-- (1, 5)
+-- >>> extract added3
+-- 4
+--
+-- The strict store (state-in-context/costate) comonad transformer is subject
+-- to the laws:
+--
+-- > x = seek (pos x) x
+-- > y = pos (seek y x)
+-- > seek y x = seek y (seek z x)
+--
+-- Thanks go to Russell O'Connor and Daniel Peebles for their help formulating
+-- and proving the laws for this comonad transformer.
+----------------------------------------------------------------------------
+module Control.Comonad.Trans.Store
+  (
+  -- * The Store comonad
+    Store, store, runStore
+  -- * The Store comonad transformer
+  , StoreT(..), runStoreT
+  -- * Operations
+  , pos
+  , seek, seeks
+  , peek, peeks
+  , experiment
+  ) where
+
+import Control.Applicative
+import Control.Comonad
+import Control.Comonad.Hoist.Class
+import Control.Comonad.Trans.Class
+import Data.Functor.Identity
+import Data.Semigroup
+
+#ifdef __GLASGOW_HASKELL__
+import Data.Typeable
+
+#if __GLASGOW_HASKELL__ >= 707
+deriving instance Typeable StoreT
+#else
+instance (Typeable s, Typeable1 w) => Typeable1 (StoreT s w) where
+  typeOf1 dswa = mkTyConApp storeTTyCon [typeOf (s dswa), typeOf1 (w dswa)]
+    where
+      s :: StoreT s w a -> s
+      s = undefined
+      w :: StoreT s w a -> w a
+      w = undefined
+
+instance (Typeable s, Typeable1 w, Typeable a) => Typeable (StoreT s w a) where
+  typeOf = typeOfDefault
+
+storeTTyCon :: TyCon
+#if __GLASGOW_HASKELL__ < 704
+storeTTyCon = mkTyCon "Control.Comonad.Trans.Store.StoreT"
+#else
+storeTTyCon = mkTyCon3 "comonad-transformers" "Control.Comonad.Trans.Store" "StoreT"
+#endif
+{-# NOINLINE storeTTyCon #-}
+#endif
+
+#endif
+
+type Store s = StoreT s Identity
+
+-- | Create a Store using an accessor function and a stored value
+store :: (s -> a) -> s -> Store s a
+store f s = StoreT (Identity f) s
+
+runStore :: Store s a -> (s -> a, s)
+runStore (StoreT (Identity f) s) = (f, s)
+
+data StoreT s w a = StoreT (w (s -> a)) s
+
+runStoreT :: StoreT s w a -> (w (s -> a), s)
+runStoreT (StoreT wf s) = (wf, s)
+
+instance Functor w => Functor (StoreT s w) where
+  fmap f (StoreT wf s) = StoreT (fmap (f .) wf) s
+
+instance (ComonadApply w, Semigroup s) => ComonadApply (StoreT s w) where
+  StoreT ff m <@> StoreT fa n = StoreT ((<*>) <$> ff <@> fa) (m <> n)
+
+instance (Applicative w, Monoid s) => Applicative (StoreT s w) where
+  pure a = StoreT (pure (const a)) mempty
+  StoreT ff m <*> StoreT fa n = StoreT ((<*>) <$> ff <*> fa) (mappend m n)
+
+instance Comonad w => Comonad (StoreT s w) where
+  duplicate (StoreT wf s) = StoreT (extend StoreT wf) s
+  extend f (StoreT wf s) = StoreT (extend (\wf' s' -> f (StoreT wf' s')) wf) s
+  extract (StoreT wf s) = extract wf s
+
+instance ComonadTrans (StoreT s) where
+  lower (StoreT f s) = fmap ($ s) f
+
+instance ComonadHoist (StoreT s) where
+  cohoist (StoreT f s) = StoreT (Identity (extract f)) s
+
+-- | Read the stored value
+--
+-- >>> pos $ store fst (1,5)
+-- (1,5)
+--
+pos :: StoreT s w a -> s
+pos (StoreT _ s) = s
+
+-- | Set the stored value
+--
+-- >>> pos . seek (3,7) $ store fst (1,5)
+-- (3,7)
+--
+-- Seek satisfies the law
+--
+-- > seek s = peek s . duplicate
+seek :: s -> StoreT s w a -> StoreT s w a
+seek s ~(StoreT f _) = StoreT f s
+
+-- | Modify the stored value
+--
+-- >>> pos . seeks swap $ store fst (1,5)
+-- (5,1)
+--
+-- Seeks satisfies the law
+--
+-- > seeks f = peeks f . duplicate
+seeks :: (s -> s) -> StoreT s w a -> StoreT s w a
+seeks f ~(StoreT g s) = StoreT g (f s)
+
+-- | Peek at what the current focus would be for a different stored value
+--
+-- Peek satisfies the law
+--
+-- > peek x . extend (peek y) = peek y
+peek :: Comonad w => s -> StoreT s w a -> a
+peek s (StoreT g _) = extract g s
+
+
+-- | Peek at what the current focus would be if the stored value was
+--   modified by some function
+peeks :: Comonad w => (s -> s) -> StoreT s w a -> a
+peeks f ~(StoreT g s) = extract g (f s)
+
+-- | Applies a functor-valued function to the stored value, and then uses the
+--   new accessor to read the resulting focus.
+--
+--   >>> let f x = if x > 0 then Just (x^2) else Nothing
+--   >>> experiment f $ store (+1) 2
+--   Just 5
+--   >>> experiment f $ store (+1) (-2)
+--   Nothing
+experiment :: (Comonad w, Functor f) => (s -> f s) -> StoreT s w a -> f a
+experiment f (StoreT wf s) = extract wf <$> f s
diff --git a/src/Control/Comonad/Trans/Traced.hs b/src/Control/Comonad/Trans/Traced.hs
new file mode 100644
index 0000000..d9d8b0b
--- /dev/null
+++ b/src/Control/Comonad/Trans/Traced.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 707
+{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-}
+#endif
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Comonad.Trans.Traced
+-- Copyright   :  (C) 2008-2013 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- The trace comonad builds up a result by prepending monoidal values to each
+-- other.
+--
+-- This module specifies the traced comonad transformer (aka the cowriter or
+-- exponential comonad transformer).
+--
+----------------------------------------------------------------------------
+module Control.Comonad.Trans.Traced
+  (
+  -- * Traced comonad
+    Traced
+  , traced
+  , runTraced
+  -- * Traced comonad transformer
+  , TracedT(..)
+  -- * Operations
+  , trace
+  , listen
+  , listens
+  , censor
+  ) where
+
+import Control.Applicative
+import Control.Monad.Instances ()
+import Control.Monad (ap)
+import Control.Comonad
+import Control.Comonad.Hoist.Class
+import Control.Comonad.Trans.Class
+import Data.Distributive
+import Data.Functor.Identity
+import Data.Semigroup
+import Data.Typeable
+
+type Traced m = TracedT m Identity
+
+traced :: (m -> a) -> Traced m a
+traced f = TracedT (Identity f)
+
+runTraced :: Traced m a -> m -> a
+runTraced (TracedT (Identity f)) = f
+
+newtype TracedT m w a = TracedT { runTracedT :: w (m -> a) }
+
+instance Functor w => Functor (TracedT m w) where
+  fmap g = TracedT . fmap (g .) . runTracedT
+
+instance (ComonadApply w, Monoid m) => ComonadApply (TracedT m w) where
+  TracedT wf <@> TracedT wa = TracedT (ap <$> wf <@> wa)
+
+instance Applicative w => Applicative (TracedT m w) where
+  pure = TracedT . pure . const
+  TracedT wf <*> TracedT wa = TracedT (ap <$> wf <*> wa)
+
+instance (Comonad w, Monoid m) => Comonad (TracedT m w) where
+  extend f = TracedT . extend (\wf m -> f (TracedT (fmap (. mappend m) wf))) . runTracedT
+  extract (TracedT wf) = extract wf mempty
+
+instance Monoid m => ComonadTrans (TracedT m) where
+  lower = fmap ($ mempty) . runTracedT
+
+instance Monoid m => ComonadHoist (TracedT m) where
+  cohoist = traced . extract . runTracedT
+
+instance Distributive w => Distributive (TracedT m w) where
+  distribute = TracedT . fmap (\tma m -> fmap ($ m) tma) . collect runTracedT
+
+trace :: Comonad w => m -> TracedT m w a -> a
+trace m (TracedT wf) = extract wf m
+
+listen :: Functor w => TracedT m w a -> TracedT m w (a, m)
+listen = TracedT . fmap (\f m -> (f m, m)) . runTracedT
+
+listens :: Functor w => (m -> b) -> TracedT m w a -> TracedT m w (a, b)
+listens g = TracedT . fmap (\f m -> (f m, g m)) . runTracedT
+
+censor :: Functor w => (m -> m) -> TracedT m w a -> TracedT m w a
+censor g = TracedT . fmap (. g) . runTracedT
+
+#ifdef __GLASGOW_HASKELL__
+
+#if __GLASGOW_HASKELL__ >= 707
+deriving instance Typeable TracedT
+#else
+instance (Typeable s, Typeable1 w) => Typeable1 (TracedT s w) where
+  typeOf1 dswa = mkTyConApp tracedTTyCon [typeOf (s dswa), typeOf1 (w dswa)]
+    where
+      s :: TracedT s w a -> s
+      s = undefined
+      w :: TracedT s w a -> w a
+      w = undefined
+
+tracedTTyCon :: TyCon
+#if __GLASGOW_HASKELL__ < 704
+tracedTTyCon = mkTyCon "Control.Comonad.Trans.Traced.TracedT"
+#else
+tracedTTyCon = mkTyCon3 "comonad-transformers" "Control.Comonad.Trans.Traced" "TracedT"
+#endif
+{-# NOINLINE tracedTTyCon #-}
+
+#endif
+
+#endif
diff --git a/src/Control/Monad/Trans/Free.hs b/src/Control/Monad/Trans/Free.hs
new file mode 100644
index 0000000..389fba3
--- /dev/null
+++ b/src/Control/Monad/Trans/Free.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Control.Monad.Trans.Free
+-- Copyright   :  (C) 2008-2011 Edward Kmett,
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Haskell 98 free monads
+--
+----------------------------------------------------------------------------
+module Control.Monad.Trans.Free
+  ( Free(..)
+  , retract
+  , liftF
+  , iter
+  , wrap
+  ) where
+
+import Control.Applicative
+import Control.Monad (liftM, MonadPlus(..))
+import Control.Monad.Trans.Class
+import Data.Functor.Bind
+import Data.Foldable
+import Data.Traversable
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+
+data Free f a = Pure a | Free (f (Free f a))
+
+instance (Eq (f (Free f a)), Eq a) => Eq (Free f a) where
+  Pure a == Pure b = a == b
+  Free fa == Free fb = fa == fb
+  _ == _ = False
+
+instance (Ord (f (Free f a)), Ord a) => Ord (Free f a) where
+  Pure a `compare` Pure b = a `compare` b
+  Pure _ `compare` Free _ = LT
+  Free _ `compare` Pure _ = GT
+  Free fa `compare` Free fb = fa `compare` fb
+
+instance (Show (f (Free f a)), Show a) => Show (Free f a) where
+  showsPrec d (Pure a) = showParen (d > 10) $
+    showString "Pure " . showsPrec 11 a
+  showsPrec d (Free m) = showParen (d > 10) $
+    showString "Free " . showsPrec 11 m
+
+instance (Read (f (Free f a)), Read a) => Read (Free f a) where
+  readsPrec d r = readParen (d > 10)
+      (\r' -> [ (Pure m, t) 
+             | ("Pure", s) <- lex r'
+             , (m, t) <- readsPrec 11 s]) r
+    ++ readParen (d > 10)
+      (\r' -> [ (Free m, t)
+             | ("Free", s) <- lex r'
+             , (m, t) <- readsPrec 11 s]) r
+
+instance Functor f => Functor (Free f) where
+  fmap f (Pure a)  = Pure (f a)
+  fmap f (Free fa) = Free (fmap f <$> fa)
+
+instance Functor f => Apply (Free f) where
+  Pure a  <.> Pure b = Pure (a b)
+  Pure a  <.> Free fb = Free $ fmap a <$> fb
+  Free fa <.> b = Free $ (<.> b) <$> fa
+  
+instance Functor f => Applicative (Free f) where
+  pure = Pure
+  Pure a <*> Pure b = Pure $ a b
+  Pure a <*> Free mb = Free $ fmap a <$> mb
+  Free ma <*> b = Free $ (<*> b) <$> ma
+
+instance Functor f => Bind (Free f) where
+  Pure a >>- f = f a
+  Free m >>- f = Free ((>>- f) <$> m)
+  
+instance Functor f => Monad (Free f) where
+  return = Pure
+  Pure a >>= f = f a
+  Free m >>= f = Free ((>>= f) <$> m)
+
+instance Alternative v => Alternative (Free v) where
+  empty = Free empty
+  a <|> b = Free (pure a <|> pure b)
+
+instance (Functor v, MonadPlus v) => MonadPlus (Free v) where
+  mzero = Free mzero
+  a `mplus` b = Free (return a `mplus` return b)
+
+instance MonadTrans Free where
+  lift = Free . liftM Pure
+
+instance Foldable f => Foldable (Free f) where
+  foldMap f (Pure a) = f a
+  foldMap f (Free fa) = foldMap (foldMap f) fa
+
+instance Foldable1 f => Foldable1 (Free f) where
+  foldMap1 f (Pure a) = f a
+  foldMap1 f (Free fa) = foldMap1 (foldMap1 f) fa
+
+instance Traversable f => Traversable (Free f) where
+  traverse f (Pure a) = Pure <$> f a 
+  traverse f (Free fa) = Free <$> traverse (traverse f) fa
+
+instance Traversable1 f => Traversable1 (Free f) where
+  traverse1 f (Pure a) = Pure <$> f a
+  traverse1 f (Free fa) = Free <$> traverse1 (traverse1 f) fa
+
+liftF :: Functor f => f a -> Free f a
+liftF = Free . fmap Pure
+
+wrap :: f (Free f a) -> Free f a 
+wrap = Free
+
+-- | retract . lift = id
+-- | retract . liftF = id
+retract :: Monad f => Free f a -> f a
+retract (Pure a) = return a
+retract (Free as) = as >>= retract
+
+iter :: Functor f => (f a -> a) -> Free f a -> a
+iter _ (Pure a) = a
+iter phi (Free m) = phi (iter phi <$> m)
diff --git a/src/Data/Functor/Composition.hs b/src/Data/Functor/Composition.hs
new file mode 100644
index 0000000..0d4bf54
--- /dev/null
+++ b/src/Data/Functor/Composition.hs
@@ -0,0 +1,14 @@
+module Data.Functor.Composition
+  ( Composition(..) ) where
+
+import Data.Functor.Compose
+
+-- | We often need to distinguish between various forms of Functor-like composition in Haskell in order to please the type system.
+-- This lets us work with these representations uniformly.
+class Composition o where
+  decompose :: o f g x -> f (g x)
+  compose :: f (g x) -> o f g x
+
+instance Composition Compose where
+  decompose = getCompose
+  compose = Compose
diff --git a/src/Data/Functor/Coproduct.hs b/src/Data/Functor/Coproduct.hs
new file mode 100644
index 0000000..0640244
--- /dev/null
+++ b/src/Data/Functor/Coproduct.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE CPP #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Coproduct
+-- Copyright   :  (C) 2008-2011 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+----------------------------------------------------------------------------
+module Data.Functor.Coproduct
+  ( Coproduct(..)
+  , left
+  , right
+  , coproduct
+  ) where
+
+import Control.Comonad
+import Data.Functor.Contravariant
+import Data.Foldable
+import Data.Traversable
+
+newtype Coproduct f g a = Coproduct { getCoproduct :: Either (f a) (g a) }
+  deriving (Eq, Ord, Read, Show)
+
+left :: f a -> Coproduct f g a
+left = Coproduct . Left
+
+right :: g a -> Coproduct f g a
+right = Coproduct . Right
+
+coproduct :: (f a -> b) -> (g a -> b) -> Coproduct f g a -> b
+coproduct f g = either f g . getCoproduct
+
+instance (Functor f, Functor g) => Functor (Coproduct f g) where
+  fmap f = Coproduct . coproduct (Left . fmap f) (Right . fmap f)
+
+instance (Foldable f, Foldable g) => Foldable (Coproduct f g) where
+  foldMap f = coproduct (foldMap f) (foldMap f)
+
+instance (Traversable f, Traversable g) => Traversable (Coproduct f g) where
+  traverse f = coproduct
+    (fmap (Coproduct . Left) . traverse f)
+    (fmap (Coproduct . Right) . traverse f)
+
+instance (Comonad f, Comonad g) => Comonad (Coproduct f g) where
+  extend f = Coproduct . coproduct
+    (Left . extend (f . Coproduct . Left))
+    (Right . extend (f . Coproduct . Right))
+  extract = coproduct extract extract
+
+instance (Contravariant f, Contravariant g) => Contravariant (Coproduct f g) where
+  contramap f = Coproduct . coproduct (Left . contramap f) (Right . contramap f)
diff --git a/src/Data/Functor/Extend/Trans/Maybe.hs b/src/Data/Functor/Extend/Trans/Maybe.hs
new file mode 100644
index 0000000..9df590c
--- /dev/null
+++ b/src/Data/Functor/Extend/Trans/Maybe.hs
@@ -0,0 +1,50 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Functor.Extend.Trans.Maybe
+-- Copyright   :  (C) 2008-2011 Edward Kmett
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
+-- Stability   :  provisional
+-- Portability :  portable
+----------------------------------------------------------------------------
+module Data.Functor.Extend.Trans.Maybe
+  ( MaybeT(..), maybeT, nothing, justT ) where
+
+import Control.Applicative
+import Data.Functor.Apply
+import Data.Functor.Alt
+import Data.Functor.Extend
+
+newtype MaybeT w a = MaybeT { runMaybeT :: Maybe (w a) }
+
+instance Functor w => Functor (MaybeT w) where
+  fmap f = MaybeT . fmap (fmap f) . runMaybeT
+
+instance Extend w => Extend (MaybeT w) where
+  duplicated (MaybeT (Just w)) = MaybeT $ Just $ extended (MaybeT . Just) w
+  duplicated (MaybeT Nothing) = MaybeT Nothing
+
+maybeT :: a -> (w b -> a) -> MaybeT w b -> a
+maybeT z f = maybe z f . runMaybeT
+
+nothing :: MaybeT w a
+nothing = MaybeT Nothing
+
+justT :: w a -> MaybeT w a
+justT = MaybeT . Just
+
+instance Apply w => Apply (MaybeT w) where
+  MaybeT a <.> MaybeT b = MaybeT $ (<.>) <$> a <.> b
+
+instance Applicative w => Applicative (MaybeT w) where
+  pure = MaybeT . Just . pure
+  MaybeT a <*> MaybeT b = MaybeT $ (<*>) <$> a <*> b
+
+-- TODO: weaken Alt
+instance Apply w => Alt (MaybeT w) where
+  MaybeT a <!> MaybeT b = MaybeT $ a <!> b
+
+instance Applicative w => Alternative (MaybeT w) where
+  empty = MaybeT Nothing
+  MaybeT a <|> MaybeT b = MaybeT $ a <|> b