packages feed

representable-functors 2.2.1.1 → 2.4

raw patch · 5 files changed

+140/−61 lines, 5 files

Files

Control/Comonad/Representable/Store.hs view
@@ -50,7 +50,7 @@  -- | Construct a store comonad computation from a function and a current index. -- (The inverse of 'runStore'.)-store :: Representable g +store :: Representable g       => (Key g -> a)  -- ^ computation       -> Key g         -- ^ index       -> Store g a@@ -58,7 +58,7 @@  -- | Unwrap a state monad computation as a function. -- (The inverse of 'state'.)-runStore :: Indexable g +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)@@ -69,7 +69,7 @@ --   * @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) +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@@ -88,11 +88,11 @@   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 ((<*>) <$> ff <.> fa) (m <> n)+  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 (pure a)) mempty-  StoreT ff m <*> StoreT fa n = StoreT ((<*>) <$> ff <*> fa) (m `mappend` n)+  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
Control/Monad/Representable/Reader.hs view
@@ -19,7 +19,7 @@   -- * Representable functor monad     Reader, runReader   -- * Monad Transformer-  , ReaderT(..)+  , ReaderT(..), readerT, runReaderT   , ask   , local   , module Data.Functor.Representable@@ -41,16 +41,15 @@ import Data.Semigroup import Data.Semigroup.Foldable import Data.Semigroup.Traversable-import Prelude hiding (lookup)+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 'tabulateresentable monad transformer' transforms any monad @m@ with a 'Representable' 'Monad'.---   This monad in turn is also tabulateresentable if @m@ is 'Representable'.+-- * 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@@ -64,20 +63,27 @@ 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 ((<.>) <$> ff <.> fa)+  ReaderT ff <.> ReaderT fa = ReaderT (unrep ((<.>) <$> Rep ff <.> Rep fa))  instance (Representable f, Applicative m) => Applicative (ReaderT f m) where-  pure = ReaderT . pure . pure-  ReaderT ff <*> ReaderT fa = ReaderT ((<*>) <$> ff <*> fa)+  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 . pure . return+  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)@@ -86,27 +92,46 @@   reader = readerT . fmap return #endif +#endif+ instance Representable f => MonadTrans (ReaderT f) where-  lift = ReaderT . pure+  lift = ReaderT . pureRep  instance (Representable f, Distributive m) => Distributive (ReaderT f m) where-  distribute = ReaderT . fmap distribute . collect getReaderT+  distribute = ReaderT . fmapRep distribute . unrep . collect (Rep . getReaderT) -instance (Keyed f, Keyed m) => Keyed (ReaderT f m) where-  mapWithKey f = ReaderT . mapWithKey (\k -> mapWithKey (f . (,) k)) . getReaderT+instance (Representable f, Keyed m) => Keyed (ReaderT f m) where+  mapWithKey f = ReaderT . mapWithKeyRep (\k -> mapWithKey (f . (,) k)) . getReaderT -instance (Indexable f, Indexable m) => Indexable (ReaderT f m) where-  index = uncurry . fmap index . index . getReaderT+instance (Indexable f, Lookup m) => Lookup (ReaderT f m) where+  lookup (k,k') (ReaderT fm) = lookup k' (index fm k) -instance (Adjustable f, Adjustable m) => Adjustable (ReaderT f m) where-  adjust f (kf,km) = ReaderT . adjust (adjust f km) kf . getReaderT+instance (Representable f, Representable m, Semigroup (Key f), Semigroup (Key m)) => Extend (ReaderT f m) where+  extend = extendRep+  duplicate = duplicateRep -instance (Lookup f, Lookup m) => Lookup (ReaderT f m) where-  lookup (k,k') (ReaderT fm) = lookup k fm >>= lookup k'+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, Representable m) => Representable (ReaderT f m) where-  tabulate = ReaderT . tabulate . fmap tabulate . curry+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 @@ -125,30 +150,8 @@ instance (Traversable1 f, Traversable1 m) => Traversable1 (ReaderT f m) where   traverse1 f = fmap ReaderT . traverse1 (traverse1 f) . getReaderT -instance (TraversableWithKey f, TraversableWithKey m) => TraversableWithKey (ReaderT f m) where+instance (Representable f, TraversableWithKey f, TraversableWithKey m) => TraversableWithKey (ReaderT f m) where   traverseWithKey f = fmap ReaderT . traverseWithKey (\k -> traverseWithKey (f . (,) k)) . getReaderT -instance (TraversableWithKey1 f, TraversableWithKey1 m) => TraversableWithKey1 (ReaderT f m) where+instance (Representable f, TraversableWithKey1 f, TraversableWithKey1 m) => TraversableWithKey1 (ReaderT f m) where   traverseWithKey1 f = fmap ReaderT . traverseWithKey1 (\k -> traverseWithKey1 (f . (,) k)) . getReaderT--instance (Representable f, Representable m, Semigroup (Key f), Semigroup (Key m)) => Extend (ReaderT f m) where-  extend = extendRep-  duplicate = duplicateRep--instance (Representable f, Representable m) => Zip (ReaderT f m) where-  zipWith = zipWithRep--instance (Representable f, Representable m) => ZipWithKey (ReaderT f m) where-  zipWithKey = zipWithKeyRep--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-
Control/Monad/Representable/State.hs view
@@ -159,7 +159,7 @@  instance (Representable g, Monad m, Key g ~ s) => MonadState s (StateT g m) where   get = stateT $ \s -> return (s, s)-  put s = StateT $ pure $ return ((),s)+  put s = StateT $ pureRep $ return ((),s) #if MIN_VERSION_transformers(0,3,0)   state f = stateT (return . f) #endif@@ -205,7 +205,7 @@     ((a -> StateT g m b) -> StateT g m a) -> StateT g m a liftCallCC callCC' f = stateT $ \s ->     callCC' $ \c ->-    runStateT (f (\a -> StateT $ pure $ c (a, s))) s+    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.
Data/Functor/Representable.hs view
@@ -1,4 +1,9 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -fenable-rewrite-rules #-} ---------------------------------------------------------------------- -- |@@ -15,11 +20,13 @@ ----------------------------------------------------------------------  module Data.Functor.Representable-  ( +  (   -- * Representable Functors     Representable(..)+  -- * Wrapped representable functors+  , Rep(..)   -- ** Representable Lenses-  , repLens +  , repLens   -- * Default definitions   -- ** Functor   , fmapRep@@ -30,6 +37,8 @@   -- ** Apply/Applicative   , apRep   , pureRep+  , liftR2+  , liftR3   -- ** Bind/Monad   , bindRep   , bindWithKeyRep@@ -47,6 +56,8 @@   ) 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@@ -68,7 +79,7 @@ -- > index . tabulate = id -- > tabulate . return f = return f -class (Indexable f, Distributive f, Keyed f, Apply f, Applicative f, ZipWithKey f) => Representable f where+class (Functor f, Indexable f) => Representable f where   -- | > fmap f . tabulate = tabulate . fmap f   tabulate :: (Key f -> a) -> f a @@ -100,7 +111,7 @@ 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) +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)@@ -122,7 +133,7 @@  -- | 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 (fmap (l ^$)) (liftA2 (l ^=))+repLens l = lens (fmapRep (l ^$)) $ \a b -> unrep $ liftA2 (l ^=) (Rep a) (Rep b)  -- * Instances @@ -142,10 +153,75 @@   tabulate = Compose . tabulate . fmap tabulate . curry  instance Representable w => Representable (TracedT s w) where-  tabulate = TracedT . collect tabulate . curry+  -- 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.2.1.1+version:       2.4 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE