profunctor-arrows 0.0.0.3 → 0.0.1

raw patch · 8 files changed

+33/−284 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +2/−2
• profunctor-arrows.cabal +4/−6
• src/Data/Profunctor/Arrow.hs +24/−2
• src/Data/Profunctor/Arrow/Choice.hs +1/−2
• src/Data/Profunctor/Arrow/Free.hs +0/−1
• src/Data/Profunctor/Arrow/Internal.hs +1/−1
• src/Data/Profunctor/Arrow/Strong.hs +1/−1
• src/Data/Profunctor/Extra.hs +0/−269

@@ -1,5 +1,5 @@-# Revision history for dioids+# Revision history for profunctor-arrows -## 0.0.1  -- YYYY-mm-dd+## 0.0.1  -- 03/05/2020  * First version. Released on an unsuspecting world.

@@ -1,12 +1,12 @@ cabal-version: >= 1.10  name:           profunctor-arrows-version:        0.0.0.3+version:        0.0.1 synopsis:       Profunctor arrows description:    Free prearrows and arrows for profunctors. category:       Data, Profunctors-homepage:       https://github.com/cmk/profunctor-optics-bug-reports:    https://github.com/cmk/profunctor-optics/issues+homepage:       https://github.com/cmk/profunctor-arrows+bug-reports:    https://github.com/cmk/profunctor-arrows/issues author:         Chris McKinlay maintainer:     Chris McKinlay copyright:      2019 Chris McKinlay@@ -17,7 +17,7 @@  source-repository head   type: git-  location: https://github.com/cmk/profunctor-optics+  location: https://github.com/cmk/profunctor-arrows  library   exposed-modules:@@ -29,7 +29,6 @@       Data.Profunctor.Arrow.Closed       Data.Profunctor.Arrow.Strong       Data.Profunctor.Arrow.Traversing-      Data.Profunctor.Extra   other-modules:       Data.Profunctor.Arrow.Internal   hs-source-dirs:@@ -42,7 +41,6 @@       TypeOperators       FlexibleContexts       FlexibleInstances-      QuantifiedConstraints   default-language: Haskell2010   ghc-options: -Wall   build-depends:

@@ -1,13 +1,26 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE ExistentialQuantification #-} module Data.Profunctor.Arrow (-    arr+    type (+)+  , arr   , ex1   , ex2   , inl   , inr+  , rgt+  , rgt'+  , lft+  , lft'+  , swap+  , eswap+  , fork+  , join+  , eval+  , apply   , braid   , ebraid+  , assocl+  , assocr   , loop   , left   , right@@ -28,10 +41,11 @@ ) where  import Control.Category hiding ((.), id)+import Data.Tuple import Data.Profunctor-import Data.Profunctor.Extra import Prelude import qualified Control.Category as C+import Test.Logic  -- | Lift a function into a profunctor arrow. --@@ -71,6 +85,14 @@ ebraid :: Category p => Profunctor p => p (a + b) (b + a) ebraid = arr eswap {-# INLINE ebraid #-}++assocl :: (a , (b , c)) -> ((a , b) , c)+assocl (a, (b, c)) = ((a, b), c)+{-# INLINE assocl #-}++assocr :: ((a , b) , c) -> (a , (b , c))+assocr ((a, b), c) = (a, (b, c))+{-# INLINE assocr #-}  loop :: Costrong p => p (a, d) (b, d) -> p a b loop = unfirst

@@ -11,11 +11,10 @@ import Control.Arrow (Kleisli(..)) import Control.Category hiding ((.), id) import Control.Comonad (Comonad, Cokleisli(..))-+import Data.Profunctor.Arrow import Data.Profunctor.Arrow.Free  import Data.Profunctor.Choice import Data.Profunctor-import Data.Profunctor.Extra  import Prelude 

@@ -6,7 +6,6 @@ import Control.Category hiding ((.), id) import Data.Profunctor import Data.Profunctor.Arrow-import Data.Profunctor.Extra import Data.Profunctor.Traversing import qualified Control.Arrow as A import qualified Control.Category as C

@@ -6,9 +6,9 @@ import Data.Functor.Identity (Identity(..)) import Data.Kind import Data.Profunctor+import Data.Profunctor.Arrow import Data.Profunctor.Choice import Data.Profunctor.Closed-import Data.Profunctor.Extra import Data.Profunctor.Mapping import Data.Profunctor.Monad import Data.Profunctor.Strong

@@ -10,8 +10,8 @@ import Control.Arrow (Kleisli(..)) import Control.Category hiding ((.), id) import Data.Profunctor+import Data.Profunctor.Arrow import Data.Profunctor.Arrow.Free -import Data.Profunctor.Extra import Data.Profunctor.Strong  import Prelude

@@ -1,269 +0,0 @@-module Data.Profunctor.Extra (-    type (+)-  , rgt-  , rgt'-  , lft-  , lft'-  , swap-  , eswap-  , fork-  , join-  , eval-  , apply-  , coeval -  , branch-  , branch'-  , assocl-  , assocr-  , assocl' -  , assocr'-  , eassocl-  , eassocr-  , eassocr'-  , forget1-  , forget2-  , forgetl-  , forgetr-  , unarr-  , peval -  , constl-  , constr-  , shiftl-  , shiftr-  , coercel -  , coercer-  , coercel'-  , coercer'-  , strong -  , costrong-  , choice-  , cochoice-  , pull-  , repn-  , corepn-  , star-  , toStar-  , fromStar -  , costar-  , uncostar-  , toCostar-  , fromCostar-  , pushr-  , pushl -  , pliftA-  , pdivide-  , pappend-  , (<<*>>)-  , (****)-  , (&&&&)-) where--import Control.Applicative (liftA2)-import Control.Arrow ((|||),(&&&))-import Control.Category (Category)-import Control.Comonad (Comonad(..))-import Data.Bifunctor-import Data.Functor.Contravariant-import Data.Profunctor-import Data.Profunctor.Rep-import Data.Profunctor.Sieve-import Data.Tuple (swap)-import Data.Void-import Test.Logic-import Prelude-import qualified Control.Category as C (id)-import qualified Control.Monad as M (join)--coeval :: b -> (b -> a) + a -> a-coeval b = either ($ b) id-{-# INLINE coeval #-}--branch :: (a -> Bool) -> b -> c -> a -> b + c-branch f y z x = if f x then Right z else Left y-{-# INLINE branch #-}--branch' :: (a -> Bool) -> a -> a + a-branch' f x = branch f x x x-{-# INLINE branch' #-}--assocl :: (a , (b , c)) -> ((a , b) , c)-assocl (a, (b, c)) = ((a, b), c)-{-# INLINE assocl #-}--assocr :: ((a , b) , c) -> (a , (b , c))-assocr ((a, b), c) = (a, (b, c))-{-# INLINE assocr #-}--assocl' :: (a , b + c) -> (a , b) + c-assocl' = eswap . traverse eswap-{-# INLINE assocl' #-}--assocr' :: (a + b , c) -> a + (b , c)-assocr' (f, b) = fmap (,b) f-{-# INLINE assocr' #-}--eassocl :: a + (b + c) -> (a + b) + c-eassocl (Left a)          = Left (Left a)-eassocl (Right (Left b))  = Left (Right b)-eassocl (Right (Right c)) = Right c-{-# INLINE eassocl #-}--eassocr :: (a + b) + c -> a + (b + c)-eassocr (Left (Left a))  = Left a-eassocr (Left (Right b)) = Right (Left b)-eassocr (Right c)        = Right (Right c)-{-# INLINE eassocr #-}--eassocr' :: (a -> b) + c -> a -> b + c-eassocr' abc a = either (\ab -> Left $ ab a) Right abc-{-# INLINE eassocr' #-}--forget1 :: ((c, a) -> (c, b)) -> a -> b-forget1 f a = b where (c, b) = f (c, a)-{-# INLINE forget1 #-}--forget2 :: ((a, c) -> (b, c)) -> a -> b-forget2 f a = b where (b, c) = f (a, c)-{-# INLINE forget2 #-}--forgetl :: (c + a -> c + b) -> a -> b-forgetl f = go . Right where go = either (go . Left) id . f-{-# INLINE forgetl #-}--forgetr :: (a + c -> b + c) -> a -> b-forgetr f = go . Left where go = either id (go . Right) . f-{-# INLINE forgetr #-}--unarr :: Comonad w => Sieve p w => p a b -> a -> b -unarr = (extract .) . sieve-{-# INLINE unarr #-}--peval :: Strong p => p a (a -> b) -> p a b-peval = rmap eval . pull-{-# INLINE peval #-}--constl :: Profunctor p => b -> p b c -> p a c-constl = lmap . const-{-# INLINE constl #-}--constr :: Profunctor p => c -> p a b -> p a c-constr = rmap . const-{-# INLINE constr #-}--shiftl :: Profunctor p => p (a + b) c -> p b (c + d)-shiftl = dimap Right Left-{-# INLINE shiftl #-}--shiftr :: Profunctor p => p b (c , d) -> p (a , b) c-shiftr = dimap snd fst-{-# INLINE shiftr #-}--coercel :: Profunctor p => Bifunctor p => p a b -> p c b-coercel = first absurd . lmap absurd-{-# INLINE coercel #-}--coercer :: Profunctor p => Contravariant (p a) => p a b -> p a c-coercer = rmap absurd . contramap absurd-{-# INLINE coercer #-}--coercel' :: Corepresentable p => Contravariant (Corep p) => p a b -> p c b-coercel' = corepn (. phantom)-{-# INLINE coercel' #-}--coercer' :: Representable p => Contravariant (Rep p) => p a b -> p a c-coercer' = repn (phantom .)-{-# INLINE coercer' #-}--strong :: Strong p => ((a , b) -> c) -> p a b -> p a c-strong f = dimap fork f . second'-{-# INLINE strong #-}--costrong :: Costrong p => ((a , b) -> c) -> p c a -> p b a-costrong f = unsecond . dimap f fork-{-# INLINE costrong #-}--choice :: Choice p => (c -> (a + b)) -> p b a -> p c a-choice f = dimap f join . right'-{-# INLINE choice #-}--cochoice :: Cochoice p => (c -> (a + b)) -> p a c -> p a b-cochoice f = unright . dimap join f-{-# INLINE cochoice #-}--pull :: Strong p => p a b -> p a (a , b)-pull = lmap fork . second'-{-# INLINE pull #-}--repn :: Representable p => ((a -> Rep p b) -> s -> Rep p t) -> p a b -> p s t-repn f = tabulate . f . sieve-{-# INLINE repn #-}--corepn :: Corepresentable p => ((Corep p a -> b) -> Corep p s -> t) -> p a b -> p s t-corepn f = cotabulate . f . cosieve-{-# INLINE corepn #-}--star :: Applicative f => Star f a a-star = Star pure-{-# INLINE star #-}--toStar :: Sieve p f => p d c -> Star f d c-toStar = Star . sieve-{-# INLINE toStar #-}--fromStar :: Representable p => Star (Rep p) a b -> p a b-fromStar = tabulate . runStar-{-# INLINE fromStar #-}--costar :: Foldable f => Monoid b => (a -> b) -> Costar f a b-costar f = Costar (foldMap f)-{-# INLINE costar #-}--uncostar :: Applicative f => Costar f a b -> a -> b-uncostar f = runCostar f . pure-{-# INLINE uncostar #-}--toCostar :: Cosieve p f => p a b -> Costar f a b-toCostar = Costar . cosieve-{-# INLINE toCostar #-}--fromCostar :: Corepresentable p => Costar (Corep p) a b -> p a b-fromCostar = cotabulate . runCostar-{-# INLINE fromCostar #-}--pushr :: Closed p => Representable p => Applicative (Rep p) => p (a , b) c -> p a b -> p a c-pushr = (<<*>>) . curry' -{-# INLINE pushr #-}--pushl :: Closed p => Representable p => Applicative (Rep p) => p a c -> p b c -> p a (b -> c)-pushl p q = curry' $ pdivide id p q-{-# INLINE pushl #-}--pliftA :: Representable p => Applicative (Rep p) => (b -> c -> d) -> p a b -> p a c -> p a d-pliftA f x y = tabulate $ \s -> liftA2 f (sieve x s) (sieve y s)-{-# INLINE pliftA #-}--infixl 4 <<*>>--(<<*>>) :: Representable p => Applicative (Rep p) => p a (b -> c) -> p a b -> p a c-(<<*>>) = pliftA ($)-{-# INLINE (<<*>>) #-}--infixr 3 ****--(****) :: Representable p => Applicative (Rep p) => p a1 b1 -> p a2 b2 -> p (a1 , a2) (b1 , b2)-p **** q = dimap fst (,) p <<*>> lmap snd q-{-# INLINE (****) #-}--infixr 3 &&&&--(&&&&) ::  Representable p => Applicative (Rep p) => p a b1 -> p a b2 -> p a (b1 , b2)-p &&&& q = pliftA (,) p q-{-# INLINE (&&&&) #-}--pdivide :: Representable p => Applicative (Rep p) => (a -> (a1 , a2)) -> p a1 b -> p a2 b -> p a b-pdivide f p q = dimap f fst $ dimap fst (,) p <<*>> lmap snd q-{-# INLINE pdivide #-}--pappend :: Representable p => Applicative (Rep p) => p a b -> p a b -> p a b-pappend = pdivide fork-{-# INLINE pappend #-}