packages feed

representable-functors (empty) → 0.1.0

raw patch · 5 files changed

+352/−0 lines, 5 filesdep +arraydep +basedep +comonadsetup-changed

Dependencies added: array, base, comonad, comonad-transformers, containers, contravariant, distributive, keys, mtl, semigroupoids, semigroups, transformers

Files

+ Control/Monad/Representable.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE GADTs, TypeFamilies, TypeOperators, CPP, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeSynonymInstances #-}+{-# OPTIONS_GHC -fenable-rewrite-rules -fno-warn-orphans #-}+----------------------------------------------------------------------+-- |+-- Module      :  Control.Monad.Representable+-- 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+  ( +  -- * Representable functor monad+    Rep, rep, runRep+  -- * Monad Transformer+  , RepT(..)+  , module Data.Functor.Representable+  ) where++import Control.Applicative+import Control.Comonad+import Control.Monad.Reader+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.Monoid+import Data.Traversable+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Prelude hiding (lookup)++type Rep f = RepT f Identity++rep :: Functor f => f b -> Rep f b+rep = RepT . fmap Identity++runRep :: Functor f => Rep f b -> f b+runRep = fmap runIdentity . runRepT++-- * This 'tabulateresentable monad transformer' transforms any monad @m@ with a 'Representable' 'Monad'.+--   This monad in turn is also tabulateresentable if @m@ is 'Representable'.+newtype RepT f m b = RepT { runRepT :: f (m b) }++type instance Key (RepT f m) = (Key f, Key m)++instance (Functor f, Functor m) => Functor (RepT f m) where+  fmap f = RepT . fmap (fmap f) . runRepT++instance (Representable f, Apply m) => Apply (RepT f m) where+  RepT ff <.> RepT fa = RepT ((<.>) <$> ff <.> fa)++instance (Representable f, Applicative m) => Applicative (RepT f m) where+  pure = RepT . pure . pure +  RepT ff <*> RepT fa = RepT ((<*>) <$> ff <*> fa)++instance (Representable f, Bind m) => Bind (RepT f m) where+  RepT fm >>- f = RepT $ tabulate (\a -> index fm a >>- flip index a . runRepT . f)++instance (Representable f, Monad m) => Monad (RepT f m) where+  return = RepT . pure . return+  RepT fm >>= f = RepT $ tabulate (\a -> index fm a >>= flip index a . runRepT . f)++-- instance (Representable f, Monad m) => MonadReader (Key f) (RepT f m) where ask = RepT (tabulate return)++instance Representable f => MonadTrans (RepT f) where+  lift = RepT . pure ++instance (Representable f, Distributive m) => Distributive (RepT f m) where+  distribute = RepT . fmap distribute . collect runRepT++instance (Keyed f, Keyed m) => Keyed (RepT f m) where+  mapWithKey f = RepT . mapWithKey (\k -> mapWithKey (f . (,) k)) . runRepT++instance (Index f, Index m) => Index (RepT f m) where+  index = uncurry . fmap index . index . runRepT++instance (Lookup f, Lookup m) => Lookup (RepT f m) where+  lookup (k,k') (RepT fm) = lookup k fm >>= lookup k'++instance (Representable f, Representable m) => Representable (RepT f m) where+  tabulate = RepT . tabulate . fmap tabulate . curry+  +instance (Foldable f, Foldable m) => Foldable (RepT f m) where+  foldMap f = foldMap (foldMap f) . runRepT++instance (Foldable1 f, Foldable1 m) => Foldable1 (RepT f m) where+  foldMap1 f = foldMap1 (foldMap1 f) . runRepT++instance (FoldableWithKey f, FoldableWithKey m) => FoldableWithKey (RepT f m) where+  foldMapWithKey f = foldMapWithKey (\k -> foldMapWithKey (f . (,) k)) . runRepT++instance (FoldableWithKey1 f, FoldableWithKey1 m) => FoldableWithKey1 (RepT f m) where+  foldMapWithKey1 f = foldMapWithKey1 (\k -> foldMapWithKey1 (f . (,) k)) . runRepT ++instance (Traversable f, Traversable m) => Traversable (RepT f m) where+  traverse f = fmap RepT . traverse (traverse f) . runRepT++instance (Traversable1 f, Traversable1 m) => Traversable1 (RepT f m) where+  traverse1 f = fmap RepT . traverse1 (traverse1 f) . runRepT++instance (TraversableWithKey f, TraversableWithKey m) => TraversableWithKey (RepT f m) where+  traverseWithKey f = fmap RepT . traverseWithKey (\k -> traverseWithKey (f . (,) k)) . runRepT++instance (TraversableWithKey1 f, TraversableWithKey1 m) => TraversableWithKey1 (RepT f m) where+  traverseWithKey1 f = fmap RepT . traverseWithKey1 (\k -> traverseWithKey1 (f . (,) k)) . runRepT++instance (Representable f, Representable m, Semigroup (Key f), Semigroup (Key m)) => Extend (RepT f m) where+  extend = extendRep+  duplicate = duplicateRep++instance (Representable f, Representable m, Semigroup (Key f), Semigroup (Key m), Monoid (Key f), Monoid (Key m)) => Comonad (RepT f m) where+  extract = extractRep++instance (Representable f, MonadIO m) => MonadIO (RepT f m) where+  liftIO = lift . liftIO ++instance (Representable f, MonadWriter w m) => MonadWriter w (RepT f m) where+  tell = lift . tell+  listen (RepT m) = RepT $ tabulate $ Writer.listen . index m+  pass (RepT m) = RepT $ tabulate $ Writer.pass . index m+
+ Data/Functor/Representable.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-}+{-# OPTIONS_GHC -fenable-rewrite-rules -fno-warn-orphans #-}+----------------------------------------------------------------------+-- |+-- 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(..)+  -- * Default definitions+  -- ** Functor+  , fmapRep+  -- ** Distributive+  , distributeRep+  -- ** Keyed+  , mapWithKeyRep+  -- ** Apply/Applicative+  , apRep+  , pureRep+  -- ** Bind/Monad+  , bindRep+  , bindWithKeyRep+  -- ** MonadReader+  , askRep+  , localRep+  -- ** Extend+  , duplicateRep+  , extendRep+  -- ** Comonad+  , extractRep+  ) where++import Control.Applicative+import Control.Comonad.Trans.Traced+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.Monoid+import Prelude hiding (lookup)++-- | A 'Functor' @f@ is 'Representable' if 'tabulate' and 'index' witness a monad isomorphism to @(->) x@.+--+-- > tabulate . index = id+-- > index . tabulate = id+-- > tabulate . return f = return f++class (Index f, Distributive f, Keyed f, Apply f, Applicative f, Bind f, Monad 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) ++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 :: (Index f, Monoid (Key f)) => f a -> a+extractRep fa = index fa mempty++-- * 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++-- * Orphans++instance (Representable f, Bind m) => Bind (Compose f m) where+  Compose fm >>- f = Compose $ tabulate (\a -> index fm a >>- flip index a . getCompose . f)++instance Representable w => Monad (TracedT s w) where+  return = TracedT . pure . pure+  TracedT fm >>= f = TracedT $ tabulate (\a -> index fm a >>= flip index a . runTracedT . f)++instance Representable w => Bind (TracedT s w) where+  TracedT fm >>- f = TracedT $ tabulate (\a -> index fm a >>- flip index a . runTracedT . f)+  +instance (Representable f, Monad m) => Monad (Compose f m) where+  return = Compose . pure . return+  Compose fm >>= f = Compose $ tabulate (\a -> index fm a >>= flip index a . getCompose . f)+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright 2011 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.
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ representable-functors.cabal view
@@ -0,0 +1,39 @@+name:          representable-functors+category:      Monads, Functors, Data Structures+version:       0.1.0+license:       BSD3+cabal-version: >= 1.6+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      http://github.com/ekmett/representable-functors/+copyright:     Copyright (C) 2011 Edward A. Kmett+synopsis:      Adjunctions+description:   Adjunctions+build-type:    Simple++source-repository head+  type: git+  location: git://github.com/ekmett/representable-functors.git++library+  build-depends: +    array >= 0.3.0.2 && < 0.4,+    base >= 4 && < 4.4,+    comonad >= 1.0 && < 1.1,+    comonad-transformers >= 1.5.0.3 && < 1.6,+    containers >= 0.4 && < 0.5,+    contravariant >= 0.1.2 && < 0.2,+    distributive >= 0.1.1 && < 0.2,+    keys >= 0.1.0 && < 0.2,+    mtl >= 2.0.1.0 && < 2.1,+    semigroups >= 0.3.4 && < 0.4,+    semigroupoids >= 1.1.1 && < 1.2.0,+    transformers >= 0.2.0 && < 0.3++  exposed-modules:+    Data.Functor.Representable+    Control.Monad.Representable++  ghc-options: -Wall