representable-functors-3.2.0.2/0000755000000000000000000000000012226532744014545 5ustar0000000000000000representable-functors-3.2.0.2/.ghci0000644000000000000000000000012512226532744015456 0ustar0000000000000000:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h representable-functors-3.2.0.2/.gitignore0000644000000000000000000000010412226532744016530 0ustar0000000000000000dist docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# representable-functors-3.2.0.2/.travis.yml0000644000000000000000000000035312226532744016657 0ustar0000000000000000language: haskell notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313representable-functors\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" representable-functors-3.2.0.2/.vim.custom0000644000000000000000000000137712226532744016662 0ustar0000000000000000" Add the following to your .vimrc to automatically load this on startup " if filereadable(".vim.custom") " so .vim.custom " endif function StripTrailingWhitespace() let myline=line(".") let mycolumn = col(".") silent %s/ *$// call cursor(myline, mycolumn) endfunction " enable syntax highlighting syntax on " search for the tags file anywhere between here and / set tags=TAGS;/ " highlight tabs and trailing spaces set listchars=tab:‗‗,trail:‗ set list " f2 runs hasktags map :exec ":!hasktags -x -c --ignore src" " strip trailing whitespace before saving " au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() " rebuild hasktags after saving au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" representable-functors-3.2.0.2/CHANGELOG.markdown0000644000000000000000000000105512226532744017601 0ustar00000000000000003.2.0.2 * Updated array dependency * Added proper upper bounds on dependencies 3.2.0.1 ------- * Fixed issue [#1](https://github.com/ekmett/representable-functors/pull/1). Did `RULES` parsing change with GHC 7.6.3? 3.2 --- * Added Day Convolution 3.1 --- * Required Distributive as a superclass * Renamed `Data.Functor.Corepresentable` to `Data.Functor.Contravariant.Representable` to finally clean up this long-standing abuse of terminology. 3.0.1 ----- * Removed intra-package dependencies * Added `README.markdown` * Added IRC build-bot notification representable-functors-3.2.0.2/LICENSE0000644000000000000000000000266012226532744015556 0ustar0000000000000000Copyright 2011-2013 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 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 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. representable-functors-3.2.0.2/README.markdown0000644000000000000000000000142212226532744017245 0ustar0000000000000000representable-functors ====================== [![Build Status](https://secure.travis-ci.org/ekmett/representable-functors.png?branch=master)](http://travis-ci.org/ekmett/representable-functors) This package provides representable functors for haskell. In category theory a representable functor (more pedantically a corepresentable functor) is one such that `f a` is isomorphic to `x -> a`. We choose the name `Representable` here because we are talking about haskell `Functor` instances, and they are all covariant, so this is the more natural notion of representability for Haskell. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett representable-functors-3.2.0.2/representable-functors.cabal0000644000000000000000000000352512226532744022232 0ustar0000000000000000name: representable-functors category: Monads, Functors, Data Structures version: 3.2.0.2 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/representable-functors/ bug-reports: http://github.com/ekmett/representable-functors/issues copyright: Copyright (C) 2011-2013 Edward A. Kmett synopsis: Representable functors description: Representable functors build-type: Simple extra-source-files: .ghci .gitignore .vim.custom .travis.yml README.markdown CHANGELOG.markdown source-repository head type: git location: git://github.com/ekmett/representable-functors.git library hs-source-dirs: src other-extensions: CPP FlexibleContexts FlexibleInstances GADTs MultiParamTypeClasses TypeFamilies TypeOperators TypeSynonymInstances UndecidableInstances build-depends: array >= 0.3.0.2 && < 0.6, base >= 4 && < 5, comonad >= 3 && < 4, comonad-transformers >= 3 && < 4, comonads-fd >= 3 && < 4, containers >= 0.3 && < 0.6, contravariant >= 0.4.1 && < 1, distributive >= 0.2.2 && < 1, free >= 3 && < 4, keys >= 3 && < 4, mtl >= 2.0.1.0 && < 2.2, semigroups >= 0.8.3.1 && < 1, semigroupoids >= 3 && < 4, transformers >= 0.2 && < 0.4 exposed-modules: Data.Functor.Contravariant.Representable Data.Functor.Representable Control.Monad.Representable.Reader Control.Monad.Representable.State Control.Comonad.Representable.Store ghc-options: -Wall representable-functors-3.2.0.2/Setup.lhs0000644000000000000000000000016512226532744016357 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain representable-functors-3.2.0.2/src/0000755000000000000000000000000012226532744015334 5ustar0000000000000000representable-functors-3.2.0.2/src/Control/0000755000000000000000000000000012226532744016754 5ustar0000000000000000representable-functors-3.2.0.2/src/Control/Comonad/0000755000000000000000000000000012226532744020334 5ustar0000000000000000representable-functors-3.2.0.2/src/Control/Comonad/Representable/0000755000000000000000000000000012226532744023127 5ustar0000000000000000representable-functors-3.2.0.2/src/Control/Comonad/Representable/Store.hs0000644000000000000000000001033212226532744024556 0ustar0000000000000000{-# 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) representable-functors-3.2.0.2/src/Control/Monad/0000755000000000000000000000000012226532744020012 5ustar0000000000000000representable-functors-3.2.0.2/src/Control/Monad/Representable/0000755000000000000000000000000012226532744022605 5ustar0000000000000000representable-functors-3.2.0.2/src/Control/Monad/Representable/Reader.hs0000644000000000000000000001447112226532744024352 0ustar0000000000000000{-# 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 representable-functors-3.2.0.2/src/Control/Monad/Representable/State.hs0000644000000000000000000001724712226532744024234 0ustar0000000000000000{-# 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 representable-functors-3.2.0.2/src/Data/0000755000000000000000000000000012226532744016205 5ustar0000000000000000representable-functors-3.2.0.2/src/Data/Functor/0000755000000000000000000000000012226532744017625 5ustar0000000000000000representable-functors-3.2.0.2/src/Data/Functor/Representable.hs0000644000000000000000000001560412226532744022762 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -fenable-rewrite-rules #-} ---------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2011-2013 -- 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 (Distributive 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) representable-functors-3.2.0.2/src/Data/Functor/Contravariant/0000755000000000000000000000000012226532744022440 5ustar0000000000000000representable-functors-3.2.0.2/src/Data/Functor/Contravariant/Representable.hs0000644000000000000000000000775112226532744025601 0ustar0000000000000000{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-} {-# OPTIONS_GHC -fenable-rewrite-rules #-} ---------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2011-2013 -- 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.Representable ( -- * Values Value -- * Contravariant Keyed , Valued(..) -- * Contravariant Indexed , Coindexed(..) -- * Representable Contravariant Functors , Representable(..) -- * Default definitions , contramapDefault , contramapWithValueDefault ) where import Control.Monad.Reader import Data.Functor.Contravariant import Data.Functor.Contravariant.Day 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 instance (Valued f, Valued g) => Valued (Day f g) where contramapWithValue d2eafg (Day fb gc abc) = Day (contramapWithValue id fb) (contramapWithValue 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) -- | Dual to 'Indexed'. class Coindexed f where coindex :: f a -> a -> Value f type instance Value (Day f g) = (Value f, Value g) instance (Coindexed f, Coindexed g) => Coindexed (Day f g) where coindex (Day fb gc abc) a = case abc a of (b, c) -> (coindex fb b, coindex gc c) -- | A 'Contravariant' functor @f@ is 'Representable' if 'contrarep' and 'coindex' witness an isomorphism to @(_ -> Value f)@. class (Coindexed f, Valued f) => Representable f where -- | > contramap f (contrarep g) = contrarep (g . f) contrarep :: (a -> Value f) -> f a instance (Representable f, Representable g) => Representable (Day f g) where contrarep a2fg = Day (contrarep fst) (contrarep snd) $ \a -> let b = a2fg a in (b,b) {-# INLINE contrarep #-} {-# RULES "contrarep/coindex" forall t. contrarep (coindex t) = t #-} -- * Default definitions contramapDefault :: Representable f => (a -> b) -> f b -> f a contramapDefault f = contrarep . (. f) . coindex contramapWithValueDefault :: Representable f => (b -> Either a (Value f)) -> f a -> f b contramapWithValueDefault f p = contrarep $ 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 Representable (Op r) where contrarep = Op -- * Predicates type instance Value Predicate = Bool instance Valued Predicate where contramapWithValue = contramapWithValueDefault instance Coindexed Predicate where coindex = getPredicate instance Representable Predicate where contrarep = 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 (Representable f, Representable g) => Representable (Product f g) where contrarep f = Pair (contrarep (fst . f)) (contrarep (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