packages feed

representable-functors 2.5 → 3.0

raw patch · 11 files changed

+869/−849 lines, 11 filesdep −data-lensdep ~comonaddep ~comonad-transformersdep ~comonads-fd

Dependencies removed: data-lens

Dependency ranges changed: comonad, comonad-transformers, comonads-fd, free, keys, semigroupoids

Files

− Control/Comonad/Representable/Store.hs 
@@ -1,116 +0,0 @@-{-# 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--- --- A generalized Store comonad, parameterized by a Representable functor.--- The representation of that functor serves as the index of the store.------------------------------------------------------------------------module Control.Comonad.Representable.Store-   ( Store-   , store-   , runStore-   , StoreT(..)-   , storeT-   , runStoreT-   , pos-   , peek-   , peeks-   , seek-   , seeks-   ) where--import Control.Comonad-import Control.Applicative-import Data.Key-import Data.Functor.Apply-import Data.Semigroup-import Control.Comonad.Hoist.Class-import Control.Comonad.Env.Class-import Control.Comonad.Traced.Class-import Control.Comonad.Cofree.Class-import Control.Comonad.Trans.Class-import Control.Comonad.Store.Class-import Control.Monad.Identity-import Data.Functor.Representable---- | A memoized store comonad parameterized by a representable functor @g@, where --- the representatation of @g@, @Key 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-      => (Key g -> a)  -- ^ computation-      -> Key g         -- ^ index-      -> Store g a-store = storeT . Identity---- | Unwrap a state monad computation as a function.--- (The inverse of 'state'.)-runStore :: Indexable g-         => Store g a           -- ^ a store to access-         -> (Key g -> a, Key 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 @Key g@------   * @w@ - The inner comonad.-data StoreT g w a = StoreT (w (g a)) (Key g)--storeT :: (Functor w, Representable g) => w (Key g -> a) -> Key g -> StoreT g w a -storeT = StoreT . fmap tabulate--runStoreT :: (Functor w, Indexable g) => StoreT g w a -> (w (Key g -> a), Key g)-runStoreT (StoreT w s) = (index <$> w, s)--instance (Comonad w, Representable g, Key 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 (Key g), Representable g) => Apply (StoreT g w) where-  StoreT ff m <.> StoreT fa n = StoreT (apRep <$> ff <.> fa) (m <> n)--instance (Applicative w, Semigroup (Key g), Monoid (Key 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-  duplicate (StoreT wf s) = StoreT (extend (tabulate . StoreT) wf) s--instance (Comonad w, Representable g) => Comonad (StoreT g w) where-  extract (StoreT wf s) = index (extract wf) s--instance Indexable g => ComonadTrans (StoreT g) where-  lower (StoreT w s) = fmap (`index` s) w--instance ComonadHoist (StoreT g) where-  cohoist (StoreT w s) = StoreT (Identity (extract 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)
− Control/Monad/Representable/Reader.hs 
@@ -1,157 +0,0 @@-{-# 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 all monads, being isomorphic to--- a reader monad.-------------------------------------------------------------------------module Control.Monad.Representable.Reader-  (-  -- * Representable functor monad-    Reader, runReader-  -- * Monad Transformer-  , ReaderT(..), readerT, runReaderT-  , ask-  , local-  , module Data.Functor.Representable-  ) 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.Key-import Data.Functor.Bind-import Data.Functor.Identity-import Data.Functor.Representable-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 :: Indexable f => Reader f b -> Key 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 => (Key f -> m b) -> ReaderT f m b-readerT = ReaderT . tabulate--runReaderT :: Indexable f => ReaderT f m b -> Key f -> m b-runReaderT = index . getReaderT--type instance Key (ReaderT f m) = (Key f, Key m)--instance (Functor f, Functor m) => Functor (ReaderT f m) where-  fmap f = ReaderT . fmap (fmap f) . getReaderT--instance (Indexable f, Indexable m) => Indexable (ReaderT f m) where-  index = uncurry . fmap index . index . getReaderT--instance (Representable f, Representable m) => Representable (ReaderT f m) where-  tabulate = ReaderT . tabulate . fmap tabulate . curry--instance (Representable f, Apply m) => Apply (ReaderT f m) where-  ReaderT ff <.> ReaderT fa = ReaderT (unrep ((<.>) <$> Rep ff <.> Rep fa))--instance (Representable f, Applicative m) => Applicative (ReaderT f m) where-  pure = ReaderT . pureRep . pure-  ReaderT ff <*> ReaderT fa = ReaderT (unrep ((<*>) <$> Rep ff <*> Rep 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, Key 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 . unrep . collect (Rep . getReaderT)--instance (Representable f, Keyed m) => Keyed (ReaderT f m) where-  mapWithKey f = ReaderT . mapWithKeyRep (\k -> mapWithKey (f . (,) k)) . getReaderT--instance (Indexable f, Lookup m) => Lookup (ReaderT f m) where-  lookup (k,k') (ReaderT fm) = lookup k' (index fm k)--instance (Representable f, Representable m, Semigroup (Key f), Semigroup (Key m)) => Extend (ReaderT f m) where-  extend = extendRep-  duplicate = duplicateRep--instance (Representable f, Zip m) => Zip (ReaderT f m) where-  zipWith f (ReaderT as) (ReaderT bs) = ReaderT $ tabulate $ \i -> zipWith f (index as i) (index bs i)--instance (Representable f, ZipWithKey m) => ZipWithKey (ReaderT f m) where-  zipWithKey f (ReaderT as) (ReaderT bs) = ReaderT $ tabulate $ \i -> zipWithKey (f . (,) i) (index as i) (index bs i)--instance (Representable f, Representable m, Semigroup (Key f), Semigroup (Key m), Monoid (Key f), Monoid (Key m)) => Comonad (ReaderT f m) where-  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 (Adjustable f, Adjustable m) => Adjustable (ReaderT f m) where-  adjust f (kf,km) = ReaderT . adjust (adjust f km) kf . getReaderT--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 (FoldableWithKey f, FoldableWithKey m) => FoldableWithKey (ReaderT f m) where-  foldMapWithKey f = foldMapWithKey (\k -> foldMapWithKey (f . (,) k)) . getReaderT--instance (FoldableWithKey1 f, FoldableWithKey1 m) => FoldableWithKey1 (ReaderT f m) where-  foldMapWithKey1 f = foldMapWithKey1 (\k -> foldMapWithKey1 (f . (,) k)) . 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--instance (Representable f, TraversableWithKey f, TraversableWithKey m) => TraversableWithKey (ReaderT f m) where-  traverseWithKey f = fmap ReaderT . traverseWithKey (\k -> traverseWithKey (f . (,) k)) . getReaderT--instance (Representable f, TraversableWithKey1 f, TraversableWithKey1 m) => TraversableWithKey1 (ReaderT f m) where-  traverseWithKey1 f = fmap ReaderT . traverseWithKey1 (\k -> traverseWithKey1 (f . (,) k)) . getReaderT
− Control/Monad/Representable/State.hs 
@@ -1,218 +0,0 @@-{-# 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'-   , get-   , gets-   , put-   , modify-   ) where--import Control.Applicative-import Data.Key-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.Representable---- ------------------------------------------------------------------------------ | A memoized state monad parameterized by a representable functor @g@, where--- the representatation of @g@, @Key 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 :: Indexable g-         => State g a   -- ^ state-passing computation to execute-         -> Key g       -- ^ initial state-         -> (a, Key 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 :: Indexable g-          => State g a  -- ^state-passing computation to execute-          -> Key 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 :: Indexable g-          => State g a  -- ^state-passing computation to execute-          -> Key g      -- ^initial value-          -> Key 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, Key g) -> (b, Key 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 @Key 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, Key g)) }--stateT :: Representable g => (Key g -> m (a, Key g)) -> StateT g m a-stateT = StateT . tabulate--runStateT :: Indexable g => StateT g m a -> Key g -> m (a, Key g)-runStateT (StateT m) = index m--mapStateT :: Functor g => (m (a, Key g) -> n (b, Key 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 :: (Indexable g, Monad m) => StateT g m a -> Key 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 :: (Indexable g, Monad m) => StateT g m a -> Key g -> m (Key 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 (Functor g, Indexable 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 (Functor g, Indexable 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, Key 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---- get :: (Representable g, Monad m) => StateT g m (Key g)--- put :: (Applicative g, Monad m) => Key g -> StateT g m ()---- gets :: (Representable g, Monad m) => (Key g -> s) -> StateT g m s--- gets f = liftM f get---- modify :: (Representable g, Monad m) => (Key g -> Key g) -> StateT g m ()--- modify f = stateT $ \s -> return ((), f s)--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, Key u) -> b) -> a -> u b-leftAdjunctRep f a = tabulate (\s -> f (a,s))--rightAdjunctRep :: Indexable u => (a -> u b) -> (a, Key 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,Key g) -> m (b,Key g)) -> m (a,Key g)) -> m (a,Key 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,Key g) -> m (b,Key g)) -> m (a,Key g)) -> m (a,Key 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-
− Data/Functor/Corepresentable.hs 
@@ -1,122 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-}-{-# OPTIONS_GHC -fenable-rewrite-rules #-}--------------------------------------------------------------------------- |--- Module      :  Data.Functor.Corepresentable--- Copyright   :  (c) Edward Kmett 2011--- 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.Corepresentable-  ( -  -- * Values-    Value-  -- * Contravariant Keyed-  , Valued(..)-  -- * Contravariant Indexed-  , Coindexed(..)-  -- * Representable Contravariant Functors-  , Corepresentable(..)-  -- * Default definitions-  , contramapDefault-  , contramapWithValueDefault-  ) where--import Control.Monad.Reader-import Data.Functor.Contravariant-import Data.Functor.Product-import Data.Functor.Coproduct-import Prelude hiding (lookup)--type family Value (f :: * -> *)---- | Dual to 'Keyed'.-class Contravariant f => Valued f where-  contramapWithValue :: (b -> Either a (Value f)) -> f a -> f b---- | Dual to 'Indexed'.-class Coindexed f where-  coindex :: f a -> a -> Value f---- | A 'Functor' @f@ is 'Corepresentable' if 'corep' and 'coindex' witness an isomorphism to @(_ -> Value f)@.------ > tabulate . index = id--- > index . tabulate = id--- > tabulate . return f = return f--class (Coindexed f, Valued f) => Corepresentable f where-  -- | > contramap f (corep g) = corep (g . f)-  corep :: (a -> Value f) -> f a--{-# RULES-"corep/coindex" forall t. corep (coindex t) = t- #-}---- * Default definitions--contramapDefault :: Corepresentable f => (a -> b) -> f b -> f a-contramapDefault f = corep . (. f) . coindex --contramapWithValueDefault :: Corepresentable f => (b -> Either a (Value f)) -> f a -> f b-contramapWithValueDefault f p = corep $ either (coindex p) id . f---- * Dual arrows--type instance Value (Op r) = r--instance Valued (Op r) where-  contramapWithValue = contramapWithValueDefault--instance Coindexed (Op r) where-  coindex = getOp--instance Corepresentable (Op r) where-  corep = Op---- * Predicates--type instance Value Predicate = Bool--instance Valued Predicate where-  contramapWithValue = contramapWithValueDefault--instance Coindexed Predicate where-  coindex = getPredicate--instance Corepresentable Predicate where-  corep = Predicate---- * Products--type instance Value (Product f g) = (Value f, Value g)--instance (Valued f, Valued g) => Valued (Product f g) where-  -- contramapWithValue :: (b -> Either a (Value f)) -> f a -> f b-  contramapWithValue h (Pair f g) = Pair -      (contramapWithValue (fmap fst . h) f)-      (contramapWithValue (fmap snd . h) g)-      -- (contramapWithValue (either id snd . h) g)-      -- (either g snd . h)--instance (Coindexed f, Coindexed g) => Coindexed (Product f g) where-  coindex (Pair f g) a = (coindex f a, coindex g a)--instance (Corepresentable f, Corepresentable g) => Corepresentable (Product f g) where-  corep f = Pair (corep (fst . f)) (corep (snd . f))----- * Coproducts--type instance Value (Coproduct f g) = Either (Value f) (Value g)--instance (Coindexed f, Coindexed g) => Coindexed (Coproduct f g) where-  coindex (Coproduct (Left f)) a  = Left  $ coindex f a -  coindex (Coproduct (Right g)) a = Right $ coindex g a
− Data/Functor/Representable.hs 
@@ -1,227 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# OPTIONS_GHC -fenable-rewrite-rules #-}-------------------------------------------------------------------------- |--- Module      :  Data.Functor.Representable--- Copyright   :  (c) Edward Kmett 2011--- 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.Representable-  (-  -- * Representable Functors-    Representable(..)-  -- * Wrapped representable functors-  , Rep(..)-  -- ** Representable Lenses-  , repLens-  -- * Default definitions-  -- ** Functor-  , fmapRep-  -- ** Distributive-  , distributeRep-  -- ** Keyed-  , mapWithKeyRep-  -- ** Apply/Applicative-  , apRep-  , pureRep-  , liftR2-  , liftR3-  -- ** Bind/Monad-  , bindRep-  , bindWithKeyRep-  -- ** Zip/ZipWithKey-  , zipWithRep-  , zipWithKeyRep-  -- ** MonadReader-  , askRep-  , localRep-  -- ** Extend-  , duplicateRep-  , extendRep-  -- ** Comonad-  , 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.Key-import Data.Functor.Bind-import Data.Functor.Identity-import Data.Functor.Compose-import Data.Functor.Product-import Data.Lens.Common-import qualified Data.Sequence as Seq-import Data.Semigroup hiding (Product)-import Prelude hiding (lookup)---- | A 'Functor' @f@ is 'Representable' if 'tabulate' and 'index' witness an isomorphism to @(->) x@.------ > tabulate . index = id--- > index . tabulate = id--- > tabulate . return f = return f--class (Functor f, Indexable f) => Representable f where-  -- | > fmap f . tabulate = tabulate . fmap f-  tabulate :: (Key f -> a) -> 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--mapWithKeyRep :: Representable f => (Key f -> a -> b) -> f a -> f b-mapWithKeyRep f = tabulate . (<*>) 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)--bindWithKeyRep :: Representable f => f a -> (Key f -> a -> f b) -> f b-bindWithKeyRep m f = tabulate (\a -> index (f a (index m a)) a)--askRep :: Representable f => f (Key f)-askRep = tabulate id--localRep :: Representable f => (Key f -> Key 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)--zipWithRep :: Representable f => (a -> b -> c) -> f a -> f b -> f c-zipWithRep f g h = tabulate $ \k -> f (index g k) (index h k)--zipWithKeyRep :: Representable f => (Key f -> a -> b -> c) -> f a -> f b -> f c-zipWithKeyRep f g h = tabulate $ \k -> f k (index g k) (index h k)--distributeRep :: (Representable f, Functor w) => w (f a) -> f (w a)-distributeRep wf = tabulate (\k -> fmap (`index` k) wf)--duplicateRep :: (Representable f, Semigroup (Key f)) => f a -> f (f a)-duplicateRep w = tabulate (\m -> tabulate (index w . (<>) m))--extendRep :: (Representable f, Semigroup (Key f)) => (f a -> b) -> f a -> f b-extendRep f w = tabulate (\m -> f (tabulate (index w . (<>) m)))--extractRep :: (Indexable f, Monoid (Key f)) => f a -> a-extractRep fa = index fa mempty---- | We extend lens across a representable functor, due to the preservation of limits.-repLens :: Representable f => Lens a b -> Lens (f a) (f b)-repLens l = lens (fmapRep (l ^$)) $ \a b -> unrep $ liftA2 (l ^=) (Rep a) (Rep b)---- * Instances--instance Representable Identity where-  tabulate f = Identity (f ())--instance Representable m => Representable (IdentityT m) where-  tabulate = IdentityT . tabulate--instance Representable ((->) e) where-  tabulate = id--instance Representable m => Representable (ReaderT e m) where-  tabulate = ReaderT . fmap tabulate . curry --instance (Representable f, Representable g) => Representable (Compose f g) where-  tabulate = Compose . tabulate . fmap tabulate . curry--instance Representable w => Representable (TracedT s w) where-  -- tabulate = TracedT . collect tabulate . curry-  tabulate = TracedT . unrep . collect (Rep . tabulate) . curry--instance (Representable f, Representable g) => Representable (Product f g) where-  tabulate f = Pair (tabulate (f . Left)) (tabulate (f . Right))--instance Representable f => Representable (Cofree f) where-  tabulate f = f Seq.empty :< tabulate (\k -> tabulate (f . (k Seq.<|)))---newtype Rep f a = Rep { unrep :: f a }--type instance Key (Rep f) = Key f--instance Representable f => Representable (Rep f) where-  tabulate = Rep . tabulate--instance Indexable f => Indexable (Rep f) where-  index (Rep f) i = index f i--instance Representable f => Keyed (Rep f) where-  mapWithKey = mapWithKeyRep--instance Indexable f => Lookup (Rep f) where-  lookup = lookupDefault--instance Representable f => Functor (Rep f) where-  fmap = fmapRep--instance Representable f => Apply (Rep f) where-  (<.>) = apRep--instance Representable f => Applicative (Rep f) where-  pure = pureRep-  (<*>) = apRep--instance Representable f => Distributive (Rep f) where-  distribute = distributeRep--instance Representable f => Bind (Rep f) where-  (>>-) = bindRep--instance Representable f => Monad (Rep f) where-  return = pureRep-  (>>=) = bindRep--#if __GLASGOW_HASKELL__ >= 704-instance (Representable f, Key f ~ a) => MonadReader a (Rep f) where-  ask = askRep-  local = localRep-#endif--instance Representable f => Zip (Rep f) where-  zipWith = zipWithRep--instance Representable f => ZipWithKey (Rep f) where-  zipWithKey = zipWithKeyRep--instance (Representable f, Semigroup (Key f)) => Extend (Rep f) where-  extend = extendRep--instance (Representable f, Semigroup (Key f), Monoid (Key f)) => Comonad (Rep f) where-  extract = extractRep--instance ComonadTrans Rep where-  lower (Rep 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)
representable-functors.cabal view
@@ -1,6 +1,6 @@ name:          representable-functors category:      Monads, Functors, Data Structures-version:       2.5+version:       3.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -20,6 +20,8 @@   location: git://github.com/ekmett/representable-functors.git  library+  hs-source-dirs: src+   other-extensions:     CPP     FlexibleContexts@@ -34,19 +36,18 @@   build-depends:     array                >= 0.3.0.2 && < 0.5,     base                 >= 4       && < 5,-    comonad              >= 1.1.1.5 && < 1.2,+    comonad              >= 3.0     && < 3.1,+    comonad-transformers >= 3.0     && < 3.1,+    comonads-fd          >= 3.0     && < 3.1,     containers           >= 0.3     && < 0.6,     contravariant        >= 0.2.0.1 && < 0.3,     distributive         >= 0.2.2   && < 0.3,+    free                 >= 3.0     && < 3.1,+    keys                 >= 3.0     && < 3.1,     mtl                  >= 2.0.1.0 && < 2.2,     semigroups           >= 0.8.3.1 && < 0.9,-    semigroupoids        >= 1.3.1.2 && < 1.4,-    transformers         >= 0.2     && < 0.4,-    keys                 >= 2.2     && < 2.3,-    free                 >= 2.2     && < 2.3,-    comonad-transformers >= 2.1.1.1 && < 2.2,-    comonads-fd          >= 2.1.1.1 && < 2.2,-    data-lens            >= 2.0.3   && < 2.11+    semigroupoids        >= 3.0     && < 3.1,+    transformers         >= 0.2     && < 0.4    exposed-modules:     Data.Functor.Corepresentable
+ src/Control/Comonad/Representable/Store.hs view
@@ -0,0 +1,121 @@+{-# 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+--+-- A generalized Store comonad, parameterized by a Representable functor.+-- The representation of that functor serves as the index of the store.+----------------------------------------------------------------------+module Control.Comonad.Representable.Store+   ( Store+   , store+   , runStore+   , StoreT(..)+   , storeT+   , runStoreT+   , pos+   , peek+   , peeks+   , seek+   , seeks+   ) where++import Control.Comonad+import Control.Applicative+import Data.Key+import Data.Functor.Apply+import Data.Functor.Extend+import Data.Semigroup+import Control.Comonad.Hoist.Class+import Control.Comonad.Env.Class+import Control.Comonad.Traced.Class+import Control.Comonad.Cofree.Class+import Control.Comonad.Trans.Class+import Control.Comonad.Store.Class+import Control.Monad.Identity+import Data.Functor.Representable++-- | A memoized store comonad parameterized by a representable functor @g@, where+-- the representatation of @g@, @Key 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+      => (Key g -> a)  -- ^ computation+      -> Key g         -- ^ index+      -> Store g a+store = storeT . Identity++-- | Unwrap a state monad computation as a function.+-- (The inverse of 'state'.)+runStore :: Indexable g+         => Store g a           -- ^ a store to access+         -> (Key g -> a, Key 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 @Key g@+--+--   * @w@ - The inner comonad.+data StoreT g w a = StoreT (w (g a)) (Key g)++storeT :: (Functor w, Representable g) => w (Key g -> a) -> Key g -> StoreT g w a+storeT = StoreT . fmap tabulate++runStoreT :: (Functor w, Indexable g) => StoreT g w a -> (w (Key g -> a), Key g)+runStoreT (StoreT w s) = (index <$> w, s)++instance (Comonad w, Representable g, Key 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 (Key g), Representable g) => Apply (StoreT g w) where+  StoreT ff m <.> StoreT fa n = StoreT (apRep <$> ff <.> fa) (m <> n)++instance (ComonadApply w, Semigroup (Key g), Representable g) => ComonadApply (StoreT g w) where+  StoreT ff m <@> StoreT fa n = StoreT (apRep <$> ff <@> fa) (m <> n)++instance (Applicative w, Semigroup (Key g), Monoid (Key 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 Indexable g => ComonadTrans (StoreT g) where+  lower (StoreT w s) = fmap (`index` s) w++instance ComonadHoist (StoreT g) where+  cohoist (StoreT w s) = StoreT (Identity (extract 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,160 @@+{-# 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 all monads, being isomorphic to+-- a reader monad.+----------------------------------------------------------------------++module Control.Monad.Representable.Reader+  (+  -- * Representable functor monad+    Reader, runReader+  -- * Monad Transformer+  , ReaderT(..), readerT, runReaderT+  , ask+  , local+  , module Data.Functor.Representable+  ) 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.Key+import Data.Functor.Bind+import Data.Functor.Extend+import Data.Functor.Identity+import Data.Functor.Representable+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 :: Indexable f => Reader f b -> Key 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 => (Key f -> m b) -> ReaderT f m b+readerT = ReaderT . tabulate++runReaderT :: Indexable f => ReaderT f m b -> Key f -> m b+runReaderT = index . getReaderT++type instance Key (ReaderT f m) = (Key f, Key m)++instance (Functor f, Functor m) => Functor (ReaderT f m) where+  fmap f = ReaderT . fmap (fmap f) . getReaderT++instance (Indexable f, Indexable m) => Indexable (ReaderT f m) where+  index = uncurry . fmap index . index . getReaderT++instance (Representable f, Representable m) => Representable (ReaderT f m) where+  tabulate = ReaderT . tabulate . fmap tabulate . curry++instance (Representable f, Apply m) => Apply (ReaderT f m) where+  ReaderT ff <.> ReaderT fa = ReaderT (unrep ((<.>) <$> Rep ff <.> Rep fa))++instance (Representable f, Applicative m) => Applicative (ReaderT f m) where+  pure = ReaderT . pureRep . pure+  ReaderT ff <*> ReaderT fa = ReaderT (unrep ((<*>) <$> Rep ff <*> Rep 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, Key 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 . unrep . collect (Rep . getReaderT)++instance (Representable f, Keyed m) => Keyed (ReaderT f m) where+  mapWithKey f = ReaderT . mapWithKeyRep (\k -> mapWithKey (f . (,) k)) . getReaderT++instance (Indexable f, Lookup m) => Lookup (ReaderT f m) where+  lookup (k,k') (ReaderT fm) = lookup k' (index fm k)++instance (Representable f, Representable m, Semigroup (Key f), Semigroup (Key m)) => Extend (ReaderT f m) where+  extended = extendedRep+  duplicated = duplicatedRep++instance (Representable f, Zip m) => Zip (ReaderT f m) where+  zipWith f (ReaderT as) (ReaderT bs) = ReaderT $ tabulate $ \i -> zipWith f (index as i) (index bs i)++instance (Representable f, ZipWithKey m) => ZipWithKey (ReaderT f m) where+  zipWithKey f (ReaderT as) (ReaderT bs) = ReaderT $ tabulate $ \i -> zipWithKey (f . (,) i) (index as i) (index bs i)++instance (Representable f, Representable m, Monoid (Key f), Monoid (Key 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 (Adjustable f, Adjustable m) => Adjustable (ReaderT f m) where+  adjust f (kf,km) = ReaderT . adjust (adjust f km) kf . getReaderT++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 (FoldableWithKey f, FoldableWithKey m) => FoldableWithKey (ReaderT f m) where+  foldMapWithKey f = foldMapWithKey (\k -> foldMapWithKey (f . (,) k)) . getReaderT++instance (FoldableWithKey1 f, FoldableWithKey1 m) => FoldableWithKey1 (ReaderT f m) where+  foldMapWithKey1 f = foldMapWithKey1 (\k -> foldMapWithKey1 (f . (,) k)) . 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++instance (Representable f, TraversableWithKey f, TraversableWithKey m) => TraversableWithKey (ReaderT f m) where+  traverseWithKey f = fmap ReaderT . traverseWithKey (\k -> traverseWithKey (f . (,) k)) . getReaderT++instance (Representable f, TraversableWithKey1 f, TraversableWithKey1 m) => TraversableWithKey1 (ReaderT f m) where+  traverseWithKey1 f = fmap ReaderT . traverseWithKey1 (\k -> traverseWithKey1 (f . (,) k)) . getReaderT
+ src/Control/Monad/Representable/State.hs view
@@ -0,0 +1,218 @@+{-# 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'+   , get+   , gets+   , put+   , modify+   ) where++import Control.Applicative+import Data.Key+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.Representable++-- ---------------------------------------------------------------------------+-- | A memoized state monad parameterized by a representable functor @g@, where+-- the representatation of @g@, @Key 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 :: Indexable g+         => State g a   -- ^ state-passing computation to execute+         -> Key g       -- ^ initial state+         -> (a, Key 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 :: Indexable g+          => State g a  -- ^state-passing computation to execute+          -> Key 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 :: Indexable g+          => State g a  -- ^state-passing computation to execute+          -> Key g      -- ^initial value+          -> Key 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, Key g) -> (b, Key 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 @Key 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, Key g)) }++stateT :: Representable g => (Key g -> m (a, Key g)) -> StateT g m a+stateT = StateT . tabulate++runStateT :: Indexable g => StateT g m a -> Key g -> m (a, Key g)+runStateT (StateT m) = index m++mapStateT :: Functor g => (m (a, Key g) -> n (b, Key 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 :: (Indexable g, Monad m) => StateT g m a -> Key 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 :: (Indexable g, Monad m) => StateT g m a -> Key g -> m (Key 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 (Functor g, Indexable 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 (Functor g, Indexable 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, Key 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++-- get :: (Representable g, Monad m) => StateT g m (Key g)+-- put :: (Applicative g, Monad m) => Key g -> StateT g m ()++-- gets :: (Representable g, Monad m) => (Key g -> s) -> StateT g m s+-- gets f = liftM f get++-- modify :: (Representable g, Monad m) => (Key g -> Key g) -> StateT g m ()+-- modify f = stateT $ \s -> return ((), f s)++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, Key u) -> b) -> a -> u b+leftAdjunctRep f a = tabulate (\s -> f (a,s))++rightAdjunctRep :: Indexable u => (a -> u b) -> (a, Key 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,Key g) -> m (b,Key g)) -> m (a,Key g)) -> m (a,Key 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,Key g) -> m (b,Key g)) -> m (a,Key g)) -> m (a,Key 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/Corepresentable.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-}+{-# OPTIONS_GHC -fenable-rewrite-rules #-}++----------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Corepresentable+-- Copyright   :  (c) Edward Kmett 2011+-- 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.Corepresentable+  ( +  -- * Values+    Value+  -- * Contravariant Keyed+  , Valued(..)+  -- * Contravariant Indexed+  , Coindexed(..)+  -- * Representable Contravariant Functors+  , Corepresentable(..)+  -- * Default definitions+  , contramapDefault+  , contramapWithValueDefault+  ) where++import Control.Monad.Reader+import Data.Functor.Contravariant+import Data.Functor.Product+import Data.Functor.Coproduct+import Prelude hiding (lookup)++type family Value (f :: * -> *)++-- | Dual to 'Keyed'.+class Contravariant f => Valued f where+  contramapWithValue :: (b -> Either a (Value f)) -> f a -> f b++-- | Dual to 'Indexed'.+class Coindexed f where+  coindex :: f a -> a -> Value f++-- | A 'Functor' @f@ is 'Corepresentable' if 'corep' and 'coindex' witness an isomorphism to @(_ -> Value f)@.+--+-- > tabulate . index = id+-- > index . tabulate = id+-- > tabulate . return f = return f++class (Coindexed f, Valued f) => Corepresentable f where+  -- | > contramap f (corep g) = corep (g . f)+  corep :: (a -> Value f) -> f a++{-# RULES+"corep/coindex" forall t. corep (coindex t) = t+ #-}++-- * Default definitions++contramapDefault :: Corepresentable f => (a -> b) -> f b -> f a+contramapDefault f = corep . (. f) . coindex ++contramapWithValueDefault :: Corepresentable f => (b -> Either a (Value f)) -> f a -> f b+contramapWithValueDefault f p = corep $ either (coindex p) id . f++-- * Dual arrows++type instance Value (Op r) = r++instance Valued (Op r) where+  contramapWithValue = contramapWithValueDefault++instance Coindexed (Op r) where+  coindex = getOp++instance Corepresentable (Op r) where+  corep = Op++-- * Predicates++type instance Value Predicate = Bool++instance Valued Predicate where+  contramapWithValue = contramapWithValueDefault++instance Coindexed Predicate where+  coindex = getPredicate++instance Corepresentable Predicate where+  corep = Predicate++-- * Products++type instance Value (Product f g) = (Value f, Value g)++instance (Valued f, Valued g) => Valued (Product f g) where+  -- contramapWithValue :: (b -> Either a (Value f)) -> f a -> f b+  contramapWithValue h (Pair f g) = Pair +      (contramapWithValue (fmap fst . h) f)+      (contramapWithValue (fmap snd . h) g)+      -- (contramapWithValue (either id snd . h) g)+      -- (either g snd . h)++instance (Coindexed f, Coindexed g) => Coindexed (Product f g) where+  coindex (Pair f g) a = (coindex f a, coindex g a)++instance (Corepresentable f, Corepresentable g) => Corepresentable (Product f g) where+  corep f = Pair (corep (fst . f)) (corep (snd . f))+++-- * Coproducts++type instance Value (Coproduct f g) = Either (Value f) (Value g)++instance (Coindexed f, Coindexed g) => Coindexed (Coproduct f g) where+  coindex (Coproduct (Left f)) a  = Left  $ coindex f a +  coindex (Coproduct (Right g)) a = Right $ coindex g a
+ src/Data/Functor/Representable.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# OPTIONS_GHC -fenable-rewrite-rules #-}+----------------------------------------------------------------------+-- |+-- Module      :  Data.Functor.Representable+-- Copyright   :  (c) Edward Kmett 2011+-- 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.Representable+  (+  -- * Representable Functors+    Representable(..)+  -- * Wrapped representable functors+  , Rep(..)+  -- * Default definitions+  -- ** Functor+  , fmapRep+  -- ** Distributive+  , distributeRep+  -- ** Keyed+  , mapWithKeyRep+  -- ** Apply/Applicative+  , apRep+  , pureRep+  , liftR2+  , liftR3+  -- ** Bind/Monad+  , bindRep+  , bindWithKeyRep+  -- ** Zip/ZipWithKey+  , zipWithRep+  , zipWithKeyRep+  -- ** 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.Key+import Data.Functor.Bind+import Data.Functor.Identity+import Data.Functor.Compose+import Data.Functor.Extend+import Data.Functor.Product+import qualified Data.Sequence as Seq+import Data.Semigroup hiding (Product)+import Prelude hiding (lookup)++-- | A 'Functor' @f@ is 'Representable' if 'tabulate' and 'index' witness an isomorphism to @(->) x@.+--+-- > tabulate . index = id+-- > index . tabulate = id+-- > tabulate . return f = return f++class (Functor f, Indexable f) => Representable f where+  -- | > fmap f . tabulate = tabulate . fmap f+  tabulate :: (Key f -> a) -> 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++mapWithKeyRep :: Representable f => (Key f -> a -> b) -> f a -> f b+mapWithKeyRep f = tabulate . (<*>) 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)++bindWithKeyRep :: Representable f => f a -> (Key f -> a -> f b) -> f b+bindWithKeyRep m f = tabulate (\a -> index (f a (index m a)) a)++askRep :: Representable f => f (Key f)+askRep = tabulate id++localRep :: Representable f => (Key f -> Key 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)++zipWithRep :: Representable f => (a -> b -> c) -> f a -> f b -> f c+zipWithRep f g h = tabulate $ \k -> f (index g k) (index h k)++zipWithKeyRep :: Representable f => (Key f -> a -> b -> c) -> f a -> f b -> f c+zipWithKeyRep f g h = tabulate $ \k -> f k (index g k) (index h k)++distributeRep :: (Representable f, Functor w) => w (f a) -> f (w a)+distributeRep wf = tabulate (\k -> fmap (`index` k) wf)++duplicatedRep :: (Representable f, Semigroup (Key f)) => f a -> f (f a)+duplicatedRep w = tabulate (\m -> tabulate (index w . (<>) m))++extendedRep :: (Representable f, Semigroup (Key f)) => (f a -> b) -> f a -> f b+extendedRep f w = tabulate (\m -> f (tabulate (index w . (<>) m)))++duplicateRep :: (Representable f, Monoid (Key f)) => f a -> f (f a)+duplicateRep w = tabulate (\m -> tabulate (index w . mappend m))++extendRep :: (Representable f, Monoid (Key f)) => (f a -> b) -> f a -> f b+extendRep f w = tabulate (\m -> f (tabulate (index w . mappend m)))++extractRep :: (Indexable f, Monoid (Key f)) => f a -> a+extractRep fa = index fa mempty++{-+-- | We extend lens across a representable functor, due to the preservation of limits.+repLens :: Representable f => Lens a b -> Lens (f a) (f b)+repLens l = lens (fmapRep (l ^$)) $ \a b -> unrep $ liftA2 (l ^=) (Rep a) (Rep b)+-}++-- representing :: (Representable f, Functor g) => ((c -> g d) -> a -> g b) -> (f c -> g (f d)) -> f a -> g (f b)++-- * Instances++instance Representable Identity where+  tabulate f = Identity (f ())++instance Representable m => Representable (IdentityT m) where+  tabulate = IdentityT . tabulate++instance Representable ((->) e) where+  tabulate = id++instance Representable m => Representable (ReaderT e m) where+  tabulate = ReaderT . fmap tabulate . curry ++instance (Representable f, Representable g) => Representable (Compose f g) where+  tabulate = Compose . tabulate . fmap tabulate . curry++instance Representable w => Representable (TracedT s w) where+  -- tabulate = TracedT . collect tabulate . curry+  tabulate = TracedT . unrep . collect (Rep . tabulate) . curry++instance (Representable f, Representable g) => Representable (Product f g) where+  tabulate f = Pair (tabulate (f . Left)) (tabulate (f . Right))++instance Representable f => Representable (Cofree f) where+  tabulate f = f Seq.empty :< tabulate (\k -> tabulate (f . (k Seq.<|)))+++newtype Rep f a = Rep { unrep :: f a }++type instance Key (Rep f) = Key f++instance Representable f => Representable (Rep f) where+  tabulate = Rep . tabulate++instance Indexable f => Indexable (Rep f) where+  index (Rep f) i = index f i++instance Representable f => Keyed (Rep f) where+  mapWithKey = mapWithKeyRep++instance Indexable f => Lookup (Rep f) where+  lookup = lookupDefault++instance Representable f => Functor (Rep f) where+  fmap = fmapRep++instance Representable f => Apply (Rep f) where+  (<.>) = apRep++instance Representable f => Applicative (Rep f) where+  pure = pureRep+  (<*>) = apRep++instance Representable f => Distributive (Rep f) where+  distribute = distributeRep++instance Representable f => Bind (Rep f) where+  (>>-) = bindRep++instance Representable f => Monad (Rep f) where+  return = pureRep+  (>>=) = bindRep++#if __GLASGOW_HASKELL__ >= 704+instance (Representable f, Key f ~ a) => MonadReader a (Rep f) where+  ask = askRep+  local = localRep+#endif++instance Representable f => Zip (Rep f) where+  zipWith = zipWithRep++instance Representable f => ZipWithKey (Rep f) where+  zipWithKey = zipWithKeyRep++instance (Representable f, Semigroup (Key f)) => Extend (Rep f) where+  extended = extendedRep++instance (Representable f, Monoid (Key f)) => Comonad (Rep f) where+  extend = extendRep+  extract = extractRep++instance ComonadTrans Rep where+  lower (Rep 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)