packages feed

profunctors 3.1.1 → 3.1.2

raw patch · 3 files changed

+222/−91 lines, 3 filesdep ~base

Dependency ranges changed: base

Files

profunctors.cabal view
@@ -1,6 +1,6 @@ name:          profunctors category:      Control, Categories-version:       3.1.1+version:       3.1.2 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -31,5 +31,7 @@     tagged        >= 0.4.4 && < 0.5    hs-source-dirs:  src-  exposed-modules: Data.Profunctor+  exposed-modules:+    Data.Profunctor+    Data.Profunctor.Unsafe   ghc-options:     -Wall
src/Data/Profunctor.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Profunctor@@ -19,7 +23,7 @@ module Data.Profunctor   (   -- * Profunctors-    Profunctor(..)+    Profunctor(dimap,lmap,rmap)   -- ** Profunctorial Strength   , Lenticular(..)   , Prismatic(..)@@ -33,97 +37,11 @@ import Control.Arrow import Control.Category import Control.Comonad (Cokleisli(..))-import Control.Monad (liftM) import Data.Tagged import Data.Traversable+import Data.Profunctor.Unsafe import Prelude hiding (id,(.),sequence)-------------------------------------------------------------------------------- Profunctors--------------------------------------------------------------------------------- | Formally, 'Profunctor' represents a 'profunctor' from @Hask@ -> @Hask@------ Intuitively it is a bifunctor where the first argument is contravariant--- and the second argument is covariant.------ You can define a profunctor by either defining 'dimap' or by defining both--- 'lmap' and 'rmap'.------ If you supply 'dimap', you should ensure that:------ @'dimap' 'id' 'id' ≡ 'id'@------ If you supply 'lmap' and 'rmap', ensure:------ @--- 'lmap' 'id' ≡ 'id'--- 'rmap' 'id' ≡ 'id'--- @------ If you supply both, you should also ensure:------ @'dimap' f g ≡ 'lmap' f . 'rmap' g@------ These ensure by parametricity:------ @--- 'dimap' (f '.' g) (h '.' i) ≡ 'dimap' g h '.' 'dimap' f i--- 'lmap' (f '.' g) ≡ 'lmap' g '.' 'lmap' f--- 'rmap' (f '.' g) ≡ 'rmap' f '.' 'rmap' g--- @-class Profunctor p where-  -- | Map over both arguments at the same time.-  ---  -- @'dimap' f g ≡ 'lmap' f '.' 'rmap' g@-  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d-  dimap f g = lmap f . rmap g-  {-# INLINE dimap #-}--  -- | Map the first argument contravariantly-  ---  -- @'lmap' f ≡ 'dimap' f 'id'@-  lmap :: (a -> b) -> p b c -> p a c-  lmap f = dimap f id-  {-# INLINE lmap #-}--  -- | Map the second argument covariantly-  ---  -- @'rmap' ≡ 'dimap' 'id'@-  rmap :: (b -> c) -> p a b -> p a c-  rmap = dimap id-  {-# INLINE rmap #-}--instance Profunctor (->) where-  dimap ab cd bc = cd . bc . ab-  {-# INLINE dimap #-}-  lmap = flip (.)-  {-# INLINE lmap #-}-  rmap = (.)-  {-# INLINE rmap #-}--instance Profunctor Tagged where-  dimap _ f (Tagged s) = Tagged (f s)-  {-# INLINE dimap #-}-  lmap _ = retag-  {-# INLINE lmap #-}-  rmap = fmap-  {-# INLINE rmap #-}--instance Monad m => Profunctor (Kleisli m) where-  dimap f g (Kleisli h) = Kleisli (liftM g . h . f)-  {-# INLINE dimap #-}-  lmap k (Kleisli f) = Kleisli (f . k)-  {-# INLINE lmap #-}-  rmap k (Kleisli f) = Kleisli (liftM k . f)-  {-# INLINE rmap #-}--instance Functor w => Profunctor (Cokleisli w) where-  dimap f g (Cokleisli h) = Cokleisli (g . h . fmap f)-  {-# INLINE dimap #-}-  lmap k (Cokleisli f) = Cokleisli (f . fmap k)-  {-# INLINE lmap #-}-  rmap k (Cokleisli f) = Cokleisli (k . f)-  {-# INLINE rmap #-}+import Unsafe.Coerce  ------------------------------------------------------------------------------ -- UpStar@@ -139,6 +57,9 @@   {-# INLINE lmap #-}   rmap k (UpStar f) = UpStar (fmap k . f)   {-# INLINE rmap #-}+  -- We cannot safely overload ( #. ) because we didn't write the 'Functor'.+  p .# _ = unsafeCoerce p+  {-# INLINE ( .# ) #-}  instance Functor f => Functor (UpStar f a) where   fmap = rmap@@ -158,6 +79,9 @@   {-# INLINE lmap #-}   rmap k (DownStar f) = DownStar (k . f)   {-# INLINE rmap #-}+  ( #. ) _ = unsafeCoerce+  {-# INLINE ( #. ) #-}+  -- We cannot overload ( .# ) because we didn't write the 'Functor'.  instance Functor (DownStar f a) where   fmap k (DownStar f) = DownStar (k . f)@@ -215,6 +139,7 @@   {-# INLINE lmap #-}   rmap = (^<<)   {-# INLINE rmap #-}+  -- We cannot safely overload ( #. ) or ( .# ) because we didn't write the 'Arrow'.  ------------------------------------------------------------------------------ -- Lenticular
+ src/Data/Profunctor/Unsafe.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Unsafe #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Profunctor.Unsafe+-- Copyright   :  (C) 2011-2012 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- For a good explanation of profunctors in Haskell see Dan Piponi's article:+--+-- <http://blog.sigfpe.com/2011/07/profunctors-in-haskell.html>+--+-- This module includes /unsafe/ composition operators that are useful in+-- practice when it comes to generating optimal core in GHC.+--+-- If you import this module you are taking upon yourself the obligation+-- that you will only call the operators with @#@ in their names with functions+-- that are operationally identity such as @newtype@ constructors or the field+-- accessor of a @newtype@.+--+-- If you are ever in doubt, use 'rmap' or 'lmap'.+----------------------------------------------------------------------------+module Data.Profunctor.Unsafe+  (+  -- * Profunctors+    Profunctor(..)+  ) where++import Control.Arrow+import Control.Category+import Control.Comonad (Cokleisli(..))+import Control.Monad (liftM)+import Data.Tagged+import Prelude hiding (id,(.),sequence)+import Unsafe.Coerce++{-# ANN module "Hlint: ignore Redundant lambda" #-}+{-# ANN module "Hlint: ignore Collapse lambdas" #-}++infixr 9 #.+infixl 8 .#++----------------------------------------------------------------------------+-- Profunctors+----------------------------------------------------------------------------++-- | Formally, the class 'Profunctor' represents a profunctor from @Hask@ -> @Hask@+--+-- Intuitively it is a bifunctor where the first argument is contravariant+-- and the second argument is covariant.+--+-- You can define a profunctor by either defining 'dimap' or by defining both+-- 'lmap' and 'rmap'.+--+-- If you supply 'dimap', you should ensure that:+--+-- @'dimap' 'id' 'id' ≡ 'id'@+--+-- If you supply 'lmap' and 'rmap', ensure:+--+-- @+-- 'lmap' 'id' ≡ 'id'+-- 'rmap' 'id' ≡ 'id'+-- @+--+-- If you supply both, you should also ensure:+--+-- @'dimap' f g ≡ 'lmap' f . 'rmap' g@+--+-- These ensure by parametricity:+--+-- @+-- 'dimap' (f '.' g) (h '.' i) ≡ 'dimap' g h '.' 'dimap' f i+-- 'lmap' (f '.' g) ≡ 'lmap' g '.' 'lmap' f+-- 'rmap' (f '.' g) ≡ 'rmap' f '.' 'rmap' g+-- @+class Profunctor p where+  -- | Map over both arguments at the same time.+  --+  -- @'dimap' f g ≡ 'lmap' f '.' 'rmap' g@+  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d+  dimap f g = lmap f . rmap g+  {-# INLINE dimap #-}++  -- | Map the first argument contravariantly+  --+  -- @'lmap' f ≡ 'dimap' f 'id'@+  lmap :: (a -> b) -> p b c -> p a c+  lmap f = dimap f id+  {-# INLINE lmap #-}++  -- | Map the second argument covariantly+  --+  -- @'rmap' ≡ 'dimap' 'id'@+  rmap :: (b -> c) -> p a b -> p a c+  rmap = dimap id+  {-# INLINE rmap #-}++  -- | Strictly map the second argument argument+  -- covariantly with a function that is assumed+  -- operationally to be a cast, such as a newtype+  -- constructor.+  --+  -- /Note:/ This operation is explicitly /unsafe/+  -- since an implementation may choose to use+  -- 'unsafeCoerce' to implement this combinator+  -- and it has no way to validate that your function+  -- meets the requirements.+  --+  -- If you implement this combinator with+  -- 'unsafeCoerce', then you are taking upon yourself+  -- the obligation that you don't use GADT-like+  -- tricks to distinguish values.+  --+  -- If you import "Data.Profunctor.Unsafe" you are+  -- taking upon yourself the obligation that you+  -- will only call this with a first argument that is+  -- operationally identity.+  --+  -- The semantics of this function with respect to bottoms+  -- should match the default definition:+  --+  -- @(#.) ≡ \\f -> \\p -> p \`seq\` 'rmap' f p@+  ( #. ) :: (b -> c) -> p a b -> p a c+  ( #. ) = \f -> \p -> p `seq` rmap f p+  {-# INLINE ( #. ) #-}++  -- | Strictly map the first argument argument+  -- contravariantly with a function that is assumed+  -- operationally to be a cast, such as a newtype+  -- constructor.+  --+  -- /Note:/ This operation is explicitly /unsafe/+  -- since an implementation may choose to use+  -- 'unsafeCoerce' to implement this combinator+  -- and it has no way to validate that your function+  -- meets the requirements.+  --+  -- If you implement this combinator with+  -- 'unsafeCoerce', then you are taking upon yourself+  -- the obligation that you don't use GADT-like+  -- tricks to distinguish values.+  --+  -- If you import "Data.Profunctor.Unsafe" you are+  -- taking upon yourself the obligation that you+  -- will only call this with a second argument that is+  -- operationally identity.+  --+  -- @(.#) ≡ \\p -> p \`seq\` \\f -> 'lmap' f p@+  ( .# ) :: p b c -> (a -> b) -> p a c+  ( .# ) = \p -> p `seq` \f -> lmap f p+  {-# INLINE ( .# ) #-}++instance Profunctor (->) where+  dimap ab cd bc = cd . bc . ab+  {-# INLINE dimap #-}+  lmap = flip (.)+  {-# INLINE lmap #-}+  rmap = (.)+  {-# INLINE rmap #-}+  ( #. ) _ = unsafeCoerce+  {-# INLINE ( #. ) #-}+  ( .# ) pbc _ = unsafeCoerce pbc+  {-# INLINE ( .# ) #-}++instance Profunctor Tagged where+  dimap _ f (Tagged s) = Tagged (f s)+  {-# INLINE dimap #-}+  lmap _ = retag+  {-# INLINE lmap #-}+  rmap = fmap+  {-# INLINE rmap #-}+  ( #. ) _ = unsafeCoerce+  {-# INLINE ( #. ) #-}+  Tagged s .# _ = Tagged s+  {-# INLINE ( .# ) #-}++instance Monad m => Profunctor (Kleisli m) where+  dimap f g (Kleisli h) = Kleisli (liftM g . h . f)+  {-# INLINE dimap #-}+  lmap k (Kleisli f) = Kleisli (f . k)+  {-# INLINE lmap #-}+  rmap k (Kleisli f) = Kleisli (liftM k . f)+  {-# INLINE rmap #-}+  -- We cannot safely overload (#.) because we didn't provide the 'Monad'.+  ( .# ) pbc _ = unsafeCoerce pbc+  {-# INLINE ( .# ) #-}++instance Functor w => Profunctor (Cokleisli w) where+  dimap f g (Cokleisli h) = Cokleisli (g . h . fmap f)+  {-# INLINE dimap #-}+  lmap k (Cokleisli f) = Cokleisli (f . fmap k)+  {-# INLINE lmap #-}+  rmap k (Cokleisli f) = Cokleisli (k . f)+  {-# INLINE rmap #-}+  -- We cannot safely overload (.#) because we didn't provide the 'Functor'.+  ( #. ) _ = unsafeCoerce+  {-# INLINE ( #. ) #-}