profunctor-optics 0.0.0.4 → 0.0.0.5

raw patch · 12 files changed

+211/−74 lines, 12 filesdep +keysdep −comonaddep ~connectionsdep ~ringsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: keys

Dependencies removed: comonad

Dependency ranges changed: connections, rings

API changes (from Hackage documentation)

Files

• profunctor-optics.cabal +5/−5
• src/Data/Profunctor/Optic/Carrier.hs +17/−1
• src/Data/Profunctor/Optic/Fold.hs +81/−29
• src/Data/Profunctor/Optic/Grate.hs +15/−2
• src/Data/Profunctor/Optic/Import.hs +0/−1
• src/Data/Profunctor/Optic/Index.hs +0/−1
• src/Data/Profunctor/Optic/Iso.hs +0/−1
• src/Data/Profunctor/Optic/Lens.hs +23/−1
• src/Data/Profunctor/Optic/Prism.hs +1/−1
• src/Data/Profunctor/Optic/Setter.hs +30/−18
• src/Data/Profunctor/Optic/Traversal.hs +39/−8
• src/Data/Tuple/Optic.hs +0/−6

@@ -1,7 +1,7 @@ cabal-version: >= 1.10  name:           profunctor-optics-version:        0.0.0.4+version:        0.0.0.5 synopsis:       An optics library compatible with the typeclasses in 'profunctors'. description:     This package provides utilities for creating and manipulating profunctor-based optics. Some highlights:@@ -94,19 +94,19 @@   ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates   build-depends:       base              >= 4.9      && < 5.0-    , comonad           >= 4        && < 6-    , connections       >= 0.0.2.1  && < 0.1+    , adjunctions       >= 4.4      && < 5.0+    , connections       >= 0.0.2.2  && < 0.1     , distributive      >= 0.3      && < 1+    , keys              >= 3.12     && < 3.13     , mtl               >= 2.0.1    && < 2.3     , newtype-generics  >= 0.5.3    && < 0.6     , profunctor-arrows >= 0.0.0.2  && < 0.0.1     , profunctors       >= 5.4      && < 6-    , rings             >= 0.0.2.1  && < 0.1+    , rings             >= 0.0.2.4  && < 0.1     , semigroupoids     >= 5        && < 6     , tagged            >= 0.4.4    && < 1     , transformers      >= 0.5      && < 0.6     , unliftio-core     >= 0.1.2    && < 0.2-    , adjunctions       >= 4.4      && < 5.0  test-suite test   type:              exitcode-stdio-1.0

@@ -31,8 +31,12 @@   , AIxrepn'   , ATraversal   , ATraversal'+  , AIxtraversal+  , AIxtraversal'   , ATraversal1   , ATraversal1'+  , AIxtraversal1+  , AIxtraversal1'   , AFold   , AIxfold   , AFold1@@ -171,10 +175,18 @@  type ATraversal' f s a = ATraversal f s s a a +type AIxtraversal f i s t a b = Applicative f => AIxrepn f i s t a b++type AIxtraversal' f i s a = AIxtraversal f i s s a a+ type ATraversal1 f s t a b = Apply f => ARepn f s t a b  type ATraversal1' f s a = ATraversal1 f s s a a +type AIxtraversal1 f i s t a b = Apply f => AIxrepn f i s t a b++type AIxtraversal1' f i s a = AIxtraversal1 f i s s a a+ type AFold r s a = ARepn' (Const r) s a  type AIxfold r i s a = AIxrepn' (Const r) i s a@@ -438,7 +450,11 @@  newtype CxgrateRep k a b s t = CxgrateRep { unCxgrateRep :: ((s -> a) -> k -> b) -> t } ---TODO Closed, Costrong+instance Profunctor (CxgrateRep k a b) where+  dimap f g (CxgrateRep z) = CxgrateRep $ \d -> g (z $ \k -> d (k . f))++instance Closed (CxgrateRep k a b) where+  closed (CxgrateRep sabt) = CxgrateRep $ \xsab x -> sabt $ \sa -> xsab $ \xs -> sa (xs x)  --------------------------------------------------------------------- -- AffineRep

@@ -14,7 +14,6 @@   , folding    , foldVl   , ifoldVl-  , toFold   , afold   , aifold     -- * Fold1 & Ixfold1@@ -23,14 +22,14 @@   , fold1_   , folding1   , fold1Vl-  , toFold1+  , ifold1Vl   , afold1+  , aifold1     -- * Optics   , folded   , folded_   , folded1    , folded1_-  , ifoldedRep   , unital   , nonunital   , presemiring@@ -38,6 +37,12 @@   , summed1   , multiplied   , multiplied1+    -- * Indexed optics+  , ifolded+  , ifoldedRep+  , ifolded1+  , aifolded+  , aifolded1     -- * Primitive operators   , withFold   , withIxfold@@ -79,9 +84,9 @@  import Control.Monad (void) import Control.Monad.Reader as Reader hiding (lift)-import Data.Bifunctor (Bifunctor(..)) import Data.Bool.Instance () -- Semigroup / Monoid / Semiring instances import Data.Foldable (Foldable, foldMap, traverse_)+import Data.Key as K import Data.Monoid hiding (All(..), Any(..)) import Data.Profunctor.Optic.Carrier import Data.Profunctor.Optic.Import@@ -106,7 +111,6 @@ -- >>> import Data.Int.Instance () -- >>> import Data.List.NonEmpty (NonEmpty(..)) -- >>> import qualified Data.List.NonEmpty as NE--- >>> import Data.Map.NonEmpty as Map1 -- >>> import Data.Map as Map -- >>> import Data.Maybe -- >>> import Data.Monoid@@ -155,31 +159,25 @@ foldVl f = coercer . traversalVl f . coercer {-# INLINE foldVl #-} --- | Obtain a 'Fold' from a Van Laarhoven 'Fold'.+-- | Obtain a 'Ixfold' from a Van Laarhoven 'Fold'. -- ifoldVl :: (forall f. Applicative f => (i -> a -> f b) -> s -> f t) -> Ixfold i s a ifoldVl f = coercer . itraversalVl f . coercer {-# INLINE ifoldVl #-} --- | Obtain a 'Fold' from a 'View' or 'AFold'.----toFold :: AView s a -> Fold s a-toFold = to . view-{-# INLINE toFold #-}- -- | TODO: Document -- -- @--- afold :: ((a -> r) -> s -> r) -> AFold r s a+-- afold :: Monoid r => ((a -> r) -> s -> r) -> AFold r s a -- @ ---afold :: ((a -> r) -> s -> r) -> APrimView r s t a b+afold :: Monoid r => ((a -> r) -> s -> r) -> APrimView r s t a b afold f = Star #. (Const #.) #. f .# (getConst #.) .# runStar {-# INLINE afold #-}  -- | TODO: Document ---aifold :: ((i -> a -> r) -> s -> r) -> AIxfold r i s a+aifold :: Monoid r => ((i -> a -> r) -> s -> r) -> AIxfold r i s a aifold f = afold $ \iar s -> f (curry iar) $ snd s {-# INLINE aifold #-} @@ -222,22 +220,28 @@ fold1Vl f = coercer . repn f . coercer {-# INLINE fold1Vl #-} --- | Obtain a 'Fold1' from a 'View' or 'AFold1'.+-- | Obtain a 'Ixfold1' from a Van Laarhoven 'Fold1'. ---toFold1 :: AView s a -> Fold1 s a-toFold1 = to . view-{-# INLINE toFold1 #-}+ifold1Vl :: (forall f. Apply f => (i -> a -> f b) -> s -> f t) -> Ixfold1 i s a+ifold1Vl f = coercer . itraversal1Vl f . coercer+{-# INLINE ifold1Vl #-}  -- | TODO: Document -- -- @--- afold1 :: ((a -> r) -> s -> r) -> AFold1 r s a+-- afold1 :: Semigroup r => ((a -> r) -> s -> r) -> AFold1 r s a -- @ ---afold1 :: ((a -> r) -> s -> r) -> APrimView r s t a b+afold1 :: Semigroup r => ((a -> r) -> s -> r) -> APrimView r s t a b afold1 f = Star #. (Const #.) #. f .# (getConst #.) .# runStar {-# INLINE afold1 #-} +-- | TODO: Document+--+aifold1 :: Semigroup r => ((i -> a -> r) -> s -> r) -> AIxfold1 r i s a+aifold1 f = afold1 $ \iar s -> f (curry iar) $ snd s+{-# INLINE aifold1 #-}+ --------------------------------------------------------------------- -- Optics  ---------------------------------------------------------------------@@ -274,12 +278,6 @@ folded1_ = fold1_ id {-# INLINE folded1_ #-} --- | Obtain an 'Ixfold' from a 'F.Representable' functor.----ifoldedRep :: F.Representable f => Traversable f => Ixfold (F.Rep f) (f a) a-ifoldedRep = ifoldVl F.itraverseRep-{-# INLINE ifoldedRep #-}- -- | Expression in a unital semiring  -- -- @ @@ -354,7 +352,7 @@ -- 10 -- summed1 :: Foldable1 f => Semigroup r => AFold1 r (f a) a-summed1 = afold foldMap1+summed1 = afold1 foldMap1 {-# INLINE summed1 #-}  -- | Semiring product of a foldable collection.@@ -382,10 +380,48 @@ -- Just 120  -- multiplied1 :: Foldable1 f => Semiring r => AFold1 r (f a) a-multiplied1 = afold Rng.product1+multiplied1 = afold1 Rng.product1 {-# INLINE multiplied1 #-}  ---------------------------------------------------------------------+-- Indexed optics +---------------------------------------------------------------------++-- | Obtain an 'AIxfold' from a 'FoldableWithKey'.+--+-- @+-- f '^%%' 'ifolded' ≡ 'toKeyedList' f+-- @+--+ifolded :: FoldableWithKey f => Ixfold (Key f) (f a) a+ifolded = ifoldVl K.traverseWithKey_+{-# INLINE ifolded #-}++-- | Obtain an 'Ixfold' from a 'F.Representable' functor.+--+ifoldedRep :: F.Representable f => Traversable f => Ixfold (F.Rep f) (f a) a+ifoldedRep = ifoldVl F.itraverseRep+{-# INLINE ifoldedRep #-}++-- | Obtain an 'Ixfold1' from a 'FoldableWithKey1'.+--+ifolded1 :: FoldableWithKey1 f => Ixfold1 (Key f) (f a) a+ifolded1 = ifold1Vl K.traverseWithKey1_+{-# INLINE ifolded1 #-}++-- | Obtain an 'AIxfold' from a 'FoldableWithKey'.+--+aifolded :: FoldableWithKey f => Monoid r => AIxfold r (Key f) (f a) a+aifolded = aifold K.foldMapWithKey+{-# INLINE aifolded #-}++-- | Obtain an 'AIxfold1' from a 'FoldableWithKey1'.+--+aifolded1 :: FoldableWithKey1 f => Semigroup r => AIxfold1 r (Key f) (f a) a+aifolded1 = aifold1 K.foldMapWithKey1+{-# INLINE aifolded1 #-}++--------------------------------------------------------------------- -- Primitive operators --------------------------------------------------------------------- @@ -587,6 +623,7 @@ -- -- @ -- 'foldsr' o ≡ 'ifoldsr' o '.' 'const'+-- 'foldrWithKey' f ≡ 'ifoldsr' 'ifolded' f -- @ -- -- >>> ifoldsr itraversed (\i a -> ((show i ++ ":" ++ show a ++ ", ") ++)) [] [1,3,5,7,9]@@ -613,6 +650,11 @@  -- | Left fold over an indexed optic. --+-- @+-- 'foldsl' o ≡ 'ifoldsl' o '.' 'const'+-- 'foldlWithKey' f ≡ 'ifoldsl' 'ifolded' f+-- @+-- ifoldsl :: Monoid i => AIxfold (Dual (Endo r)) i s a -> (i -> r -> a -> r) -> r -> s -> r ifoldsl o f = ifoldslFrom o f mempty {-# INLINE ifoldsl #-}@@ -634,6 +676,11 @@  -- | Strict right fold over an indexed optic. --+-- @+-- 'foldsr'' o ≡ 'ifoldsr'' o '.' 'const'+-- 'foldrWithKey'' f ≡ 'ifoldsr'' 'ifolded' f+-- @+-- ifoldsr' :: Monoid i => AIxfold (Dual (Endo (r -> r))) i s a -> (i -> a -> r -> r) -> r -> s -> r ifoldsr' l f z0 xs = ifoldsl l f' id xs z0 where f' i k x z = k $! f i x z {-# INLINE ifoldsr' #-}@@ -658,6 +705,11 @@ {-# INLINE foldsl' #-}  -- | Strict left fold over an indexed optic.+--+-- @+-- 'foldsl'' o ≡ 'ifoldsl'' o '.' 'const'+-- 'foldlWithKey'' f ≡ 'ifoldsl'' 'ifolded' f+-- @ -- ifoldsl' :: Monoid i => AIxfold (Endo (r -> r)) i s a -> (i -> r -> a -> r) -> r -> s -> r ifoldsl' l f z0 xs = ifoldsr l f' id xs z0 where f' i x k z = k $! f i z x

@@ -30,6 +30,7 @@   , kclosed   , kfirst   , ksecond+  , coindexed     -- * Primitive operators   , withGrate    , withGrateVl@@ -58,8 +59,7 @@ import Data.Profunctor.Optic.Import import Data.Profunctor.Optic.Index import Data.Profunctor.Optic.Iso (tabulated)--import qualified Data.Functor.Rep as F+import Data.Semiring.Module  import qualified Data.Functor.Rep as F @@ -70,9 +70,11 @@ -- >>> :set -XTupleSections -- >>> import Control.Exception -- >>> import Control.Monad.Reader+-- >>> import Data.Complex -- >>> import Data.Connection.Int -- >>> import Data.List as L -- >>> import Data.Monoid (Endo(..))+-- >>> import Data.Semiring -- >>> :load Data.Profunctor.Optic  ---------------------------------------------------------------------@@ -254,6 +256,17 @@ ksecond :: Cxgrate k a b (c , a) (c , b) ksecond = rmap (unsecond . uncurry) . curry' . lmap swap {-# INLINE ksecond #-}++-- | Obtain a 'Cxgrate' from a representable functor.+--+-- >>> kzipsWith (coindexed @Complex) (\t -> if t then (<>) else (><)) (2 :+ 2) (3 :+ 4)+-- 6 :+ 6+--+-- See also 'Data.Profunctor.Optic.Lens.indexed'.+--+coindexed :: F.Representable f => Monoid (F.Rep f) => Cxgrate (F.Rep f) (f a) (f b) a b+coindexed = kgrateVl grateRep+{-# INLINE coindexed #-}  --------------------------------------------------------------------- -- Primitive operators

@@ -12,7 +12,6 @@ import Control.Applicative as Export (liftA2, Alternative(..)) import Control.Category as Export hiding ((.), id) import Control.Monad as Export hiding (void, join)-import Control.Comonad as Export import Data.Distributive as Export import Data.Function as Export ((&)) import Data.Functor as Export hiding (void)

@@ -45,7 +45,6 @@  import Control.Arrow as Arrow import Control.Category (Category)-import Control.Comonad import Control.Monad import Control.Monad.Fix import Data.Profunctor.Closed

@@ -86,7 +86,6 @@ -- >>> import Data.Int.Instance () -- >>> import Data.List.Index -- >>> import Data.Semiring--- >>> import Data.Sequence as Seq hiding (reverse) -- >>> import Data.Functor.Identity -- >>> import Data.Functor.Const -- >>> import Data.Profunctor.Types

@@ -20,6 +20,7 @@     -- * Optics   , united   , voided+  , indexed     -- * Indexed optics   , ifirst   , isecond@@ -39,13 +40,18 @@ import Data.Profunctor.Optic.Import import Data.Profunctor.Optic.Index import Data.Profunctor.Optic.Types+import Data.Semiring.Module+ import qualified Data.Bifunctor as B+import qualified Data.Functor.Rep as F  -- $setup -- >>> :set -XNoOverloadedStrings -- >>> :set -XTypeApplications -- >>> :set -XFlexibleContexts--- >>> import Data.Int.Instance+-- >>> import Data.Int.Instance ()+-- >>> import Data.Semiring.V2+-- >>> import Data.Semiring.V3 -- >>> :load Data.Profunctor.Optic  ---------------------------------------------------------------------@@ -196,6 +202,22 @@ -- voided :: Lens' Void a voided = lens absurd const++-- | Obtain a 'Lens' from a representable functor.+--+-- >>> V2 3 1 ^. indexed I21+-- 3+-- >>> V3 "foo" "bar" "baz" & indexed I32 .~ "bip"+-- V3 "foo" "bip" "baz"+--+-- See also 'Data.Profunctor.Optic.Grate.coindexed'.+--+indexed :: F.Representable f => Eq (F.Rep f) => F.Rep f -> Lens' (f a) a+indexed i = lensVl $ lensRep i++---------------------------------------------------------------------+-- Indexed optics +---------------------------------------------------------------------  -- | TODO: Document --

@@ -126,7 +126,7 @@ -- Just 6 -- -- >>> Nothing :| [Just 2, Just 3] & just //~ sum--- Just 5+-- Nothing -- just :: Prism (Maybe a) (Maybe b) a b just = flip prism Just $ maybe (Left Nothing) Right

@@ -22,17 +22,19 @@   , dom   , bound    , fmapped-  , imappedRep   , contramapped   , exmapped+  , adjusted   , liftedA   , liftedM   , forwarded   , censored-  , seeked   , zipped   , modded   , cond+    -- * Indexed optics+  , imapped+  , imappedRep     -- * Primitive operators   , withIxsetter   , withCxsetter@@ -67,11 +69,11 @@ ) where  import Control.Applicative (liftA)-import Control.Comonad.Store.Class (ComonadStore, seeks) import Control.Exception (Exception(..)) import Control.Monad.Reader as Reader import Control.Monad.State as State import Control.Monad.Writer as Writer+import Data.Key as K import Data.Profunctor.Optic.Carrier import Data.Profunctor.Optic.Import hiding ((&&&)) import Data.Profunctor.Optic.Index@@ -247,15 +249,6 @@ fmapped = setter fmap {-# INLINE fmapped #-} --- | 'Ixsetter' on each value of a representable functor.------ >>> 1 :+ 2 & imappedRep %~ bool 20 10--- 20 :+ 10----imappedRep :: F.Representable f => Ixsetter (F.Rep f) (f a) (f b) a b-imappedRep = isetter F.imapRep-{-# INLINE imappedRep #-}- -- | 'Setter' on each value of a contravariant functor. -- -- @@@ -285,6 +278,12 @@ exmapped = setter Ex.mapException {-# INLINE exmapped #-} +-- | 'Setter' on a particular value of an 'Adjustable' container.+--+adjusted :: Adjustable f => Key f -> Setter' (f a) a +adjusted i = setter $ \f -> K.adjust f i+{-# INLINE adjusted #-}+ -- | 'Setter' on each value of an applicative. -- -- @@@ -324,12 +323,6 @@ censored = setter Writer.censor {-# INLINE censored #-} --- | 'Setter' on the ----seeked :: ComonadStore a w => Setter' (w s) a-seeked = setter seeks-{-# INLINE seeked #-}- -- | 'Setter' on the codomain of a zipping function. -- -- >>> ((,) & zipped ..~ swap) 1 2@@ -352,6 +345,25 @@ cond :: (a -> Bool) -> Setter' a a cond p = setter $ \f a -> if p a then f a else a {-# INLINE cond #-}++---------------------------------------------------------------------+-- Indexed optics +---------------------------------------------------------------------++-- | 'Ixsetter' on each value of a 'Keyed' container.+--+imapped :: Keyed f => Ixsetter (Key f) (f a) (f b) a b+imapped = isetter K.mapWithKey+{-# INLINE imapped #-}++-- | 'Ixsetter' on each value of a representable functor.+--+-- >>> 1 :+ 2 & imappedRep %~ bool 20 10+-- 20 :+ 10+--+imappedRep :: F.Representable f => Ixsetter (F.Rep f) (f a) (f b) a b+imappedRep = isetter F.imapRep+{-# INLINE imappedRep #-}  --------------------------------------------------------------------- -- Operators

@@ -28,7 +28,6 @@     -- * Optics   , traversed   , traversed1-  , itraversedRep   , both   , both1   , duplicated@@ -38,9 +37,15 @@   , repeated    , iterated   , cycled-    -- * Operators+    -- * Indexed optics+  , itraversed+  , itraversed1+  , itraversedRep+    -- * Primitive operators   , withTraversal+  , withIxtraversal   , withTraversal1+  , withIxtraversal1     -- * Operators   , (*~)   , (**~)@@ -51,6 +56,7 @@ import Control.Category import Control.Arrow import Data.Bitraversable+import Data.Key as K import Data.List.NonEmpty as NonEmpty import Data.Profunctor.Optic.Carrier import Data.Profunctor.Optic.Lens@@ -267,11 +273,6 @@  -- | TODO: Document ---itraversedRep :: F.Representable f => Traversable f => Ixtraversal (F.Rep f) (f a) (f b) a b-itraversedRep = itraversalVl F.itraverseRep---- | TODO: Document--- -- >>> withTraversal both (pure . length) ("hello","world") -- (5,5) --@@ -299,7 +300,6 @@ -- beside :: Bitraversable r => Traversal s1 t1 a b -> Traversal s2 t2 a b -> Traversal (r s1 s2) (r t1 t2) a b beside x y p = tabulate go where go rss = bitraverse (sieve $ x p) (sieve $ y p) rss-    --go :: r s s' -> Rep p (r t t')  -- | Traverse both parts of a 'Bitraversable' container with matching types. --@@ -378,6 +378,25 @@ {-# INLINE cycled #-}  ---------------------------------------------------------------------+-- Indexed optics +---------------------------------------------------------------------++-- | TODO: Document+--+itraversed :: TraversableWithKey f => Traversable f => Ixtraversal (Key f) (f a) (f b) a b+itraversed = itraversalVl K.traverseWithKey++-- | TODO: Document+--+itraversed1 :: TraversableWithKey1 f => Traversable1 f => Ixtraversal1 (Key f) (f a) (f b) a b+itraversed1 = itraversal1Vl K.traverseWithKey1++-- | TODO: Document+--+itraversedRep :: F.Representable f => Traversable f => Ixtraversal (F.Rep f) (f a) (f b) a b+itraversedRep = itraversalVl F.itraverseRep++--------------------------------------------------------------------- -- Primitive operators --------------------------------------------------------------------- @@ -393,6 +412,12 @@ withTraversal = withStar {-# INLINE withTraversal #-} +-- | TODO: Document+--+withIxtraversal :: Applicative f => AIxtraversal f i s t a b -> (i -> a -> f b) -> i -> s -> f t+withIxtraversal o f = curry $ withTraversal o (uncurry f)+{-# INLINE withIxtraversal #-}+ -- | -- -- The traversal laws can be stated in terms of 'withTraversal1':@@ -409,6 +434,12 @@ withTraversal1 :: Apply f => ATraversal1 f s t a b -> (a -> f b) -> s -> f t withTraversal1 = withStar {-# INLINE withTraversal1 #-}++-- | TODO: Document+--+withIxtraversal1 :: Apply f => AIxtraversal1 f i s t a b -> (i -> a -> f b) -> i -> s -> f t+withIxtraversal1 o f = curry $ withTraversal1 o (uncurry f)+{-# INLINE withIxtraversal1 #-}  --------------------------------------------------------------------- -- Operators

@@ -96,9 +96,3 @@ t55 :: Lens (a,b,c,d,e) (a,b,c,d,e') e e' t55 = lensVl $ \f ~(a,b,c,d,e) -> (\e' -> (a,b,c,d,e')) <$> f e {-# INLINE t55 #-}-------------------------------------------------------------------------- Optics ------------------------------------------------------------------------