profunctors 3.2 → 3.3

raw patch · 3 files changed

+56/−1 lines, 3 files

Files

• CHANGELOG.markdown +8/−0
• profunctors.cabal +1/−1
• src/Data/Profunctor.hs +47/−0

@@ -1,3 +1,11 @@+3.3+---+* Added `instance Choice (Upstar f)` and introduced `Forget`.++3.2+---+* Renamed `Lenticular` and `Prismatic` to `Strong` and `Choice`, and restructured them.+ 3.1.3 ----- * Removed upper bounds on my own intra-package dependencies

@@ -1,6 +1,6 @@ name:          profunctors category:      Control, Categories-version:       3.2+version:       3.3 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE

@@ -31,12 +31,15 @@   , UpStar(..)   , DownStar(..)   , WrappedArrow(..)+  , Forget(..)   ) where  import Control.Applicative hiding (WrappedArrow(..)) import Control.Arrow import Control.Category import Control.Comonad+import Data.Foldable+import Data.Monoid import Data.Tagged import Data.Traversable import Data.Tuple@@ -143,6 +146,32 @@   -- We cannot safely overload ( #. ) or ( .# ) because we didn't write the 'Arrow'.  ------------------------------------------------------------------------------+-- Forget+------------------------------------------------------------------------------++newtype Forget r a b = Forget { runForget :: a -> r }++instance Profunctor (Forget r) where+  dimap f _ (Forget k) = Forget (k . f)+  {-# INLINE dimap #-}+  lmap f (Forget k) = Forget (k . f)+  {-# INLINE lmap #-}+  rmap _ (Forget k) = Forget k+  {-# INLINE rmap #-}++instance Functor (Forget r a) where+  fmap _ (Forget k) = Forget k+  {-# INLINE fmap #-}++instance Foldable (Forget r a) where+  foldMap _ _ = mempty+  {-# INLINE foldMap #-}++instance Traversable (Forget r a) where+  traverse _ (Forget k) = pure (Forget k)+  {-# INLINE traverse #-}++------------------------------------------------------------------------------ -- Strong ------------------------------------------------------------------------------ @@ -185,6 +214,12 @@   second' (WrapArrow k) = WrapArrow (second k)   {-# INLINE second' #-} +instance Strong (Forget r) where+  first' (Forget k) = Forget (k . fst)+  {-# INLINE first' #-}+  second' (Forget k) = Forget (k . snd)+  {-# INLINE second' #-}+ ------------------------------------------------------------------------------ -- Choice ------------------------------------------------------------------------------@@ -214,6 +249,12 @@   right' = right   {-# INLINE right' #-} +instance Applicative f => Choice (UpStar f) where+  left' (UpStar f) = UpStar $ either (fmap Left . f) (fmap Right . pure)+  {-# INLINE left' #-}+  right' (UpStar f) = UpStar $ either (fmap Left . pure) (fmap Right . f)+  {-# INLINE right' #-}+ -- | 'extract' approximates 'costrength' instance Comonad w => Choice (Cokleisli w) where   left' = left@@ -238,4 +279,10 @@   left' (WrapArrow k) = WrapArrow (left k)   {-# INLINE left' #-}   right' (WrapArrow k) = WrapArrow (right k)+  {-# INLINE right' #-}++instance Monoid r => Choice (Forget r) where+  left' (Forget k) = Forget (either k (const mempty))+  {-# INLINE left' #-}+  right' (Forget k) = Forget (either (const mempty) k)   {-# INLINE right' #-}