profunctor-extras 3.3.1 → 3.3.3

raw patch · 3 files changed

+74/−1 lines, 3 files

Files

• profunctor-extras.cabal +2/−1
• src/Data/Profunctor/Composition.hs +8/−0
• src/Data/Profunctor/Rift.hs +64/−0

@@ -1,6 +1,6 @@ name:             profunctor-extras category:         Control, Categories-version:          3.3.1+version:          3.3.3 license:          BSD3 cabal-version:    >= 1.6 license-file:     LICENSE@@ -49,6 +49,7 @@     Data.Profunctor.Composition     Data.Profunctor.Collage     Data.Profunctor.Rep+    Data.Profunctor.Rift     Data.Profunctor.Trace    ghc-options:      -Wall

@@ -19,6 +19,7 @@   (   -- * Profunctor Composition     Procompose(..)+  , procomposed   -- * Lax identity   , idl   , idr@@ -28,12 +29,14 @@   ) 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 @@ -46,6 +49,11 @@ -- <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)

@@ -0,0 +1,64 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ImplicitParams #-}+#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 }++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 #-}