profunctors 4.2.0.1 → 4.3.2

raw patch · 6 files changed

+120/−11 lines, 6 files

Files

CHANGELOG.markdown +10/−0
profunctors.cabal +1/−1
src/Data/Profunctor.hs +94/−7
src/Data/Profunctor/Closed.hs +3/−3
src/Data/Profunctor/Rep.hs +8/−0
src/Data/Profunctor/Unsafe.hs +4/−0

CHANGELOG.markdown view

@@ -1,3 +1,13 @@+4.3.2+-----+* Added some missing instances for `UpStar` and `DownStar`.++4.3+---+* Removed the non law-abiding instance for `Closed (Forget r)`+* `Forget` is `Representable`+* MINIMAL pragmas+ 4.2.0.1 ------- * Avoided using 'type' in the export list, as that doesn't work on 7.4.

profunctors.cabal view

@@ -1,6 +1,6 @@ name:          profunctors category:      Control, Categories-version:       4.2.0.1+version:       4.3.2 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE

src/Data/Profunctor.hs view

@@ -28,6 +28,9 @@   -- ** Profunctorial Strength   , Strong(..)   , Choice(..)+  -- ** Profunctorial Costrength+  , Costrong(..)+  , Cochoice(..)   -- ** Common Profunctors   , UpStar(..)   , DownStar(..)@@ -42,6 +45,8 @@ import Control.Arrow import Control.Category import Control.Comonad+import Control.Monad (liftM, MonadPlus(..))+import Control.Monad.Fix import Data.Foldable import Data.Monoid import Data.Tagged@@ -76,6 +81,26 @@   fmap = rmap   {-# INLINE fmap #-} +instance Applicative f => Applicative (UpStar f a) where+  pure a = UpStar $ \_ -> pure a+  UpStar ff <*> UpStar fx = UpStar $ \a -> ff a <*> fx a+  UpStar ff  *> UpStar fx = UpStar $ \a -> ff a  *> fx a+  UpStar ff <*  UpStar fx = UpStar $ \a -> ff a <*  fx a++instance Alternative f => Alternative (UpStar f a) where+  empty = UpStar $ \_ -> empty+  UpStar f <|> UpStar g = UpStar $ \a -> f a <|> g a++instance Monad f => Monad (UpStar f a) where+  return a = UpStar $ \_ -> return a+  UpStar m >>= f = UpStar $ \ e -> do+    a <- m e+    runUpStar (f a) e++instance MonadPlus f => MonadPlus (UpStar f a) where+  mzero = UpStar $ \_ -> mzero+  UpStar f `mplus` UpStar g = UpStar $ \a -> f a `mplus` g a+ ------------------------------------------------------------------------------ -- DownStar ------------------------------------------------------------------------------@@ -97,7 +122,19 @@ instance Functor (DownStar f a) where   fmap k (DownStar f) = DownStar (k . f)   {-# INLINE fmap #-}+  a <$ _ = DownStar $ \_ -> a+  {-# INLINE (<$) #-} +instance Applicative (DownStar f a) where+  pure a = DownStar $ \_ -> a+  DownStar ff <*> DownStar fx = DownStar $ \a -> ff a (fx a)+  _ *> m = m+  m <* _ = m++instance Monad (DownStar f a) where+  return a = DownStar $ \_ -> a+  DownStar m >>= f = DownStar $ \ x -> runDownStar (f (m x)) x+ ------------------------------------------------------------------------------ -- Wrapped Profunctors ------------------------------------------------------------------------------@@ -184,9 +221,10 @@  -- | Generalizing 'UpStar' of a strong 'Functor' ----- Minimal complete definition: 'first'' or 'second''+-- /Note:/ Every 'Functor' in Haskell is strong with respect to (,). ----- /Note:/ Every 'Functor' in Haskell is strong.+-- This describes profunctor strength with respect to the product structure+-- of Hask. -- -- <http://takeichi.ipl-lab.org/~asada/papers/arrStrMnd.pdf> class Profunctor p => Strong p where@@ -196,6 +234,11 @@   second' :: p a b -> p (c, a) (c, b)   second' = dimap swap swap . first' ++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL first' | second' #-}+#endif+ instance Strong (->) where   first' ab ~(a, c) = (ab a, c)   {-# INLINE first' #-}@@ -234,11 +277,11 @@ -- Choice ------------------------------------------------------------------------------ --- | The generalization of 'DownStar' of a \"costrong\" 'Functor'------ Minimal complete definition: 'left'' or 'right''+-- | The generalization of 'DownStar' of 'Functor' that is strong with respect+-- to 'Either'. ----- /Note:/ We use 'traverse' and 'extract' as approximate costrength as needed.+-- Note: This is also a notion of strength, except with regards to another monoidal +-- structure that we can choose to equip Hask with: the cocartesian coproduct. class Profunctor p => Choice p where   left'  :: p a b -> p (Either a c) (Either b c)   left' =  dimap (either Right Left) (either Right Left) . right'@@ -246,6 +289,10 @@   right' :: p a b -> p (Either c a) (Either c b)   right' =  dimap (either Right Left) (either Right Left) . left' +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL left' | right' #-}+#endif+ instance Choice (->) where   left' ab (Left a) = Left (ab a)   left' _ (Right c) = Right c@@ -272,7 +319,7 @@   right' = right   {-# INLINE right' #-} --- | 'sequence' approximates 'costrength'+-- NB: This instance is highly questionable instance Traversable w => Choice (DownStar w) where   left' (DownStar wab) = DownStar (either Right Left . fmap wab . traverse (either Right Left))   {-# INLINE left' #-}@@ -296,3 +343,43 @@   {-# INLINE left' #-}   right' (Forget k) = Forget (either (const mempty) k)   {-# INLINE right' #-}++--------------------------------------------------------------------------------+-- * Costrength for (,)+--------------------------------------------------------------------------------++-- | Analogous to 'ArrowLoop', 'loop' = 'unfirst'+-- +-- unfirst . unfirst = +class Profunctor p => Costrong p where+  unfirst  :: p (a, d) (b, d) -> p a b+  unfirst = unsecond . dimap swap swap++  unsecond :: p (d, a) (d, b) -> p a b+  unsecond = unfirst . dimap swap swap++instance Costrong (->) where+  unfirst f a = b where (b, d) = f (a, d)+  unsecond f a = b where (d, b) = f (d, a)++instance Costrong Tagged where+  unfirst (Tagged bd) = Tagged (fst bd)+  unsecond (Tagged db) = Tagged (snd db)++instance ArrowLoop p => Costrong (WrappedArrow p) where+  unfirst (WrapArrow k) = WrapArrow (loop k)++instance MonadFix m => Costrong (Kleisli m) where+  unfirst (Kleisli f) = Kleisli (liftM fst . mfix . f')+    where f' x y = f (x, snd y)++--------------------------------------------------------------------------------+-- * Costrength for Either+--------------------------------------------------------------------------------++class Profunctor p => Cochoice p where+  unleft  :: p (Either a d) (Either b d) -> p a b+  unleft = unright . dimap (either Right Left) (either Right Left)++  unright :: p (Either d a) (Either d b) -> p a b+  unright = unleft . dimap (either Right Left) (either Right Left)

src/Data/Profunctor/Closed.hs view

@@ -56,8 +56,8 @@ instance (Distributive f, Monad f) => Closed (Kleisli f) where   closed (Kleisli afb) = Kleisli $ \xa -> distribute $ \x -> afb (xa x) -instance Monoid r => Closed (Forget r) where-  closed _ = Forget $ \_ -> mempty+-- instance Monoid r => Closed (Forget r) where+--  closed _ = Forget $ \_ -> mempty  -------------------------------------------------------------------------------- -- * Closure@@ -65,7 +65,7 @@  -- | 'Closure' adjoins a 'Closed' structure to any 'Profunctor'. ----- Analogous to 'Data.Profunctor.Tambara.Tambara' for 'Closed'.+-- Analogous to 'Data.Profunctor.Tambara.Tambara' for 'Strong'.  newtype Closure p a b = Closure { runClosure :: forall x. p (x -> a) (x -> b) }

src/Data/Profunctor/Rep.hs view

@@ -26,6 +26,7 @@   , Corepresentable(..), cotabulated   ) where +import Control.Applicative import Control.Arrow import Control.Comonad import Data.Functor.Identity@@ -61,6 +62,13 @@   tabulate = UpStar   {-# INLINE tabulate #-}   rep = runUpStar+  {-# INLINE rep #-}+  +instance Representable (Forget r) where+  type Rep (Forget r) = Const r+  tabulate = Forget . (getConst .)+  {-# INLINE tabulate #-}+  rep = (Const .) . runForget   {-# INLINE rep #-}  type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)

src/Data/Profunctor/Unsafe.hs view

@@ -157,6 +157,10 @@   ( .# ) = \p -> p `seq` \f -> lmap f p   {-# INLINE ( .# ) #-} +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL dimap | (lmap, rmap) #-}+#endif+ instance Profunctor (->) where   dimap ab cd bc = cd . bc . ab   {-# INLINE dimap #-}