profunctors 4.1 → 4.2

raw patch · 11 files changed

+87/−28 lines, 11 files

Files

• CHANGELOG.markdown +5/−0
• profunctors.cabal +2/−1
• src/Data/Profunctor.hs +3/−2
• src/Data/Profunctor/Adjunction.hs +4/−3
• src/Data/Profunctor/Cayley.hs +4/−1
• src/Data/Profunctor/Closed.hs +9/−3
• src/Data/Profunctor/Composition.hs +10/−2
• src/Data/Profunctor/Monad.hs +9/−6
• src/Data/Profunctor/Monoid.hs +16/−0
• src/Data/Profunctor/Ran.hs +7/−4
• src/Data/Profunctor/Tambara.hs +18/−6

@@ -1,3 +1,8 @@+4.2+---+* Renamed `-|` to `ProfunctorAdjunction` because GHC 7.4 still exists in the wild.+* Renamed `-/->` to `:->` for the same reason. Also the former was confusing as they conflated profunctor homomorphisms and profunctors themselves.+ 4.1 --- * Flipped the order of 'Procompose'

@@ -1,6 +1,6 @@ name:          profunctors category:      Control, Categories-version:       4.1+version:       4.2 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE@@ -43,6 +43,7 @@     Data.Profunctor.Composition     Data.Profunctor.Collage     Data.Profunctor.Monad+    Data.Profunctor.Monoid     Data.Profunctor.Ran     Data.Profunctor.Rep     Data.Profunctor.Tambara

@@ -34,7 +34,7 @@   , WrappedArrow(..)   , Forget(..) #ifndef HLINT-  , type (-/->)+  , type (:->) #endif   ) where @@ -51,7 +51,8 @@ import Prelude hiding (id,(.),sequence) import Unsafe.Coerce -type p -/-> q = forall a b. p a b -> q a b+infixr 0 :->+type p :-> q = forall a b. p a b -> q a b  ------------------------------------------------------------------------------ -- UpStar

@@ -5,7 +5,8 @@ module Data.Profunctor.Adjunction where  import Data.Profunctor+import Data.Profunctor.Monad -class f -| u | f -> u, u -> f where-  unit   :: Profunctor p => p -/-> u (f p)-  counit :: Profunctor p => f (u p) -/-> p+class (ProfunctorFunctor f, ProfunctorFunctor u) => ProfunctorAdjunction f u | f -> u, u -> f where+  unit   :: Profunctor p => p :-> u (f p)+  counit :: Profunctor p => f (u p) :-> p

@@ -27,8 +27,11 @@ -- static arrows newtype Cayley f p a b = Cayley { runCayley :: f (p a b) } +instance Functor f => ProfunctorFunctor (Cayley f) where+  promap f (Cayley p) = Cayley (fmap f p)+ -- | Cayley transforms Monads in @Hask@ into monads on @Prof@-instance Monad f => ProfunctorMonad (Cayley f) where+instance (Functor f, Monad f) => ProfunctorMonad (Cayley f) where   proreturn = Cayley . return   projoin (Cayley m) = Cayley $ m >>= runCayley 

@@ -76,6 +76,9 @@   w #. Closure p = Closure $ fmap w #. p   Closure p .# w = Closure $ p .# fmap w +instance ProfunctorFunctor Closure where+  promap f (Closure p) = Closure (f p)+ instance ProfunctorComonad Closure where   proextract = dimap const ($ ()) . runClosure   produplicate (Closure p) = Closure $ Closure $ dimap uncurry curry p@@ -129,7 +132,7 @@ -- 'close' '.' 'unclose' ≡ 'id' -- 'unclose' '.' 'close' ≡ 'id' -- @-close :: Closed p => (p -/-> q) -> p -/-> Closure q+close :: Closed p => (p :-> q) -> p :-> Closure q close f p = Closure $ f $ closed p  -- |@@ -137,7 +140,7 @@ -- 'close' '.' 'unclose' ≡ 'id' -- 'unclose' '.' 'close' ≡ 'id' -- @-unclose :: Profunctor q => (p -/-> Closure q) -> p -/-> q+unclose :: Profunctor q => (p :-> Closure q) -> p :-> q unclose f p = dimap const ($ ()) $ runClosure $ f p  --------------------------------------------------------------------------------@@ -154,12 +157,15 @@   w #. Environment l m r = Environment (w #. l) m r   Environment l m r .# w = Environment l m (r .# w) +instance ProfunctorFunctor Environment where+  promap f (Environment l m r) = Environment l (f m) r+ instance ProfunctorMonad Environment where   proreturn p = Environment ($ ()) p const   projoin (Environment l (Environment m n o) p) = Environment (lm . curry) n op where     op a (b, c) = o (p a b) c     lm zr = l (m.zr) -instance Environment -| Closure where+instance ProfunctorAdjunction Environment Closure where   counit (Environment g (Closure p) f) = dimap f g p   unit p = Closure (Environment id p id)

@@ -62,6 +62,9 @@ data Procompose p q d c where   Procompose :: p x c -> q d x -> Procompose p q d c +instance ProfunctorFunctor (Procompose p) where+  promap f (Procompose p q) = Procompose p (f q)+ instance Category p => ProfunctorMonad (Procompose p) where   proreturn = Procompose id   projoin (Procompose p (Procompose q r)) = Procompose (p . q) r@@ -217,6 +220,9 @@ -- | 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 b x -> q a x } +instance ProfunctorFunctor (Rift p) where+  promap f (Rift g) = Rift (f . g)+ instance Category p => ProfunctorComonad (Rift p) where   proextract (Rift f) = f id   produplicate (Rift f) = Rift $ \p -> Rift $ \q -> f (q . p)@@ -247,10 +253,12 @@ -- | The 2-morphism that defines a left Kan lift. -- -- Note: When @p@ is right adjoint to @'Rift' p (->)@ then 'decomposeRift' is the 'counit' of the adjunction.-decomposeRift :: Procompose p (Rift p q) -/-> q+decomposeRift :: Procompose p (Rift p q) :-> q decomposeRift (Procompose p (Rift pq)) = pq p {-# INLINE decomposeRift #-} -instance Procompose p -| Rift p where+instance ProfunctorAdjunction (Procompose p) (Rift p) where   counit (Procompose p (Rift pq)) = pq p   unit q = Rift $ \p -> Procompose p q++--instance (ProfunctorAdjunction f g, ProfunctorAdjunction f' g') => ProfunctorAdjunction (ProfunctorCompose f' f) (ProfunctorCompose g g') where

@@ -4,10 +4,13 @@  import Data.Profunctor -class ProfunctorMonad t where-  proreturn :: Profunctor p => p -/-> t p-  projoin   :: Profunctor p => t (t p) -/-> t p+class ProfunctorFunctor t where+  promap    :: Profunctor p => (p :-> q) -> t p :-> t q -class ProfunctorComonad t where-  proextract :: Profunctor p => t p -/-> p-  produplicate :: Profunctor p => t p -/-> t (t p)+class ProfunctorFunctor t => ProfunctorMonad t where+  proreturn :: Profunctor p => p :-> t p+  projoin   :: Profunctor p => t (t p) :-> t p++class ProfunctorFunctor t => ProfunctorComonad t where+  proextract :: Profunctor p => t p :-> p+  produplicate :: Profunctor p => t p :-> t (t p)

@@ -0,0 +1,16 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE NoImplicitPrelude #-}+module Data.Profunctor.Monoid where++import Control.Category+import Data.Profunctor+import Data.Profunctor.Composition++-- | a 'Category' that is also a 'Profunctor' is a 'Monoid' in @Prof@++eta :: (Profunctor p, Category p) => (->) :-> p+eta f = rmap f id++mu :: Category p => Procompose p p :-> p+mu (Procompose f g) = f . g

@@ -33,6 +33,9 @@ -- | This represents the right Kan extension 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 Ran p q a b = Ran { runRan :: forall x. p x a -> q x b } +instance ProfunctorFunctor (Ran p) where+  promap f (Ran g) = Ran (f . g)+ instance Category p => ProfunctorComonad (Ran p) where   proextract (Ran f) = f id   produplicate (Ran f) = Ran $ \ p -> Ran $ \q -> f (p . q)@@ -63,18 +66,18 @@ -- | The 2-morphism that defines a right Kan extension. -- -- Note: When @q@ is left adjoint to @'Ran' q (->)@ then 'decomposeRan' is the 'counit' of the adjunction.-decomposeRan :: Procompose (Ran q p) q -/-> p+decomposeRan :: Procompose (Ran q p) q :-> p decomposeRan (Procompose (Ran qp) q) = qp q {-# INLINE decomposeRan #-} -precomposeRan :: Profunctor q => Procompose q (Ran p (->)) -/-> Ran p q+precomposeRan :: Profunctor q => Procompose q (Ran p (->)) :-> Ran p q precomposeRan (Procompose p pf) = Ran (\pxa -> runRan pf pxa `lmap` p) {-# INLINE precomposeRan #-} -curryRan :: (Procompose p q -/-> r) -> p -/-> Ran q r+curryRan :: (Procompose p q :-> r) -> p :-> Ran q r curryRan f p = Ran $ \q -> f (Procompose p q) {-# INLINE curryRan #-} -uncurryRan :: (p -/-> Ran q r) -> Procompose p q -/-> r+uncurryRan :: (p :-> Ran q r) -> Procompose p q :-> r uncurryRan f (Procompose p q) = runRan (f p) q {-# INLINE uncurryRan #-}

@@ -45,6 +45,9 @@   dimap f g (Tambara p) = Tambara $ dimap (first f) (first g) p   {-# INLINE dimap #-} +instance ProfunctorFunctor Tambara where+  promap f (Tambara p) = Tambara (f p)+ instance ProfunctorComonad Tambara where   proextract (Tambara p) = dimap (\a -> (a,())) fst p   produplicate (Tambara p) = Tambara (Tambara $ dimap hither yon p) where@@ -111,7 +114,7 @@ -- 'tambara' '.' 'untambara' ≡ 'id' -- 'untambara' '.' 'tambara' ≡ 'id' -- @-tambara :: Strong p => (p -/-> q) -> p -/-> Tambara q+tambara :: Strong p => (p :-> q) -> p :-> Tambara q tambara f p = Tambara $ f $ first' p  -- |@@ -119,7 +122,7 @@ -- 'tambara' '.' 'untambara' ≡ 'id' -- 'untambara' '.' 'tambara' ≡ 'id' -- @-untambara :: Profunctor q => (p -/-> Tambara q) -> p -/-> q+untambara :: Profunctor q => (p :-> Tambara q) -> p :-> q untambara f p = dimap (\a -> (a,())) fst $ runTambara $ f p  ----------------------------------------------------------------------------@@ -137,6 +140,9 @@   w #. Pastro l m r = Pastro (w #. l) m r   Pastro l m r .# w = Pastro l m (r .# w) +instance ProfunctorFunctor Pastro where+  promap f (Pastro l m r) = Pastro l (f m) r+ instance ProfunctorMonad Pastro where   proreturn p = Pastro fst p $ \a -> (a,())   projoin (Pastro l (Pastro m n o) p) = Pastro lm n op where@@ -145,7 +151,7 @@          (c, g) -> (c, (f, g))      lm (d, (f, g)) = l (m (d, g), f)     -instance Pastro -| Tambara where+instance ProfunctorAdjunction Pastro Tambara where   counit (Pastro g (Tambara p) f) = dimap f g p   unit p = Tambara (Pastro id p id) @@ -156,6 +162,9 @@ -- | Cotambara is freely adjoins respect for cocartesian structure to a profunctor newtype Cotambara p a b = Cotambara { runCotambara :: forall c. p (Either a c) (Either b c) } +instance ProfunctorFunctor Cotambara where+  promap f (Cotambara p) = Cotambara (f p)+ instance ProfunctorComonad Cotambara where   proextract (Cotambara p)   = dimap Left (\(Left a) -> a) p   produplicate (Cotambara p) = Cotambara (Cotambara $ dimap hither yon p) where@@ -186,7 +195,7 @@ -- 'cotambara' '.' 'uncotambara' ≡ 'id' -- 'uncotambara' '.' 'cotambara' ≡ 'id' -- @-cotambara :: Choice p => (p -/-> q) -> p -/-> Cotambara q+cotambara :: Choice p => (p :-> q) -> p :-> Cotambara q cotambara f p = Cotambara $ f $ left' p  -- |@@ -194,7 +203,7 @@ -- 'cotambara' '.' 'uncotambara' ≡ 'id' -- 'uncotambara' '.' 'cotambara' ≡ 'id' -- @-uncotambara :: Profunctor q => (p -/-> Cotambara q) -> p -/-> q+uncotambara :: Profunctor q => (p :-> Cotambara q) -> p :-> q uncotambara f p = dimap Left (\(Left a) -> a) $ runCotambara $ f p  ----------------------------------------------------------------------------@@ -212,9 +221,12 @@   w #. Copastro l m r = Copastro (w #. l) m r   Copastro l m r .# w = Copastro l m (r .# w) -instance Copastro -| Cotambara where+instance ProfunctorAdjunction Copastro Cotambara where   counit (Copastro f (Cotambara g) h) = dimap h f g   unit p = Cotambara $ Copastro id p id++instance ProfunctorFunctor Copastro where+  promap f (Copastro l m r) = Copastro l (f m) r  instance ProfunctorMonad Copastro where   proreturn p = Copastro (\(Left a)-> a) p Left