packages feed

profunctors 3.3.0.1 → 4.0

raw patch · 8 files changed

+469/−10 lines, 8 filesdep +semigroupoidsdep +transformersdep ~basedep ~comonad

Dependencies added: semigroupoids, transformers

Dependency ranges changed: base, comonad

Files

.gitignore view
@@ -1,3 +1,14 @@-_darcs-dist+dist/+.hsenv/+docs+wiki+TAGS tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#
CHANGELOG.markdown view
@@ -1,3 +1,7 @@+4.0+---+* Merged the contents of `profunctor-extras` into `profunctors`.+ 3.3 --- * Added `instance Choice (Upstar f)` and introduced `Forget`.
profunctors.cabal view
@@ -1,8 +1,8 @@ name:          profunctors category:      Control, Categories-version:       3.3.0.1+version:       4.0 license:       BSD3-cabal-version: >= 1.6+cabal-version: >= 1.10 license-file:  LICENSE author:        Edward A. Kmett maintainer:    Edward A. Kmett <ekmett@gmail.com>@@ -10,8 +10,8 @@ homepage:      http://github.com/ekmett/profunctors/ bug-reports:   http://github.com/ekmett/profunctors/issues copyright:     Copyright (C) 2011-2013 Edward A. Kmett-synopsis:      Haskell 98 Profunctors-description:   Haskell 98 Profunctors+synopsis:      Profunctors+description:   Profunctors build-type:    Simple extra-source-files:   .ghci@@ -27,13 +27,29 @@  library   build-depends:-    base    == 4.*,-    comonad >= 3     && < 4,-    tagged  >= 0.4.4 && < 1+    base                >= 4     && < 5,+    comonad             >= 4     && < 5,+    semigroupoids       >= 4     && < 5,+    tagged              >= 0.4.4 && < 1,+    transformers        >= 0.2   && < 0.4    exposed-modules:     Data.Profunctor+    Data.Profunctor.Composition+    Data.Profunctor.Collage+    Data.Profunctor.Rep+    Data.Profunctor.Rift+    Data.Profunctor.Trace     Data.Profunctor.Unsafe -  ghc-options:     -Wall+  ghc-options:     -Wall -O2   hs-source-dirs:  src++  default-language: Haskell2010+  other-extensions:+    CPP+    GADTs+    FlexibleContexts+    FlexibleInstances+    UndecidableInstances+    TypeFamilies
+ src/Data/Profunctor/Collage.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Profunctor.Collage+-- Copyright   :  (C) 2011-2012 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  MPTCs+--+----------------------------------------------------------------------------+module Data.Profunctor.Collage+  ( Collage(..)+  ) where++import Data.Semigroupoid+import Data.Semigroupoid.Ob+import Data.Semigroupoid.Coproduct (L, R)+import Data.Profunctor++-- | The cograph of a 'Profunctor'.+data Collage k b a where+  L :: (b -> b') -> Collage k (L b) (L b')+  R :: (a -> a') -> Collage k (R a) (R a')+  C :: k b a     -> Collage k (L b) (R a)++instance Profunctor k => Semigroupoid (Collage k) where+  L f `o` L g = L (f . g)+  R f `o` R g = R (f . g)+  R f `o` C g = C (rmap f g)+  C f `o` L g = C (lmap g f)++instance Profunctor k => Ob (Collage k) (L a) where+  semiid = L semiid++instance Profunctor k => Ob (Collage k) (R a) where+  semiid = R semiid
+ src/Data/Profunctor/Composition.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Profunctor.Composition+-- Copyright   :  (C) 2011-2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs+--+----------------------------------------------------------------------------+module Data.Profunctor.Composition+  (+  -- * Profunctor Composition+    Procompose(..)+  , procomposed+  -- * Lax identity+  , idl+  , idr+  -- * Generalized Composition+  , upstars, kleislis+  , downstars, cokleislis+  ) where++import Control.Arrow+import Control.Category+import Control.Comonad+import Control.Monad (liftM)+import Data.Functor.Compose+import Data.Profunctor+import Data.Profunctor.Rep+import Data.Profunctor.Unsafe+import Prelude hiding ((.),id)++-- * Profunctor Composition++-- | @'Procompose' p q@ is the 'Profunctor' composition of the+-- 'Profunctor's @p@ and @q@.+--+-- For a good explanation of 'Profunctor' composition in Haskell+-- see Dan Piponi's article:+--+-- <http://blog.sigfpe.com/2011/07/profunctors-in-haskell.html>+data Procompose p q d c where+  Procompose :: p d a -> q a c -> Procompose p q d c++procomposed :: Category p => Procompose p p a b -> p a b+procomposed (Procompose pda pac) = pac . pda+{-# INLINE procomposed #-}+++instance (Profunctor p, Profunctor q) => Profunctor (Procompose p q) where+  dimap l r (Procompose f g) = Procompose (lmap l f) (rmap r g)+  {-# INLINE dimap #-}+  lmap k (Procompose f g) = Procompose (lmap k f) g+  {-# INLINE rmap #-}+  rmap k (Procompose f g) = Procompose f (rmap k g)+  {-# INLINE lmap #-}+  k #. Procompose f g     = Procompose f (k #. g)+  {-# INLINE ( #. ) #-}+  Procompose f g .# k     = Procompose (f .# k) g+  {-# INLINE ( .# ) #-}++instance Profunctor q => Functor (Procompose p q a) where+  fmap k (Procompose f g) = Procompose f (rmap k g)+  {-# INLINE fmap #-}++-- | The composition of two 'Representable' 'Profunctor's is 'Representable' by+-- the composition of their representations.+instance (Representable p, Representable q) => Representable (Procompose p q) where+  type Rep (Procompose p q) = Compose (Rep p) (Rep q)+  tabulate f = Procompose (tabulate (getCompose . f)) (tabulate id)+  {-# INLINE tabulate #-}+  rep (Procompose f g) d = Compose $ rep g <$> rep f d+  {-# INLINE rep #-}++instance (Corepresentable p, Corepresentable q) => Corepresentable (Procompose p q) where+  type Corep (Procompose p q) = Compose (Corep q) (Corep p)+  cotabulate f = Procompose (cotabulate id) (cotabulate (f . Compose))+  {-# INLINE cotabulate #-}+  corep (Procompose f g) (Compose d) = corep g $ corep f <$> d+  {-# INLINE corep #-}++instance (Strong p, Strong q) => Strong (Procompose p q) where+  first' (Procompose x y) = Procompose (first' x) (first' y)+  {-# INLINE first' #-}+  second' (Procompose x y) = Procompose (second' x) (second' y)+  {-# INLINE second' #-}++instance (Choice p, Choice q) => Choice (Procompose p q) where+  left' (Procompose x y) = Procompose (left' x) (left' y)+  {-# INLINE left' #-}+  right' (Procompose x y) = Procompose (right' x) (right' y)+  {-# INLINE right' #-}+++-- * Lax identity++-- | @(->)@ functions as a lax identity for 'Profunctor' composition.+--+-- This provides an 'Iso' for the @lens@ package that witnesses the+-- isomorphism between @'Procompose' (->) q d c@ and @q d c@, which+-- is the left identity law.+--+-- @+-- 'idl' :: 'Profunctor' q => Iso' ('Procompose' (->) q d c) (q d c)+-- @+idl :: (Profunctor p, Profunctor q, Functor f)+    => p (q d c) (f (r d' c')) -> p (Procompose (->) q d c) (f (Procompose (->) r d' c'))+idl = dimap (\(Procompose f g) -> lmap f g) (fmap (Procompose id))++-- | @(->)@ functions as a lax identity for 'Profunctor' composition.+--+-- This provides an 'Iso' for the @lens@ package that witnesses the+-- isomorphism between @'Procompose' q (->) d c@ and @q d c@, which+-- is the right identity law.+--+-- @+-- 'idr' :: 'Profunctor' q => Iso' ('Procompose' q (->) d c) (q d c)+-- @+idr :: (Profunctor p, Profunctor q, Functor f)+    => p (q d c) (f (r d' c')) -> p (Procompose q (->) d c) (f (Procompose r (->) d' c'))+idr = dimap (\(Procompose f g) -> rmap g f) (fmap (`Procompose` id))++-- | 'Profunctor' composition generalizes 'Functor' composition in two ways.+--+-- This is the first, which shows that @exists b. (a -> f b, b -> g c)@ is+-- isomorphic to @a -> f (g c)@.+--+-- @'upstars' :: 'Functor' f => Iso' ('Procompose' ('UpStar' f) ('UpStar' g) d c) ('UpStar' ('Compose' f g) d c)@+upstars :: (Profunctor p, Functor f, Functor h)+        => p (UpStar (Compose f g) d c) (h (UpStar (Compose f' g') d' c'))+        -> p (Procompose (UpStar f) (UpStar g) d c) (h (Procompose (UpStar f') (UpStar g') d' c'))+upstars = dimap hither (fmap yon) where+  hither (Procompose (UpStar dfx) (UpStar xgc)) = UpStar (Compose . fmap xgc . dfx)+  yon (UpStar dfgc) = Procompose (UpStar (getCompose . dfgc)) (UpStar id)++-- | 'Profunctor' composition generalizes 'Functor' composition in two ways.+--+-- This is the second, which shows that @exists b. (f a -> b, g b -> c)@ is+-- isomorphic to @g (f a) -> c@.+--+-- @'downstars' :: 'Functor' f => Iso' ('Procompose' ('DownStar' f) ('DownStar' g) d c) ('DownStar' ('Compose' g f) d c)@+downstars :: (Profunctor p, Functor g, Functor h)+          => p (DownStar (Compose g f) d c) (h (DownStar (Compose g' f') d' c'))+          -> p (Procompose (DownStar f) (DownStar g) d c) (h (Procompose (DownStar f') (DownStar g') d' c'))+downstars = dimap hither (fmap yon) where+  hither (Procompose (DownStar fdx) (DownStar gxc)) = DownStar (gxc . fmap fdx . getCompose)+  yon (DownStar dgfc) = Procompose (DownStar id) (DownStar (dgfc . Compose))++-- | This is a variant on 'upstars' that uses 'Kleisli' instead of 'UpStar'.+--+-- @'kleislis' :: 'Monad' f => Iso' ('Procompose' ('Kleisli' f) ('Kleisli' g) d c) ('Kleisli' ('Compose' f g) d c)@+kleislis :: (Profunctor p, Monad f, Functor h)+        => p (Kleisli (Compose f g) d c) (h (Kleisli (Compose f' g') d' c'))+        -> p (Procompose (Kleisli f) (Kleisli g) d c) (h (Procompose (Kleisli f') (Kleisli g') d' c'))+kleislis = dimap hither (fmap yon) where+  hither (Procompose (Kleisli dfx) (Kleisli xgc)) = Kleisli (Compose . liftM xgc . dfx)+  yon (Kleisli dfgc) = Procompose (Kleisli (getCompose . dfgc)) (Kleisli id)++-- | This is a variant on 'downstars' that uses 'Cokleisli' instead+-- of 'DownStar'.+--+-- @'cokleislis' :: 'Functor' f => Iso' ('Procompose' ('Cokleisli' f) ('Cokleisli' g) d c) ('Cokleisli' ('Compose' g f) d c)@+cokleislis :: (Profunctor p, Functor g, Functor h)+          => p (Cokleisli (Compose g f) d c) (h (Cokleisli (Compose g' f') d' c'))+          -> p (Procompose (Cokleisli f) (Cokleisli g) d c) (h (Procompose (Cokleisli f') (Cokleisli g') d' c'))+cokleislis = dimap hither (fmap yon) where+  hither (Procompose (Cokleisli fdx) (Cokleisli gxc)) = Cokleisli (gxc . fmap fdx . getCompose)+  yon (Cokleisli dgfc) = Procompose (Cokleisli id) (Cokleisli (dgfc . Compose))
+ src/Data/Profunctor/Rep.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Profunctor.Rep+-- Copyright   :  (C) 2011-2012 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Type-Families+--+----------------------------------------------------------------------------+module Data.Profunctor.Rep+  (+  -- * Representable Profunctors+    Representable(..), tabulated+  -- * Corepresentable Profunctors+  , Corepresentable(..), cotabulated+  ) where++import Control.Arrow+import Control.Comonad+import Data.Functor.Identity+import Data.Profunctor+import Data.Proxy+import Data.Tagged++-- * Representable Profunctors++-- | A 'Profunctor' @p@ is 'Representable' if there exists a 'Functor' @f@ such that+-- @p d c@ is isomorphic to @d -> f c@.+class (Functor (Rep p), Profunctor p) => Representable p where+  type Rep p :: * -> *+  tabulate :: (d -> Rep p c) -> p d c+  rep :: p d c -> d -> Rep p c++instance Representable (->) where+  type Rep (->) = Identity+  tabulate f = runIdentity . f+  {-# INLINE tabulate #-}+  rep f = Identity . f+  {-# INLINE rep #-}++instance (Monad m, Functor m) => Representable (Kleisli m) where+  type Rep (Kleisli m) = m+  tabulate = Kleisli+  {-# INLINE tabulate #-}+  rep = runKleisli+  {-# INLINE rep #-}++instance Functor f => Representable (UpStar f) where+  type Rep (UpStar f) = f+  tabulate = UpStar+  {-# INLINE tabulate #-}+  rep = runUpStar+  {-# INLINE rep #-}++-- | 'tabulate' and 'rep' form two halves of an isomorphism.+--+-- This can be used with the combinators from the @lens@ package.+--+-- @'tabulated' :: 'Representable' p => 'Iso'' (d -> 'Rep' p c) (p d c)@+tabulated :: (Profunctor r, Functor f, Representable p, Representable q)+          => r (p d c) (f (q d' c'))+          -> r (d -> Rep p c) (f (d' -> Rep q c'))+tabulated = dimap tabulate (fmap rep)+{-# INLINE tabulated #-}++-- * Corepresentable Profunctors++-- | A 'Profunctor' @p@ is 'Corepresentable' if there exists a 'Functor' @f@ such that+-- @p d c@ is isomorphic to @f d -> c@.+class (Functor (Corep p), Profunctor p) => Corepresentable p where+  type Corep p :: * -> *+  cotabulate :: (Corep p d -> c) -> p d c+  corep :: p d c -> Corep p d -> c++instance Corepresentable (->) where+  type Corep (->) = Identity+  cotabulate f = f . Identity+  {-# INLINE cotabulate #-}+  corep f (Identity d) = f d+  {-# INLINE corep #-}++instance Functor w => Corepresentable (Cokleisli w) where+  type Corep (Cokleisli w) = w+  cotabulate = Cokleisli+  {-# INLINE cotabulate #-}+  corep = runCokleisli+  {-# INLINE corep #-}++instance Corepresentable Tagged where+  type Corep Tagged = Proxy+  cotabulate f = Tagged (f Proxy)+  {-# INLINE cotabulate #-}+  corep (Tagged a) _ = a+  {-# INLINE corep #-}++instance Functor f => Corepresentable (DownStar f) where+  type Corep (DownStar f) = f+  cotabulate = DownStar+  {-# INLINE cotabulate #-}+  corep = runDownStar+  {-# INLINE corep #-}++-- | 'cotabulate' and 'corep' form two halves of an isomorphism.+--+-- This can be used with the combinators from the @lens@ package.+--+-- @'tabulated' :: 'Corep' f p => 'Iso'' (f d -> c) (p d c)@+cotabulated :: (Profunctor r, Functor h, Corepresentable p, Corepresentable q)+          => r (p d c) (h (q d' c'))+          -> r (Corep p d -> c) (h (Corep q d' -> c'))+cotabulated = dimap cotabulate (fmap corep)+{-# INLINE cotabulated #-}
+ src/Data/Profunctor/Rift.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2013 Edward Kmett and Dan Doel+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  Rank2Types+--+----------------------------------------------------------------------------+module Data.Profunctor.Rift+  ( Rift(..)+  , decomposeRift+  , precomposeRift+  ) where++import Control.Category+import Data.Profunctor.Unsafe+import Data.Profunctor.Composition+import Prelude hiding (id,(.))++-- | This represents the right Kan lift of a 'Profunctor' @q@ along a 'Profunctor' @p@ in a limited version of the 2-category of Profunctors where the only object is the category Hask, 1-morphisms are profunctors composed and compose with Profunctor composition, and 2-morphisms are just natural transformations.+newtype Rift p q a b = Rift { runRift :: forall x. p x a -> q x b }++--  Ran f g a = forall b. (a -> f b) -> g b++instance (Profunctor p, Profunctor q) => Profunctor (Rift p q) where+  dimap ca bd f = Rift (rmap bd . runRift f . rmap ca)+  {-# INLINE dimap #-}+  lmap ca f = Rift (runRift f . rmap ca)+  {-# INLINE lmap #-}+  rmap bd f = Rift (rmap bd . runRift f)+  {-# INLINE rmap #-}+  bd #. f = Rift (\p -> bd #. runRift f p)+  {-# INLINE ( #. ) #-}+  f .# ca = Rift (\p -> runRift f (ca #. p))+  {-# INLINE (.#) #-}++instance Profunctor q => Functor (Rift p q a) where+  fmap bd f = Rift (rmap bd . runRift f)+  {-# INLINE fmap #-}++-- | @'Rift' p p@ forms a 'Monad' in the 'Profunctor' 2-category, which is isomorphic to a Haskell 'Category' instance.+instance p ~ q => Category (Rift p q) where+  id = Rift id+  {-# INLINE id #-}+  Rift f . Rift g = Rift (f . g)+  {-# INLINE (.) #-}++-- | The 2-morphism that defines a right Kan lift.+--+-- Note: When @f@ is left adjoint to @'Rift' f (->)@ then 'decomposeRift' is the 'counit' of the adjunction.+decomposeRift :: Procompose q (Rift q p) a b -> p a b+decomposeRift (Procompose q (Rift qp)) = qp q+{-# INLINE decomposeRift #-}++precomposeRift :: Profunctor q => Procompose (Rift p (->)) q a b -> Rift p q a b+precomposeRift (Procompose pf p) = Rift (\pxa -> runRift pf pxa `lmap` p)+{-# INLINE precomposeRift #-}
+ src/Data/Profunctor/Trace.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE GADTs #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Profunctor.Trace+-- Copyright   :  (C) 2011-2012 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  GADTs+--+----------------------------------------------------------------------------+module Data.Profunctor.Trace+  ( Trace(..)+  ) where++-- | Coend of 'Data.Profunctor.Profunctor' from @Hask -> Hask@.+data Trace f where+  Trace :: f a a -> Trace f