profunctors 5.1.1 → 5.1.2
raw patch · 7 files changed
+116/−4 lines, 7 filesdep +bifunctorsdep +contravariant
Dependencies added: bifunctors, contravariant
Files
- CHANGELOG.markdown +4/−0
- README.markdown +2/−2
- profunctors.cabal +3/−1
- src/Data/Profunctor.hs +3/−1
- src/Data/Profunctor/Rep.hs +79/−0
- src/Data/Profunctor/Tambara.hs +6/−0
- src/Data/Profunctor/Unsafe.hs +19/−0
CHANGELOG.markdown view
@@ -1,3 +1,7 @@+5.1.2+-----+* Added `Prep` and `Coprep` along with witnesses to the adjunctions `Prep -| Star : [Hask,Hask] -> Prof` and `Coprep -| Costar : [Hask,Hask]^op -> Prof`.+ 5.1.1 ----- * Add proper support for GHC 7.0+.
README.markdown view
@@ -1,9 +1,9 @@ Profunctors =========== -[](http://travis-ci.org/ekmett/profunctors)+[](https://hackage.haskell.org/package/profunctors) [](http://travis-ci.org/ekmett/profunctors) -Haskell 98 Profunctors+Profunctors for Haskell. Contact Information -------------------
profunctors.cabal view
@@ -1,6 +1,6 @@ name: profunctors category: Control, Categories-version: 5.1.1+version: 5.1.2 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -30,7 +30,9 @@ library build-depends: base >= 4 && < 5,+ bifunctors >= 5 && < 6, comonad >= 4 && < 5,+ contravariant >= 1 && < 2, distributive >= 0.4.4 && < 1, tagged >= 0.4.4 && < 1, transformers >= 0.2 && < 0.5
src/Data/Profunctor.hs view
@@ -103,7 +103,9 @@ Star f <|> Star g = Star $ \a -> f a <|> g a instance Monad f => Monad (Star f a) where+#if __GLASGOW_HASKELL__ < 710 return a = Star $ \_ -> return a+#endif Star m >>= f = Star $ \ e -> do a <- m e runStar (f a) e@@ -153,7 +155,7 @@ m <* _ = m instance Monad (Costar f a) where- return a = Costar $ \_ -> a+ return = pure Costar m >>= f = Costar $ \ x -> runCostar (f (m x)) x ------------------------------------------------------------------------------
src/Data/Profunctor/Rep.hs view
@@ -3,6 +3,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708 {-# LANGUAGE Trustworthy #-}@@ -28,6 +30,18 @@ , Corepresentable(..) , cotabulated , unfirstCorep, unsecondCorep+ -- * Prep -| Star+ , Prep(..)+ , prepAdj+ , unprepAdj+ , prepUnit+ , prepCounit+ -- * Coprep -| Costar+ , Coprep(..)+ , coprepAdj+ , uncoprepAdj+ , coprepUnit+ , coprepCounit ) where import Control.Applicative@@ -75,6 +89,7 @@ tabulate = Forget . (getConst .) {-# INLINE tabulate #-} + type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t) -- | 'tabulate' and 'sieve' form two halves of an isomorphism.@@ -132,3 +147,67 @@ cotabulated :: (Corepresentable p, Corepresentable q) => Iso (Corep p d -> c) (Corep q d' -> c') (p d c) (q d' c') cotabulated = dimap cotabulate (fmap cosieve) {-# INLINE cotabulated #-}++--------------------------------------------------------------------------------+-- * Prep+--------------------------------------------------------------------------------++-- | @'Prep' -| 'Star' :: [Hask, Hask] -> Prof@+--+-- This gives rise to a monad in @Prof@, @('Star'.'Prep')@, and+-- a comonad in @[Hask,Hask]@ @('Prep'.'Star')@+data Prep p a where+ Prep :: x -> p x a -> Prep p a++instance Profunctor p => Functor (Prep p) where+ fmap f (Prep x p) = Prep x (rmap f p)++instance (Applicative (Rep p), Representable p) => Applicative (Prep p) where+ pure a = Prep () $ tabulate $ const $ pure a+ Prep xf pf <*> Prep xa pa = Prep (xf,xa) (tabulate go) where+ go (xf',xa') = sieve pf xf' <*> sieve pa xa'++instance (Monad (Rep p), Representable p) => Monad (Prep p) where+ return a = Prep () $ tabulate $ const $ return a+ Prep xa pa >>= f = Prep xa $ tabulate $ \xa' -> sieve pa xa' >>= \a -> case f a of+ Prep xb pb -> sieve pb xb++prepAdj :: (forall a. Prep p a -> g a) -> p :-> Star g+prepAdj k p = Star $ \x -> k (Prep x p)++unprepAdj :: (p :-> Star g) -> Prep p a -> g a+unprepAdj k (Prep x p) = runStar (k p) x++prepUnit :: p :-> Star (Prep p)+prepUnit p = Star $ \x -> Prep x p++prepCounit :: Prep (Star f) a -> f a+prepCounit (Prep x p) = runStar p x++--------------------------------------------------------------------------------+-- * Coprep+--------------------------------------------------------------------------------++newtype Coprep p a = Coprep { runCoprep :: forall r. p a r -> r }++instance Profunctor p => Functor (Coprep p) where+ fmap f (Coprep g) = Coprep (g . lmap f)++-- | @'Coprep' -| 'Costar' :: [Hask, Hask]^op -> Prof@+--+-- Like all adjunctions this gives rise to a monad and a comonad.+--+-- This gives rise to a monad on Prof @('Costar'.'Coprep')@ and+-- a comonad on @[Hask, Hask]^op@ given by @('Coprep'.'Costar')@ which+-- is a monad in @[Hask,Hask]@+coprepAdj :: (forall a. f a -> Coprep p a) -> p :-> Costar f+coprepAdj k p = Costar $ \f -> runCoprep (k f) p++uncoprepAdj :: (p :-> Costar f) -> f a -> Coprep p a+uncoprepAdj k f = Coprep $ \p -> runCostar (k p) f++coprepUnit :: p :-> Costar (Coprep p)+coprepUnit p = Costar $ \f -> runCoprep f p++coprepCounit :: f a -> Coprep (Costar f) a+coprepCounit f = Coprep $ \p -> runCostar p f
src/Data/Profunctor/Tambara.hs view
@@ -141,6 +141,10 @@ ---------------------------------------------------------------------------- -- | Pastro -| Tambara+--+-- @+-- Pastro p ~ exists z. Costar ((,)z) `Procompose` p `Procompose` Star ((,)z)+-- @ data Pastro p a b where Pastro :: ((y, z) -> b) -> p x y -> (a -> (x, z)) -> Pastro p a b @@ -171,6 +175,8 @@ ---------------------------------------------------------------------------- -- | Cotambara is freely adjoins respect for cocartesian structure to a profunctor+--+-- Note: this is not dual to 'Tambara'. It is 'Tambara' with respect to a different tensor. newtype Cotambara p a b = Cotambara { runCotambara :: forall c. p (Either a c) (Either b c) } instance ProfunctorFunctor Cotambara where
src/Data/Profunctor/Unsafe.hs view
@@ -38,6 +38,9 @@ import Control.Category import Control.Comonad (Cokleisli(..)) import Control.Monad (liftM)+import Data.Bifunctor.Clown (Clown(..))+import Data.Bifunctor.Joker (Joker(..))+import Data.Functor.Contravariant (Contravariant(..)) import Data.Tagged import Prelude hiding (id,(.),sequence) @@ -239,3 +242,19 @@ ( #. ) _ = unsafeCoerce #endif {-# INLINE ( #. ) #-}++instance Contravariant f => Profunctor (Clown f) where+ lmap f (Clown fa) = Clown (contramap f fa)+ {-# INLINE lmap #-}+ rmap _ (Clown fa) = Clown fa+ {-# INLINE rmap #-}+ dimap f _ (Clown fa) = Clown (contramap f fa)+ {-# INLINE dimap #-}++instance Functor f => Profunctor (Joker f) where+ lmap _ (Joker fb) = Joker fb+ {-# INLINE lmap #-}+ rmap g (Joker fb) = Joker (fmap g fb)+ {-# INLINE rmap #-}+ dimap _ g (Joker fb) = Joker (fmap g fb)+ {-# INLINE dimap #-}