packages feed

adjunctions 3.2.1.1 → 4.0

raw patch · 10 files changed

+813/−28 lines, 10 filesdep +semigroupsdep +taggeddep −comonad-transformersdep −keysdep −representable-functorsdep ~arraydep ~comonaddep ~distributive

Dependencies added: semigroups, tagged

Dependencies removed: comonad-transformers, keys, representable-functors

Dependency ranges changed: array, comonad, distributive, free, semigroupoids

Files

CHANGELOG.markdown view
@@ -1,3 +1,12 @@+4.0+---+* Merged the contents of `representable-functors`.+* Removed the dependency on `keys`.+* Moved `Data.Functor.Contravariant.Representable` to `Data.Functor.Contravariant.Rep` and made the API mimic `Data.Profunctor.Rep`.+* Moved `Data.Functor.Representable` to `Data.Functor.Rep` and made the API mimic `Data.Profunctor.Rep`.+* Added `Tagged` and `Proxy` instances for `Data.Functor.Rep.Representable`+* Added a `Proxy` instance for `Data.Functor.Contravariant.Rep.Representable`+ 3.2.1.1 ------- * Updated the `array` dependency
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2011-2013 Edward Kmett+Copyright 2011-2014 Edward Kmett  All rights reserved. @@ -12,10 +12,6 @@ 2. Redistributions in binary form must reproduce the above copyright    notice, this list of conditions and the following disclaimer in the    documentation and/or other materials provided with the distribution.--3. Neither the name of the author nor the names of his contributors-   may be used to endorse or promote products derived from this software-   without specific prior written permission.  THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
adjunctions.cabal view
@@ -1,6 +1,6 @@ name:          adjunctions category:      Data Structures, Adjunctions-version:       3.2.1.1+version:       4.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -9,9 +9,9 @@ stability:     provisional homepage:      http://github.com/ekmett/adjunctions/ bug-reports:   http://github.com/ekmett/adjunctions/issues-copyright:     Copyright (C) 2011-2013 Edward A. Kmett-synopsis:      Adjunctions-description:   Adjunctions+copyright:     Copyright (C) 2011-2014 Edward A. Kmett+synopsis:      Adjunctions and representable functors+description:   Adjunctions and representable functors build-type:    Simple extra-source-files:   .ghci@@ -40,27 +40,31 @@     UndecidableInstances    build-depends:-    array                  >= 0.3.0.2 && < 0.6,-    base                   >= 4       && < 5,-    transformers           >= 0.2     && < 0.4,-    mtl                    >= 2.0.1   && < 2.2,-    containers             >= 0.3     && < 0.6,-    comonad                >= 3       && < 4,-    contravariant          >= 0.2.0.1 && < 1,-    distributive           >= 0.2.2   && < 1,-    semigroupoids          >= 3       && < 4,-    void                   >= 0.5.5.1 && < 1,-    keys                   >= 3       && < 4,-    comonad-transformers   >= 3       && < 4,-    representable-functors >= 3.1     && < 4,-    free                   >= 3       && < 4+    array         >= 0.3.0.2 && < 0.7,+    base          >= 4       && < 5,+    comonad       >= 4       && < 5,+    containers    >= 0.3     && < 0.6,+    contravariant >= 0.2.0.1 && < 1,+    distributive  >= 0.4     && < 1,+    free          >= 4       && < 5,+    mtl           >= 2.0.1   && < 2.2,+    tagged        >= 0.7     && < 1,+    semigroupoids >= 4       && < 5,+    semigroups    >= 0.11    && < 1,+    transformers  >= 0.2     && < 0.4,+    void          >= 0.5.5.1 && < 1    exposed-modules:-    Data.Functor.Adjunction-    Data.Functor.Contravariant.Adjunction+    Control.Comonad.Representable.Store     Control.Comonad.Trans.Adjoint+    Control.Monad.Representable.Reader+    Control.Monad.Representable.State     Control.Monad.Trans.Adjoint-    Control.Monad.Trans.Conts     Control.Monad.Trans.Contravariant.Adjoint+    Control.Monad.Trans.Conts+    Data.Functor.Adjunction+    Data.Functor.Contravariant.Adjunction+    Data.Functor.Contravariant.Rep+    Data.Functor.Rep    ghc-options: -Wall
+ src/Control/Comonad/Representable/Store.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE TypeFamilies+           , FlexibleContexts+           , FlexibleInstances+           , MultiParamTypeClasses+           , UndecidableInstances #-}+----------------------------------------------------------------------+-- |+-- Module      :  Control.Comonad.Representable.Store+-- Copyright   :  (c) Edward Kmett & Sjoerd Visscher 2011+-- License     :  BSD3+--+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+--+-- This is a generalized 'Store' 'Comonad', parameterized by a 'Representable' 'Functor'.+-- The representation of that 'Functor' serves as the index of the store.+--+-- This can be useful if the representable functor serves to memoize its+-- contents and will be inspected often.+----------------------------------------------------------------------+module Control.Comonad.Representable.Store+   ( Store+   , store+   , runStore+   , StoreT(..)+   , storeT+   , runStoreT+   , ComonadStore(..)+   ) where++import Control.Applicative+import Control.Comonad+import Control.Comonad.Cofree.Class+import Control.Comonad.Env.Class+import Control.Comonad.Hoist.Class+import Control.Comonad.Store.Class+import Control.Comonad.Traced.Class+import Control.Comonad.Trans.Class+import Control.Monad.Identity+import Data.Functor.Apply+import Data.Functor.Extend+import Data.Functor.Rep+import Data.Semigroup++-- | A memoized store comonad parameterized by a representable functor @g@, where+-- the representatation of @g@, @Rep g@ is the index of the store.+--+type Store g = StoreT g Identity++-- | Construct a store comonad computation from a function and a current index.+-- (The inverse of 'runStore'.)+store :: Representable g+      => (Rep g -> a)  -- ^ computation+      -> Rep g         -- ^ index+      -> Store g a+store = storeT . Identity++-- | Unwrap a state monad computation as a function.+-- (The inverse of 'state'.)+runStore :: Representable g+         => Store g a           -- ^ a store to access+         -> (Rep g -> a, Rep g) -- ^ initial state+runStore (StoreT (Identity ga) k) = (index ga, k)++-- ---------------------------------------------------------------------------+-- | A store transformer comonad parameterized by:+--+--   * @g@ - A representable functor used to memoize results for an index @Rep g@+--+--   * @w@ - The inner comonad.+data StoreT g w a = StoreT (w (g a)) (Rep g)++storeT :: (Functor w, Representable g) => w (Rep g -> a) -> Rep g -> StoreT g w a+storeT = StoreT . fmap tabulate++runStoreT :: (Functor w, Representable g) => StoreT g w a -> (w (Rep g -> a), Rep g)+runStoreT (StoreT w s) = (index <$> w, s)++instance (Comonad w, Representable g, Rep g ~ s) => ComonadStore s (StoreT g w) where+  pos (StoreT _ s) = s+  peek s (StoreT w _) = extract w `index` s+  peeks f (StoreT w s) = extract w `index` f s+  seek s (StoreT w _) = StoreT w s+  seeks f (StoreT w s) = StoreT w (f s)++instance (Functor w, Functor g) => Functor (StoreT g w) where+  fmap f (StoreT w s) = StoreT (fmap (fmap f) w) s++instance (Apply w, Semigroup (Rep g), Representable g) => Apply (StoreT g w) where+  StoreT ff m <.> StoreT fa n = StoreT (apRep <$> ff <.> fa) (m <> n)++instance (ComonadApply w, Semigroup (Rep g), Representable g) => ComonadApply (StoreT g w) where+  StoreT ff m <@> StoreT fa n = StoreT (apRep <$> ff <@> fa) (m <> n)++instance (Applicative w, Semigroup (Rep g), Monoid (Rep g), Representable g) => Applicative (StoreT g w) where+  pure a = StoreT (pure (pureRep a)) mempty+  StoreT ff m <*> StoreT fa n = StoreT (apRep <$> ff <*> fa) (m `mappend` n)++instance (Extend w, Representable g) => Extend (StoreT g w) where+  duplicated (StoreT wf s) = StoreT (extended (tabulate . StoreT) wf) s++instance (Comonad w, Representable g) => Comonad (StoreT g w) where+  duplicate (StoreT wf s) = StoreT (extend (tabulate . StoreT) wf) s+  extract (StoreT wf s) = index (extract wf) s++instance Representable g => ComonadTrans (StoreT g) where+  lower (StoreT w s) = fmap (`index` s) w++instance ComonadHoist (StoreT g) where+  cohoist f (StoreT w s) = StoreT (f w) s++instance (ComonadTraced m w, Representable g) => ComonadTraced m (StoreT g w) where+  trace m = trace m . lower++instance (ComonadEnv m w, Representable g) => ComonadEnv m (StoreT g w) where+  ask = ask . lower++instance (Representable g, ComonadCofree f w) => ComonadCofree f (StoreT g w) where+  unwrap (StoreT w s) = fmap (`StoreT` s) (unwrap w)
+ src/Control/Monad/Representable/Reader.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeSynonymInstances #-}+{-# OPTIONS_GHC -fenable-rewrite-rules -fno-warn-orphans #-}+----------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Representable.Reader+-- Copyright   :  (c) Edward Kmett 2011,+--                (c) Conal Elliott 2008+-- License     :  BSD3+--+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+--+-- Representable functors on Hask are all monads, because they are isomorphic to+-- a 'Reader' monad.+----------------------------------------------------------------------++module Control.Monad.Representable.Reader+  (+  -- * Representable functor monad+    Reader+  , runReader+  -- * Monad Transformer+  , ReaderT(..), readerT, runReaderT+  , MonadReader(..)+  , module Data.Functor.Rep+  ) where++import Control.Applicative+import Control.Comonad+import Control.Monad.Reader.Class+import Control.Monad.Writer.Class as Writer+import Control.Monad.Trans.Class+import Control.Monad.IO.Class+import Data.Distributive+import Data.Functor.Bind+import Data.Functor.Extend+import Data.Functor.Identity+import Data.Functor.Rep+import Data.Foldable+import Data.Traversable+import Data.Semigroup+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Prelude hiding (lookup,zipWith)++type Reader f = ReaderT f Identity++runReader :: Representable f => Reader f b -> Rep f -> b+runReader = fmap runIdentity . runReaderT++-- * This 'representable monad transformer' transforms any monad @m@ with a 'Representable' 'Monad'.+--   This monad in turn is also representable if @m@ is 'Representable'.+newtype ReaderT f m b = ReaderT { getReaderT :: f (m b) }++readerT :: Representable f => (Rep f -> m b) -> ReaderT f m b+readerT = ReaderT . tabulate++runReaderT :: Representable f => ReaderT f m b -> Rep f -> m b+runReaderT = index . getReaderT++instance (Functor f, Functor m) => Functor (ReaderT f m) where+  fmap f = ReaderT . fmap (fmap f) . getReaderT++instance (Representable f, Representable m) => Representable (ReaderT f m) where+  type Rep (ReaderT f m) = (Rep f, Rep m)+  tabulate = ReaderT . tabulate . fmap tabulate . curry+  index = uncurry . fmap index . index . getReaderT++instance (Representable f, Apply m) => Apply (ReaderT f m) where+  ReaderT ff <.> ReaderT fa = ReaderT (unCo ((<.>) <$> Co ff <.> Co fa))++instance (Representable f, Applicative m) => Applicative (ReaderT f m) where+  pure = ReaderT . pureRep . pure+  ReaderT ff <*> ReaderT fa = ReaderT (unCo ((<*>) <$> Co ff <*> Co fa))++instance (Representable f, Bind m) => Bind (ReaderT f m) where+  ReaderT fm >>- f = ReaderT $ tabulate (\a -> index fm a >>- flip index a . getReaderT . f)++instance (Representable f, Monad m) => Monad (ReaderT f m) where+  return = ReaderT . pureRep . return+  ReaderT fm >>= f = ReaderT $ tabulate (\a -> index fm a >>= flip index a . getReaderT . f)++#if __GLASGOW_HASKELL >= 704++instance (Representable f, Monad m, Rep f ~ e) => MonadReader e (ReaderT f m) where+  ask = ReaderT (tabulate return)+  local f m = readerT $ \r -> runReaderT m (f r)+#if MIN_VERSION_transformers(0,3,0)+  reader = readerT . fmap return+#endif++#endif++instance Representable f => MonadTrans (ReaderT f) where+  lift = ReaderT . pureRep++instance (Representable f, Distributive m) => Distributive (ReaderT f m) where+  distribute = ReaderT . fmapRep distribute . unCo . collect (Co . getReaderT)++instance (Representable f, Representable m, Semigroup (Rep f), Semigroup (Rep m)) => Extend (ReaderT f m) where+  extended = extendedRep+  duplicated = duplicatedRep++instance (Representable f, Representable m, Monoid (Rep f), Monoid (Rep m)) => Comonad (ReaderT f m) where+  extend = extendRep+  duplicate = duplicateRep+  extract = extractRep++instance (Representable f, MonadIO m) => MonadIO (ReaderT f m) where+  liftIO = lift . liftIO++instance (Representable f, MonadWriter w m) => MonadWriter w (ReaderT f m) where+  tell = lift . tell+  listen (ReaderT m) = ReaderT $ tabulate $ Writer.listen . index m+  pass (ReaderT m) = ReaderT $ tabulate $ Writer.pass . index m++-- misc. instances that can exist, but aren't particularly about representability++instance (Foldable f, Foldable m) => Foldable (ReaderT f m) where+  foldMap f = foldMap (foldMap f) . getReaderT++instance (Foldable1 f, Foldable1 m) => Foldable1 (ReaderT f m) where+  foldMap1 f = foldMap1 (foldMap1 f) . getReaderT++instance (Traversable f, Traversable m) => Traversable (ReaderT f m) where+  traverse f = fmap ReaderT . traverse (traverse f) . getReaderT++instance (Traversable1 f, Traversable1 m) => Traversable1 (ReaderT f m) where+  traverse1 f = fmap ReaderT . traverse1 (traverse1 f) . getReaderT
+ src/Control/Monad/Representable/State.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+----------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Representable.State+-- Copyright   :  (c) Edward Kmett & Sjoerd Visscher 2011+-- License     :  BSD3+--+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+--+-- A generalized State monad, parameterized by a Representable functor.+-- The representation of that functor serves as the state.+----------------------------------------------------------------------+module Control.Monad.Representable.State+   ( State+   , runState+   , evalState+   , execState+   , mapState+   , StateT(..)+   , stateT+   , runStateT+   , evalStateT+   , execStateT+   , mapStateT+   , liftCallCC+   , liftCallCC'+   , MonadState(..)+   ) where++import Control.Applicative+import Data.Functor.Bind+import Data.Functor.Bind.Trans+import Control.Monad.State.Class+import Control.Monad.Cont.Class+import Control.Monad.Reader.Class+import Control.Monad.Writer.Class+import Control.Monad.Free.Class+import Control.Monad.Trans.Class+import Control.Monad.Identity+import Data.Functor.Rep++-- ---------------------------------------------------------------------------+-- | A memoized state monad parameterized by a representable functor @g@, where+-- the representatation of @g@, @Rep g@ is the state to carry.+--+-- The 'return' function leaves the state unchanged, while @>>=@ uses+-- the final state of the first computation as the initial state of+-- the second.+type State g = StateT g Identity+++-- | Unwrap a state monad computation as a function.+-- (The inverse of 'state'.)+runState :: Representable g+         => State g a   -- ^ state-passing computation to execute+         -> Rep g       -- ^ initial state+         -> (a, Rep g)  -- ^ return value and final state+runState m = runIdentity . runStateT m++-- | Evaluate a state computation with the given initial state+-- and return the final value, discarding the final state.+--+-- * @'evalState' m s = 'fst' ('runState' m s)@+evalState :: Representable g+          => State g a  -- ^state-passing computation to execute+          -> Rep g      -- ^initial value+          -> a          -- ^return value of the state computation+evalState m s = fst (runState m s)++-- | Evaluate a state computation with the given initial state+-- and return the final state, discarding the final value.+--+-- * @'execState' m s = 'snd' ('runState' m s)@+execState :: Representable g+          => State g a  -- ^state-passing computation to execute+          -> Rep g      -- ^initial value+          -> Rep g      -- ^final state+execState m s = snd (runState m s)++-- | Map both the return value and final state of a computation using+-- the given function.+--+-- * @'runState' ('mapState' f m) = f . 'runState' m@+mapState :: Functor g => ((a, Rep g) -> (b, Rep g)) -> State g a -> State g b+mapState f = mapStateT (Identity . f . runIdentity)++-- ---------------------------------------------------------------------------+-- | A state transformer monad parameterized by:+--+--   * @g@ - A representable functor used to memoize results for a state @Rep g@+--+--   * @m@ - The inner monad.+--+-- The 'return' function leaves the state unchanged, while @>>=@ uses+-- the final state of the first computation as the initial state of+-- the second.+newtype StateT g m a = StateT { getStateT :: g (m (a, Rep g)) }++stateT :: Representable g => (Rep g -> m (a, Rep g)) -> StateT g m a+stateT = StateT . tabulate++runStateT :: Representable g => StateT g m a -> Rep g -> m (a, Rep g)+runStateT (StateT m) = index m++mapStateT :: Functor g => (m (a, Rep g) -> n (b, Rep g)) -> StateT g m a -> StateT g n b+mapStateT f (StateT m) = StateT (fmap f m)++-- | Evaluate a state computation with the given initial state+-- and return the final value, discarding the final state.+--+-- * @'evalStateT' m s = 'liftM' 'fst' ('runStateT' m s)@+evalStateT :: (Representable g, Monad m) => StateT g m a -> Rep g -> m a+evalStateT m s = do+    (a, _) <- runStateT m s+    return a++-- | Evaluate a state computation with the given initial state+-- and return the final state, discarding the final value.+--+-- * @'execStateT' m s = 'liftM' 'snd' ('runStateT' m s)@+execStateT :: (Representable g, Monad m) => StateT g m a -> Rep g -> m (Rep g)+execStateT m s = do+    (_, s') <- runStateT m s+    return s'++instance (Functor g, Functor m) => Functor (StateT g m) where+  fmap f = StateT . fmap (fmap (\ ~(a, s) -> (f a, s))) . getStateT++instance (Representable g, Bind m) => Apply (StateT g m) where+  mf <.> ma = mf >>- \f -> fmap f ma++instance (Representable g, Functor m, Monad m) => Applicative (StateT g m) where+  pure = StateT . leftAdjunctRep return+  mf <*> ma = mf >>= \f -> fmap f ma++instance (Representable g, Bind m) => Bind (StateT g m) where+  StateT m >>- f = StateT $ fmap (>>- rightAdjunctRep (runStateT . f)) m++instance (Representable g, Monad m) => Monad (StateT g m) where+  return = StateT . leftAdjunctRep return+  StateT m >>= f = StateT $ fmap (>>= rightAdjunctRep (runStateT . f)) m++instance Representable f => BindTrans (StateT f) where+  liftB m = stateT $ \s -> fmap (\a -> (a, s)) m++instance Representable f => MonadTrans (StateT f) where+  lift m = stateT $ \s -> liftM (\a -> (a, s)) m++instance (Representable g, Monad m, Rep g ~ s) => MonadState s (StateT g m) where+  get = stateT $ \s -> return (s, s)+  put s = StateT $ pureRep $ return ((),s)+#if MIN_VERSION_transformers(0,3,0)+  state f = stateT (return . f)+#endif++instance (Representable g, MonadReader e m) => MonadReader e (StateT g m) where+  ask = lift ask+  local = mapStateT . local++instance (Representable g, MonadWriter w m) => MonadWriter w (StateT g m) where+  tell = lift . tell+  listen = mapStateT $ \ma -> do+     ((a,s'), w) <- listen ma+     return ((a,w), s')+  pass = mapStateT $ \ma -> pass $ do+    ((a, f), s') <- ma+    return ((a, s'), f)++instance (Representable g, MonadCont m) => MonadCont (StateT g m) where+    callCC = liftCallCC' callCC++instance (Functor f, Representable g, MonadFree f m) => MonadFree f (StateT g m) where+    wrap as = stateT $ \s -> wrap (fmap (`runStateT` s) as)++leftAdjunctRep :: Representable u => ((a, Rep u) -> b) -> a -> u b+leftAdjunctRep f a = tabulate (\s -> f (a,s))++rightAdjunctRep :: Representable u => (a -> u b) -> (a, Rep u) -> b+rightAdjunctRep f ~(a, k) = f a `index` k++-- | Uniform lifting of a @callCC@ operation to the new monad.+-- This version rolls back to the original state on entering the+-- continuation.+liftCallCC :: Representable g => ((((a,Rep g) -> m (b,Rep g)) -> m (a,Rep g)) -> m (a,Rep g)) ->+    ((a -> StateT g m b) -> StateT g m a) -> StateT g m a+liftCallCC callCC' f = stateT $ \s ->+    callCC' $ \c ->+    runStateT (f (\a -> StateT $ pureRep $ c (a, s))) s++-- | In-situ lifting of a @callCC@ operation to the new monad.+-- This version uses the current state on entering the continuation.+-- It does not satisfy the laws of a monad transformer.+liftCallCC' :: Representable g => ((((a,Rep g) -> m (b,Rep g)) -> m (a,Rep g)) -> m (a,Rep g)) ->+    ((a -> StateT g m b) -> StateT g m a) -> StateT g m a+liftCallCC' callCC' f = stateT $ \s ->+    callCC' $ \c ->+    runStateT (f (\a -> stateT $ \s' -> c (a, s'))) s+
src/Data/Functor/Adjunction.hs view
@@ -46,7 +46,7 @@ import Data.Functor.Coproduct import Data.Functor.Compose import Data.Functor.Product-import Data.Functor.Representable+import Data.Functor.Rep import Data.Void  -- | An adjunction between Hask and Hask.
src/Data/Functor/Contravariant/Adjunction.hs view
@@ -22,7 +22,7 @@  import Control.Monad.Instances () import Data.Functor.Contravariant-import Data.Functor.Contravariant.Representable+import Data.Functor.Contravariant.Rep  -- | An adjunction from @Hask^op@ to @Hask@ --
+ src/Data/Functor/Contravariant/Rep.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-}+{-# OPTIONS_GHC -fenable-rewrite-rules #-}+----------------------------------------------------------------------+-- |+-- Copyright   :  (c) Edward Kmett 2011-2014+-- License     :  BSD3+--+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+--+-- Representable contravariant endofunctors over the category of Haskell+-- types are isomorphic to @(_ -> r)@ and resemble mappings to a+-- fixed range.+----------------------------------------------------------------------+module Data.Functor.Contravariant.Rep+  (+  -- * Representable Contravariant Functors+    Representable(..)+  -- * Default definitions+  , contramapRep+  ) where++import Control.Monad.Reader+import Data.Functor.Contravariant+import Data.Functor.Contravariant.Day+import Data.Functor.Product+import Data.Proxy+import Prelude hiding (lookup)++-- | A 'Contravariant' functor @f@ is 'Representable' if 'tabulate' and 'index' witness an isomorphism to @(_ -> Rep f)@.+--+-- @+-- 'tabulate' . 'index' ≡ id+-- 'index' . 'tabulate' ≡ id+-- @+class Contravariant f => Representable f where+  type Rep f :: *+  -- |+  -- @+  -- 'contramap' f ('tabulate' g) = 'tabulate' (g . f)+  -- @+  tabulate :: (a -> Rep f) -> f a++  index    :: f a -> a -> Rep f++  -- |+  -- @+  -- 'contramapWithRep' f p ≡ 'tabulate' $ 'either' ('index' p) 'id' . f+  -- @+  contramapWithRep :: (b -> Either a (Rep f)) -> f a -> f b+  contramapWithRep f p = tabulate $ either (index p) id . f++contramapRep :: Representable f => (a -> b) -> f b -> f a+contramapRep f = tabulate . (. f) . index++instance Representable Proxy where+  type Rep Proxy = ()+  tabulate _ = Proxy+  index Proxy _ = ()+  contramapWithRep _ Proxy = Proxy++instance (Representable f, Representable g) => Representable (Day f g) where+  type Rep (Day f g) = (Rep f, Rep g)+  tabulate a2fg = Day (tabulate fst) (tabulate snd) $ \a -> let b = a2fg a in (b,b)+  index (Day fb gc abc) a = case abc a of+    (b, c) -> (index fb b, index gc c)+  contramapWithRep d2eafg (Day fb gc abc) = Day (contramapWithRep id fb) (contramapWithRep id gc) $ \d -> case d2eafg d of+    Left a -> case abc a of+      (b, c) -> (Left b, Left c)+    Right (vf, vg) -> (Right vf, Right vg)+  {-# INLINE tabulate #-}++instance Representable (Op r) where+  type Rep (Op r) = r+  tabulate = Op+  index = getOp++instance Representable Predicate where+  type Rep Predicate = Bool+  tabulate = Predicate+  index = getPredicate++instance (Representable f, Representable g) => Representable (Product f g) where+  type Rep (Product f g) = (Rep f, Rep g)+  tabulate f = Pair (tabulate (fst . f)) (tabulate (snd . f))+  index (Pair f g) a = (index f a, index g a)+  contramapWithRep h (Pair f g) = Pair+      (contramapWithRep (fmap fst . h) f)+      (contramapWithRep (fmap snd . h) g)
+ src/Data/Functor/Rep.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveFunctor #-}+{-# OPTIONS_GHC -fenable-rewrite-rules #-}+----------------------------------------------------------------------+-- |+-- Copyright   :  (c) Edward Kmett 2011-2014+-- License     :  BSD3+--+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+--+-- Representable endofunctors over the category of Haskell types are+-- isomorphic to the reader monad and so inherit a very large number+-- of properties for free.+----------------------------------------------------------------------++module Data.Functor.Rep+  (+  -- * Representable Functors+    Representable(..)+  -- * Wrapped representable functors+  , Co(..)+  -- * Default definitions+  -- ** Functor+  , fmapRep+  -- ** Distributive+  , distributeRep+  -- ** Apply/Applicative+  , apRep+  , pureRep+  , liftR2+  , liftR3+  -- ** Bind/Monad+  , bindRep+  -- ** MonadReader+  , askRep+  , localRep+  -- ** Extend+  , duplicatedRep+  , extendedRep+  -- ** Comonad+  , duplicateRep+  , extendRep+  , extractRep+  ) where++import Control.Applicative+import Control.Comonad+import Control.Comonad.Trans.Class+import Control.Comonad.Trans.Traced+import Control.Comonad.Cofree+import Control.Monad.Trans.Identity+import Control.Monad.Reader+import Data.Distributive+import Data.Functor.Bind+import Data.Functor.Identity+import Data.Functor.Compose+import Data.Functor.Extend+import Data.Functor.Product+import Data.Proxy+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import Data.Semigroup hiding (Product)+import Data.Tagged+import Data.Void+import Prelude hiding (lookup)++-- | A 'Functor' @f@ is 'Representable' if 'tabulate' and 'index' witness an isomorphism to @(->) x@.+--+-- Every 'Distributive' 'Functor' is actually 'Representable'.+--+-- Every 'Representable' 'Functor' from Hask to Hask is a right adjoint.+--+-- @+-- 'tabulate' . 'index'    ≡ id+-- 'index' . 'tabulate'    ≡ id+-- 'tabulate' . 'return' f ≡ 'return' f+-- @++class Distributive f => Representable f where+  type Rep f :: *+  -- |+  -- @+  -- 'fmap' f . 'tabulate' ≡ 'tabulate' . 'fmap' f+  -- @+  tabulate :: (Rep f -> a) -> f a+  index    :: f a -> Rep f -> a++{-# RULES+"tabulate/index" forall t. tabulate (index t) = t #-}++-- * Default definitions++fmapRep :: Representable f => (a -> b) -> f a -> f b+fmapRep f = tabulate . fmap f . index++pureRep :: Representable f => a -> f a+pureRep = tabulate . const++bindRep :: Representable f => f a -> (a -> f b) -> f b+bindRep m f = tabulate $ \a -> index (f (index m a)) a++askRep :: Representable f => f (Rep f)+askRep = tabulate id++localRep :: Representable f => (Rep f -> Rep f) -> f a -> f a+localRep f m = tabulate (index m . f)++apRep :: Representable f => f (a -> b) -> f a -> f b+apRep f g = tabulate (index f <*> index g)++distributeRep :: (Representable f, Functor w) => w (f a) -> f (w a)+distributeRep wf = tabulate (\k -> fmap (`index` k) wf)++duplicatedRep :: (Representable f, Semigroup (Rep f)) => f a -> f (f a)+duplicatedRep w = tabulate (\m -> tabulate (index w . (<>) m))++extendedRep :: (Representable f, Semigroup (Rep f)) => (f a -> b) -> f a -> f b+extendedRep f w = tabulate (\m -> f (tabulate (index w . (<>) m)))++duplicateRep :: (Representable f, Monoid (Rep f)) => f a -> f (f a)+duplicateRep w = tabulate (\m -> tabulate (index w . mappend m))++extendRep :: (Representable f, Monoid (Rep f)) => (f a -> b) -> f a -> f b+extendRep f w = tabulate (\m -> f (tabulate (index w . mappend m)))++extractRep :: (Representable f, Monoid (Rep f)) => f a -> a+extractRep fa = index fa mempty++-- * Instances++instance Representable Proxy where+  type Rep Proxy = Void+  index Proxy = absurd+  tabulate f = Proxy++instance Representable Identity where+  type Rep Identity = ()+  index (Identity a) () = a+  tabulate f = Identity (f ())++instance Representable (Tagged t) where+  type Rep (Tagged t) = ()+  index (Tagged a) () = a+  tabulate f = Tagged (f ())++instance Representable m => Representable (IdentityT m) where+  type Rep (IdentityT m) = Rep m+  index (IdentityT m) i = index m i+  tabulate = IdentityT . tabulate++instance Representable ((->) e) where+  type Rep ((->) e) = e+  index = id+  tabulate = id++instance Representable m => Representable (ReaderT e m) where+  type Rep (ReaderT e m) = (e, Rep m)+  index (ReaderT f) (e,k) = index (f e) k+  tabulate = ReaderT . fmap tabulate . curry++instance (Representable f, Representable g) => Representable (Compose f g) where+  type Rep (Compose f g) = (Rep f, Rep g)+  index (Compose fg) (i,j) = index (index fg i) j+  tabulate = Compose . tabulate . fmap tabulate . curry++instance Representable w => Representable (TracedT s w) where+  type Rep (TracedT s w) = (s, Rep w)+  index (TracedT w) (e,k) = index w k e+  tabulate = TracedT . unCo . collect (Co . tabulate) . curry++instance (Representable f, Representable g) => Representable (Product f g) where+  type Rep (Product f g) = Either (Rep f) (Rep g)+  index (Pair a _) (Left i)  = index a i+  index (Pair _ b) (Right j) = index b j+  tabulate f = Pair (tabulate (f . Left)) (tabulate (f . Right))++instance Representable f => Representable (Cofree f) where+  type Rep (Cofree f) = Seq (Rep f)+  index (a :< as) key = case Seq.viewl key of+      Seq.EmptyL -> a+      k Seq.:< ks -> index (index as k) ks+  tabulate f = f Seq.empty :< tabulate (\k -> tabulate (f . (k Seq.<|)))++newtype Co f a = Co { unCo :: f a } deriving Functor++instance Representable f => Representable (Co f) where+  type Rep (Co f) = Rep f+  tabulate = Co . tabulate+  index (Co f) i = index f i++instance Representable f => Apply (Co f) where+  (<.>) = apRep++instance Representable f => Applicative (Co f) where+  pure = pureRep+  (<*>) = apRep++instance Representable f => Distributive (Co f) where+  distribute = distributeRep++instance Representable f => Bind (Co f) where+  (>>-) = bindRep++instance Representable f => Monad (Co f) where+  return = pureRep+  (>>=) = bindRep++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 704+instance (Representable f, Rep f ~ a) => MonadReader a (Co f) where+  ask = askRep+  local = localRep+#endif++instance (Representable f, Semigroup (Rep f)) => Extend (Co f) where+  extended = extendedRep++instance (Representable f, Monoid (Rep f)) => Comonad (Co f) where+  extend = extendRep+  extract = extractRep++instance ComonadTrans Co where+  lower (Co f) = f++liftR2 :: Representable f => (a -> b -> c) -> f a -> f b -> f c+liftR2 f fa fb = tabulate $ \i -> f (index fa i) (index fb i)++liftR3 :: Representable f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d+liftR3 f fa fb fc = tabulate $ \i -> f (index fa i) (index fb i) (index fc i)