profunctor-optics 0.0.0.5 → 0.0.1

raw patch · 24 files changed

+172/−796 lines, 24 filesdep +magmasdep ~connectionsdep ~profunctor-arrowsdep ~ringsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: magmas

Dependency ranges changed: connections, profunctor-arrows, rings

API changes (from Hackage documentation)

Files

• profunctor-optics.cabal +6/−9
• src/Control/Exception/Optic.hs +1/−0
• src/Data/Connection/Optic.hs +0/−25
• src/Data/Connection/Optic/Float.hs +0/−34
• src/Data/Connection/Optic/Int.hs +0/−78
• src/Data/Connection/Optic/Word.hs +0/−78
• src/Data/Profunctor/Optic/Affine.hs +0/−2
• src/Data/Profunctor/Optic/Carrier.hs +7/−10
• src/Data/Profunctor/Optic/Cotraversal.hs +0/−4
• src/Data/Profunctor/Optic/Fold.hs +33/−176
• src/Data/Profunctor/Optic/Grate.hs +9/−7
• src/Data/Profunctor/Optic/Import.hs +3/−1
• src/Data/Profunctor/Optic/Index.hs +13/−45
• src/Data/Profunctor/Optic/Iso.hs +0/−9
• src/Data/Profunctor/Optic/Lens.hs +12/−20
• src/Data/Profunctor/Optic/Operator.hs +9/−51
• src/Data/Profunctor/Optic/Option.hs +2/−3
• src/Data/Profunctor/Optic/Prelude.hs +42/−39
• src/Data/Profunctor/Optic/Prism.hs +4/−43
• src/Data/Profunctor/Optic/Setter.hs +11/−53
• src/Data/Profunctor/Optic/Traversal.hs +8/−16
• src/Data/Profunctor/Optic/View.hs +9/−85
• src/Data/Tuple/Optic.hs +0/−8
• test/doctest.hs +3/−0

@@ -1,7 +1,7 @@ cabal-version: >= 1.10  name:           profunctor-optics-version:        0.0.0.5+version:        0.0.1 synopsis:       An optics library compatible with the typeclasses in 'profunctors'. description:     This package provides utilities for creating and manipulating profunctor-based optics. Some highlights:@@ -42,11 +42,6 @@       Data.Either.Optic       Data.Tuple.Optic -      Data.Connection.Optic-      Data.Connection.Optic.Int-      Data.Connection.Optic.Word-      Data.Connection.Optic.Float-       Data.Profunctor.Optic       Data.Profunctor.Optic.Types       Data.Profunctor.Optic.Property@@ -95,14 +90,15 @@   build-depends:       base              >= 4.9      && < 5.0     , adjunctions       >= 4.4      && < 5.0-    , connections       >= 0.0.2.2  && < 0.1+    , connections       >= 0.0.3    && < 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+    , profunctor-arrows >= 0.0.0.3  && < 0.0.1     , profunctors       >= 5.4      && < 6-    , rings             >= 0.0.2.4  && < 0.1+    , rings             >= 0.0.3.1  && < 0.0.4+    , magmas            >= 0.0.1    && < 0.1     , semigroupoids     >= 5        && < 6     , tagged            >= 0.4.4    && < 1     , transformers      >= 0.5      && < 0.6@@ -136,6 +132,7 @@       base     , adjunctions     , containers+    , connections     , doctest >= 0.8     , ilist     , mtl

@@ -89,6 +89,7 @@ import Foreign.C.Types import GHC.IO.Exception (IOErrorType) import System.IO+import Prelude (String) import qualified Control.Exception as Ex  import qualified GHC.IO.Exception as Ghc 

@@ -1,25 +0,0 @@-module Data.Connection.Optic (-    dual-  , just-  , binord-  , ordbin-  , connected-) where--import Data.Connection (Conn)-import Data.Prd-import Data.Profunctor.Optic.Grate-import Data.Profunctor.Optic.Import-import qualified Data.Connection as C--dual :: Prd a => Prd b => Conn a b -> Grate' (Down b) (Down a)-dual = connected . C.dual--just :: Prd a => Prd b => Conn a b -> Grate' (Maybe a) (Maybe b)-just = connected . C.just--ordbin :: Grate' Ordering Bool-ordbin = connected C.ordbin --binord :: Grate' Bool Ordering-binord = connected C.binord

@@ -1,34 +0,0 @@-module Data.Connection.Optic.Float (-    f32u32-  , u32f32-) where--import Data.Connection.Float (Ulp32)-import Data.Int-import Data.Prd.Nan (Nan)-import Data.Profunctor.Optic.Grate-import Data.Profunctor.Optic.Import-import Data.Word-import qualified Data.Connection.Float as F---- >>> coview f32u32 (Ulp32 0)--- 0.0--- >>> coview f32u32 (Ulp32 1)--- 1.0e-45-f32u32 :: Grate' Float Ulp32-f32u32 = connected F.f32u32--u32f32 :: Grate' Ulp32 Float-u32f32 = connected F.u32f32--{---- >>> coview f32i32 Nan--- NaN--- >>> zipsWith i32f32 (/) (Def 0) (Def 0)--- Nan-f32i32 :: Grate' Float (Nan Int64)-f32i32 = connected F.f32i32-  -i32f32 :: Grate' (Nan Int64) Float-i32f32 = connected F.i32f32--}

@@ -1,78 +0,0 @@-module Data.Connection.Optic.Int (-  -- * Int8-    i08w08-  , i08w08'-  , i08i16-  , i08i32-  , i08i64-  -- * Int16-  , i16w16-  , i16w16'-  , i16i32-  , i16i64-  -- * Int32-  , i32w32-  , i32w32'-  , i32i64-  -- * Int64-  , i64w64-  , i64w64'-  -- * Integer-  , intnat-) where--import Data.Int-import Data.Word-import Data.Profunctor.Optic.Import-import Data.Profunctor.Optic.Grate-import Numeric.Natural-import qualified Data.Connection.Int as I--i08w08 :: Grate' Int8 Word8-i08w08 = connected I.i08w08--i08w08' :: Grate' Int8 Word8-i08w08' = connected I.i08w08'---- >>> (127 :: Int8) + 3--- -126--- >>> zipWithOf i08i16 (+) 127 3--- 127-i08i16 :: Grate' Int8 Int16-i08i16 = connected I.i08i16--i08i32 :: Grate' Int8 Int32-i08i32 = connected I.i08i32--i08i64 :: Grate' Int8 Int64-i08i64 = connected I.i08i64--i16w16 :: Grate' Int16 Word16-i16w16 = connected I.i16w16--i16w16' :: Grate' Int16 Word16-i16w16' = connected I.i16w16'--i16i32 :: Grate' Int16 Int32-i16i32 = connected I.i16i32--i16i64 :: Grate' Int16 Int64-i16i64 = connected I.i16i64--i32w32 :: Grate' Int32 Word32-i32w32 = connected I.i32w32--i32w32' :: Grate' Int32 Word32-i32w32' = connected I.i32w32'--i32i64 :: Grate' Int32 Int64-i32i64 = connected I.i32i64--i64w64 :: Grate' Int64 Word64-i64w64 = connected I.i64w64--i64w64' :: Grate' Int64 Word64-i64w64' = connected I.i64w64'--intnat :: Grate' Integer Natural-intnat = connected I.intnat 

@@ -1,78 +0,0 @@-module Data.Connection.Optic.Word (-  -- * Word8-    w08i08-  , w08w16-  , w08w32-  , w08w64-  , w08nat-  -- * Word16-  , w16i16-  , w16w32-  , w16w64-  , w16nat-  -- * Word32-  , w32i32-  , w32w64-  , w32nat-  -- * Word64-  , w64i64-  , w64nat-) where--import Data.Int-import Data.Word-import Data.Profunctor.Optic.Grate -import Numeric.Natural-import qualified Data.Connection.Word as W---- >>> constOf w08i08 0--- 128--- >>> zipWithOf w08i08 (+) 0 0--- 128----w08i08 :: Grate' Word8 Int8-w08i08 = connected W.w08i08---- >>> constOf w08w16 0--- 0--- >>> zipWithOf w08w16 (+) 16 7--- 23----w08w16 :: Grate' Word8 Word16-w08w16 = connected W.w08w16 --w08w32 :: Grate' Word8 Word32-w08w32 = connected W.w08w32--w08w64 :: Grate' Word8 Word64-w08w64 = connected W.w08w64--w08nat :: Grate' Word8 Natural-w08nat = connected W.w08nat--w16i16 :: Grate' Word16 Int16-w16i16 = connected W.w16i16--w16w32 :: Grate' Word16 Word32-w16w32 = connected W.w16w32--w16w64 :: Grate' Word16 Word64-w16w64 = connected W.w16w64--w16nat :: Grate' Word16 Natural-w16nat = connected W.w16nat--w32i32 :: Grate' Word32 Int32-w32i32 = connected W.w32i32--w32w64 :: Grate' Word32 Word64-w32w64 = connected W.w32w64--w32nat :: Grate' Word32 Natural-w32nat = connected W.w32nat--w64i64 :: Grate' Word64 Int64-w64i64 = connected W.w64i64--w64nat :: Grate' Word64 Natural-w64nat = connected W.w64nat

@@ -48,8 +48,6 @@ -- >>> import Data.Functor.Identity -- >>> import Data.List.Index -- >>> :load Data.Profunctor.Optic--- >>> let catchOn :: Int -> Cxprism' Int (Maybe String) String ; catchOn n = kjust $ \k -> if k==n then Just "caught" else Nothing--- >>> let itraversed :: Ixtraversal Int [a] [b] a b ; itraversed = itraversalVl itraverse  --------------------------------------------------------------------- -- 'Affine' & 'Ixaffine'

@@ -114,14 +114,11 @@ -- >>> import Control.Exception hiding (catches) -- >>> import Data.Functor.Identity -- >>> import Data.List.Index as LI--- >>> import Data.Int.Instance () -- >>> import Data.Map as Map -- >>> import Data.Maybe -- >>> import Data.Monoid -- >>> import Data.Semiring hiding (unital,nonunital,presemiring) -- >>> :load Data.Profunctor.Optic--- >>> let itraversed :: Ixtraversal Int [a] [b] a b ; itraversed = itraversalVl itraverse--- >>> let iat :: Int -> Ixaffine' Int [a] a; iat i = iaffine' (\s -> flip LI.ifind s $ \n _ -> n==i) (\s a -> LI.modifyAt i (const a) s)   --------------------------------------------------------------------- -- Carriers@@ -261,8 +258,8 @@  -- | Extract the two functions that characterize a 'Lens'. ---withIxlens :: Monoid i => AIxlens i s t a b -> ((s -> (i , a)) -> (s -> b -> t) -> r) -> r-withIxlens o f = case o (IxlensRep id $ flip const) of IxlensRep x y -> f (x . (mempty,)) (\s b -> y (mempty, s) b)+withIxlens :: (Additive-Monoid) i => AIxlens i s t a b -> ((s -> (i , a)) -> (s -> b -> t) -> r) -> r+withIxlens o f = case o (IxlensRep id $ flip const) of IxlensRep x y -> f (x . (zero,)) (\s b -> y (zero, s) b)  -- | Extract the function that characterizes a 'Grate'. --@@ -270,8 +267,8 @@ withGrate o f = case o (GrateRep $ \k -> k id) of GrateRep sabt -> f sabt {-# INLINE withGrate #-} -withCxgrate :: Monoid k => ACxgrate k s t a b -> ((((s -> a) -> k -> b) -> t) -> r) -> r-withCxgrate o sakbtr = case o (CxgrateRep $ \f -> f id) of CxgrateRep sakbt -> sakbtr $ flip sakbt mempty+withCxgrate :: (Additive-Monoid) k => ACxgrate k s t a b -> ((((s -> a) -> k -> b) -> t) -> r) -> r+withCxgrate o sakbtr = case o (CxgrateRep $ \f -> f id) of CxgrateRep sakbt -> sakbtr $ flip sakbt zero  -- | TODO: Document --@@ -291,8 +288,8 @@  -- | TODO: Document ---withIxoption :: Monoid i => AIxoption r i s a -> (i -> a -> Maybe r) -> s -> Maybe r-withIxoption o f = flip curry mempty $ withOption o (uncurry f)+withIxoption :: (Additive-Monoid) i => AIxoption r i s a -> (i -> a -> Maybe r) -> s -> Maybe r+withIxoption o f = flip curry zero $ withOption o (uncurry f) {-# INLINE withIxoption #-}  -- | TODO: Document@@ -561,7 +558,7 @@  -- | 'Pre' is 'Maybe' with a phantom type variable. ---newtype Pre a b = Pre { getPre :: Maybe a } deriving (Eq, Ord, Show)+newtype Pre a b = Pre { getPre :: Maybe a } deriving (Eq, Show)  instance Functor (Pre a) where fmap _ (Pre p) = Pre p 

@@ -15,8 +15,6 @@     -- * Optics   , cotraversed     -- * Operators-  , (/~)-  , (//~)   , withCotraversal   , distributes  ) where@@ -51,12 +49,10 @@ -- >>> :set -XTupleSections -- >>> :set -XRankNTypes -- >>> import Data.Maybe--- >>> import Data.Int.Instance () -- >>> import Data.List.NonEmpty (NonEmpty(..)) -- >>> import Data.Functor.Identity -- >>> import Data.List.Index -- >>> :load Data.Profunctor.Optic--- >>> let catchOn :: Int -> Cxprism' Int (Maybe String) String ; catchOn n = kjust $ \k -> if k==n then Just "caught" else Nothing  --------------------------------------------------------------------- -- 'Cotraversal'

@@ -30,13 +30,6 @@   , folded_   , folded1    , folded1_-  , unital-  , nonunital-  , presemiring-  , summed-  , summed1-  , multiplied-  , multiplied1     -- * Indexed optics   , ifolded   , ifoldedRep@@ -59,8 +52,6 @@   , ifolds   , folds1   , foldsa-  , foldsp-  , folds1p   , foldsr   , ifoldsr   , ifoldsrFrom@@ -78,26 +69,23 @@   , traverses_   , itraverses_     -- * Auxilliary Types-  , All, Any   , Nedl(..) ) where  import Control.Monad (void) import Control.Monad.Reader as Reader hiding (lift)-import Data.Bool.Instance () -- Semigroup / Monoid / Semiring instances import Data.Foldable (Foldable, foldMap, traverse_)+import Data.List.NonEmpty (NonEmpty(..)) import Data.Key as K-import Data.Monoid hiding (All(..), Any(..))+import Data.Monoid+import Data.Semiring as Rng import Data.Profunctor.Optic.Carrier import Data.Profunctor.Optic.Import import Data.Profunctor.Optic.Traversal import Data.Profunctor.Optic.Types import Data.Profunctor.Optic.View-import Data.Semiring (Semiring(..), Prod(..)) -import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Functor.Rep as F-import qualified Data.Semiring as Rng import qualified Data.List.NonEmpty as NEL  -- $setup@@ -108,16 +96,14 @@ -- >>> import Control.Exception hiding (catches) -- >>> import Data.Functor.Identity -- >>> import Data.List.Index as LI--- >>> import Data.Int.Instance () -- >>> import Data.List.NonEmpty (NonEmpty(..)) -- >>> import qualified Data.List.NonEmpty as NE+-- >>> import Data.Int -- >>> import Data.Map as Map -- >>> import Data.Maybe -- >>> import Data.Monoid--- >>> import Data.Semiring hiding (unital,nonunital,presemiring) -- >>> :load Data.Profunctor.Optic -- >>> let itraversed :: Ixtraversal Int [a] [b] a b ; itraversed = itraversalVl itraverse--- >>> let iat :: Int -> Ixaffine' Int [a] a; iat i = iaffine' (\s -> flip LI.ifind s $ \n _ -> n==i) (\s a -> LI.modifyAt i (const a) s)   --------------------------------------------------------------------- -- 'Fold' & 'Ixfold'@@ -229,16 +215,16 @@ -- | TODO: Document -- -- @--- afold1 :: Semigroup r => ((a -> r) -> s -> r) -> AFold1 r s a+-- afold1 :: ((a -> r) -> s -> r) -> AFold1 r s a -- @ ---afold1 :: Semigroup r => ((a -> r) -> s -> r) -> APrimView r s t a b+afold1 :: ((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 :: ((i -> a -> r) -> s -> r) -> AIxfold1 r i s a aifold1 f = afold1 $ \iar s -> f (curry iar) $ snd s {-# INLINE aifold1 #-} @@ -278,111 +264,6 @@ folded1_ = fold1_ id {-# INLINE folded1_ #-} --- | Expression in a unital semiring ------ @ --- 'unital' ≡ 'summed' . 'multiplied'--- @------ >>> folds unital [[1,2], [3,4 :: Int]]--- 14------ For semirings without a multiplicative unit this is --- equivalent to @const mempty@:------ >>> folds unital $ (fmap . fmap) Just [[1,2], [3,4 :: Int]]--- Just 0------ In this situation you most likely want to use 'nonunital'.----unital :: Foldable f => Foldable g => Monoid r => Semiring r => AFold r (f (g a)) a-unital = summed . multiplied-{-# INLINE unital #-}---- | Expression in a semiring expression with no multiplicative unit.------ @ --- 'nonunital' ≡ 'summed' . 'multiplied1'--- @------ >>> folds1 nonunital $ (fmap . fmap) Just [1 :| [2], 3 :| [4 :: Int]]--- Just 14----nonunital :: Foldable f => Foldable1 g => Monoid r => Semiring r => AFold r (f (g a)) a-nonunital = summed . multiplied1-{-# INLINE nonunital #-}---- | Expression in a semiring with no additive or multiplicative unit.------ @ --- 'presemiring' ≡ 'summed1' . 'multiplied1'--- @----presemiring :: Foldable1 f => Foldable1 g => Semiring r => AFold1 r (f (g a)) a-presemiring = summed1 . multiplied1-{-# INLINE presemiring #-}---- | Monoidal sum of a foldable collection.------ >>> 1 <> 2 <> 3 <> 4 :: Int--- 10--- >>> folds summed [1,2,3,4 :: Int]--- 10------ 'summed' and 'multiplied' compose just as they do in arithmetic:------ >>> 1 >< 2 <> 3 >< 4 :: Int--- 14--- >>> folds (summed . multiplied) [[1,2], [3,4 :: Int]]--- 14--- >>> (1 <> 2) >< (3 <> 4) :: Int--- 21--- >>> folds (multiplied . summed) [[1,2], [3,4 :: Int]]--- 21----summed :: Foldable f => Monoid r => AFold r (f a) a-summed = afold foldMap-{-# INLINE summed #-}---- | Semigroup sum of a non-empty foldable collection.------ >>> 1 <> 2 <> 3 <> 4 :: Int--- 10--- >>> folds1 summed1 $ 1 :| [2,3,4 :: Int]--- 10----summed1 :: Foldable1 f => Semigroup r => AFold1 r (f a) a-summed1 = afold1 foldMap1-{-# INLINE summed1 #-}---- | Semiring product of a foldable collection.------ >>> 1 >< 2 >< 3 >< 4 :: Int--- 24--- >>> folds multiplied [1,2,3,4 :: Int]--- 24------ For semirings without a multiplicative unit this is --- equivalent to @const mempty@:------ >>> folds multiplied $ fmap Just [1..(5 :: Int)]--- Just 0------ In this situation you most likely want to use 'multiplied1'.----multiplied :: Foldable f => Monoid r => Semiring r => AFold r (f a) a-multiplied = afold Rng.product-{-# INLINE multiplied #-}---- | Semiring product of a non-empty foldable collection. ------ >>> folds1 multiplied1 $ fmap Just (1 :| [2..(5 :: Int)])--- Just 120 ----multiplied1 :: Foldable1 f => Semiring r => AFold1 r (f a) a-multiplied1 = afold1 Rng.product1-{-# INLINE multiplied1 #-}- --------------------------------------------------------------------- -- Indexed optics  ---------------------------------------------------------------------@@ -428,7 +309,7 @@ -- | Map an optic to a monoid and combine the results. -- -- @--- 'Data.Foldable.foldMap' = 'withFold' 'folded_''+-- 'Data.Foldable.foldMap' = 'withFold' 'folded_' -- @ -- -- >>> withFold both id (["foo"], ["bar", "baz"])@@ -450,10 +331,6 @@ -- -- Note that most indexed optics do not use their output index: ----- >>> withIxfold itraversed const 100 [1..5]--- 10--- >>> withIxfold itraversed const 100 []--- 0 -- withIxfold :: Monoid r => AIxfold r i s a -> (i -> a -> r) -> i -> s -> r withIxfold o f = curry $ withFold o (uncurry f)@@ -502,11 +379,11 @@ -- ('^..') ≡ 'flip' 'lists' -- @ ----- >>> [[1,2], [3 :: Int]] ^.. id+-- >>> [[1,2], [3 :: Int64]] ^.. id -- [[[1,2],[3]]]--- >>> [[1,2], [3 :: Int]] ^.. traversed+-- >>> [[1,2], [3 :: Int64]] ^.. traversed -- [[1,2],[3]]--- >>> [[1,2], [3 :: Int]] ^.. traversed . traversed+-- >>> [[1,2], [3 :: Int64]] ^.. traversed . traversed -- [1,2,3] -- -- >>> (1,2) ^.. bitraversed@@ -541,7 +418,10 @@ -- 'lists' l ≡ 'map' 'snd' '.' 'ilists' l -- @ ---ilists :: Monoid i => AIxfold (Endo [(i, a)]) i s a -> s -> [(i, a)]+-- >>> ilists (itraversed . imapping swapped) [(40,'f'),(41,'o'),(42,'o')]+-- [(0,('f',40)),(1,('o',41)),(2,('o',42))]+--+ilists :: (Additive-Monoid) i => AIxfold (Endo [(i, a)]) i s a -> s -> [(i, a)] ilists o = ifoldsr o (\i a -> ((i,a):)) [] {-# INLINE ilists #-} @@ -549,7 +429,7 @@  -- | Infix version of 'ilists'. ---(^%%) :: Monoid i => s -> AIxfold (Endo [(i, a)]) i s a -> [(i, a)]+(^%%) :: (Additive-Monoid) i => s -> AIxfold (Endo [(i, a)]) i s a -> [(i, a)] (^%%) = flip ilists {-# INLINE (^%%) #-} @@ -570,8 +450,8 @@  -- | TODO: Document ---ifolds :: Monoid i => Monoid a => AIxfold (i, a) i s a -> s -> (i, a)-ifolds o = withIxfold o (,) mempty+ifolds :: (Additive-Monoid) i => Monoid a => AIxfold (Additive i, a) i s a -> s -> (i, a)+ifolds o = first unAdditive . withIxfold o (\i a -> (Additive i, a)) zero {-# INLINE ifolds #-}  -- | TODO: Document@@ -591,28 +471,9 @@ foldsa = flip withFold pure {-# INLINE foldsa #-} --- | Compute the semiring product of the foci of an optic.------ For semirings without a multiplicative unit this is equivalent to @const mempty@:------ >>> foldsp folded Just [1..(5 :: Int)]--- Just 0------ In this situation you most likely want to use 'folds1p'.----foldsp :: Monoid r => Semiring r => AFold (Prod r) s a -> (a -> r) -> s -> r-foldsp o p = getProd . withFold o (Prod . p)-{-# INLINE foldsp #-}---- | Compute the semiring product of the foci of an optic.----folds1p :: Semiring r => AFold (Prod r) s a -> (a -> r) -> s -> r-folds1p o p = getProd . withFold1 o (Prod . p)-{-# INLINE folds1p #-}- -- | Right fold over an optic. ----- >>> foldsr folded (<>) 0 [1..5::Int]+-- >>> foldsr folded (+) 0 [1..5::Int64] -- 15 -- foldsr :: AFold (Endo r) s a -> (a -> r -> r) -> r -> s -> r@@ -629,8 +490,8 @@ -- >>> ifoldsr itraversed (\i a -> ((show i ++ ":" ++ show a ++ ", ") ++)) [] [1,3,5,7,9] -- "0:1, 1:3, 2:5, 3:7, 4:9, " ---ifoldsr :: Monoid i => AIxfold (Endo r) i s a -> (i -> a -> r -> r) -> r -> s -> r-ifoldsr o f = ifoldsrFrom o f mempty+ifoldsr :: (Additive-Monoid) i => AIxfold (Endo r) i s a -> (i -> a -> r -> r) -> r -> s -> r+ifoldsr o f = ifoldsrFrom o f zero {-# INLINE ifoldsr #-}  -- | Indexed right fold over an indexed optic, using an initial index value.@@ -644,7 +505,7 @@  -- | Left fold over an optic. ---foldsl :: AFold (Dual (Endo r)) s a -> (r -> a -> r) -> r -> s -> r+foldsl :: AFold ((Endo-Dual) r) s a -> (r -> a -> r) -> r -> s -> r foldsl o f r = (`appEndo` r) . getDual . withFold o (Dual . Endo . flip f) {-# INLINE foldsl #-} @@ -655,8 +516,8 @@ -- '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+ifoldsl :: (Additive-Monoid) i => AIxfold ((Endo-Dual) r) i s a -> (i -> r -> a -> r) -> r -> s -> r+ifoldsl o f = ifoldslFrom o f zero {-# INLINE ifoldsl #-}  -- | Left fold over an indexed optic, using an initial index value.@@ -664,13 +525,13 @@ -- This is only for use with the few indexed optics that don't ignore their  -- output index. You most likely want to use 'ifoldsl'. ---ifoldslFrom :: AIxfold (Dual (Endo r)) i s a -> (i -> r -> a -> r) -> i -> r -> s -> r+ifoldslFrom :: AIxfold ((Endo-Dual) r) i s a -> (i -> r -> a -> r) -> i -> r -> s -> r ifoldslFrom o f i r = (`appEndo` r) . getDual . withIxfold o (\i -> Dual . Endo . flip (f i)) i {-# INLINE ifoldslFrom #-}  -- | Strict right fold over an optic. ---foldsr' :: AFold (Dual (Endo (Endo r))) s a -> (a -> r -> r) -> r -> s -> r+foldsr' :: AFold ((Endo-Dual) (Endo r)) s a -> (a -> r -> r) -> r -> s -> r foldsr' l f z0 xs = foldsl l f' (Endo id) xs `appEndo` z0 where f' (Endo k) x = Endo $ \ z -> k $! f x z {-# INLINE foldsr' #-} @@ -681,7 +542,7 @@ -- 'foldrWithKey'' f ≡ 'ifoldsr'' 'ifolded' f -- @ ---ifoldsr' :: Monoid i => AIxfold (Dual (Endo (r -> r))) i s a -> (i -> a -> r -> r) -> r -> s -> r+ifoldsr' :: (Additive-Monoid) i => AIxfold ((Endo-Dual) (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' #-} @@ -700,7 +561,7 @@ -- 'foldsl'' :: 'Affine'' s a -> (c -> a -> c) -> c -> s -> c -- @ ---foldsl' :: AFold (Endo (Endo r)) s a -> (r -> a -> r) -> r -> s -> r+foldsl' :: AFold ((Endo-Endo) r) s a -> (r -> a -> r) -> r -> s -> r foldsl' o f r s = foldsr o f' (Endo id) s `appEndo` r where f' x (Endo k) = Endo $ \z -> k $! f z x {-# INLINE foldsl' #-} @@ -711,13 +572,13 @@ -- 'foldlWithKey'' f ≡ 'ifoldsl'' 'ifolded' f -- @ ---ifoldsl' :: Monoid i => AIxfold (Endo (r -> r)) i s a -> (i -> r -> a -> r) -> r -> s -> r+ifoldsl' :: (Additive-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 {-# INLINE ifoldsl' #-}  -- | Monadic right fold over an optic. ---foldsrM :: Monad m => AFold (Dual (Endo (r -> m r))) s a -> (a -> r -> m r) -> r -> s -> m r+foldsrM :: Monad m => AFold ((Endo-Dual) (r -> m r)) s a -> (a -> r -> m r) -> r -> s -> m r foldsrM l f z0 xs = foldsl l f' return xs z0 where f' k x z = f x z >>= k {-# INLINE foldsrM #-} @@ -727,7 +588,7 @@ -- 'foldsrM' ≡ 'ifoldrM' '.' 'const' -- @ ---ifoldsrM :: Monoid i => Monad m => AIxfold (Dual (Endo (r -> m r))) i s a -> (i -> a -> r -> m r) -> r -> s -> m r+ifoldsrM :: (Additive-Monoid) i => Monad m => AIxfold ((Endo-Dual) (r -> m r)) i s a -> (i -> a -> r -> m r) -> r -> s -> m r ifoldsrM o f z0 xs = ifoldsl o f' return xs z0 where f' i k x z = f i x z >>= k {-# INLINE ifoldsrM #-} @@ -743,7 +604,7 @@ -- 'foldslM' ≡ 'ifoldslM' '.' 'const' -- @ ---ifoldslM :: Monoid i => Monad m => AIxfold (Endo (r -> m r)) i s a -> (i -> r -> a -> m r) -> r -> s -> m r+ifoldslM :: (Additive-Monoid) i => Monad m => AIxfold (Endo (r -> m r)) i s a -> (i -> r -> a -> m r) -> r -> s -> m r ifoldslM o f z0 xs = ifoldsr o f' return xs z0 where f' i x k z = f i z x >>= k {-# INLINE ifoldslM #-} @@ -763,17 +624,13 @@  -- | Applicative fold over an indexed optic. ---itraverses_ :: Monoid i => Applicative f => AIxfold (Endo (f ())) i s a -> (i -> a -> f r) -> s -> f ()+itraverses_ :: (Additive-Monoid) i => Applicative f => AIxfold (Endo (f ())) i s a -> (i -> a -> f r) -> s -> f () itraverses_ p f = ifoldsr p (\i a fu -> void (f i a) *> fu) (pure ()) {-# INLINE itraverses_ #-}  ------------------------------------------------------------------------------ -- Auxilliary Types --------------------------------------------------------------------------------type All = Prod Bool--type Any = Bool  -- A non-empty difference list. newtype Nedl a = Nedl { getNedl :: [a] -> NEL.NonEmpty a }

@@ -11,7 +11,6 @@   , Grate'   , Cxgrate   , Cxgrate'-    -- * Constructors   , grate   , grateVl   , kgrateVl@@ -59,8 +58,8 @@ import Data.Profunctor.Optic.Import import Data.Profunctor.Optic.Index import Data.Profunctor.Optic.Iso (tabulated)-import Data.Semiring.Module +import Prelude (IO) import qualified Data.Functor.Rep as F  -- $setup@@ -74,7 +73,6 @@ -- >>> import Data.Connection.Int -- >>> import Data.List as L -- >>> import Data.Monoid (Endo(..))--- >>> import Data.Semiring -- >>> :load Data.Profunctor.Optic  ---------------------------------------------------------------------@@ -259,15 +257,19 @@  -- | Obtain a 'Cxgrate' from a representable functor. ----- >>> kzipsWith (coindexed @Complex) (\t -> if t then (<>) else (><)) (2 :+ 2) (3 :+ 4)+-- >>> 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 :: F.Representable f => (Additive-Monoid) (F.Rep f) => Cxgrate (F.Rep f) (f a) (f b) a b coindexed = kgrateVl grateRep {-# INLINE coindexed #-} +grateRep :: F.Representable f => forall g. Functor g => (F.Rep f -> g a1 -> a2) -> g (f a1) -> f a2+grateRep iab s = F.tabulate $ \i -> iab i (fmap (`F.index` i) s)+{-# INLINE grateRep #-}+ --------------------------------------------------------------------- -- Primitive operators ---------------------------------------------------------------------@@ -306,13 +308,13 @@  -- | Zip over a 'Grate'.  ----- @\f -> 'zipsWith' 'closed' ('zipsWith' 'closed' f) ≡ 'zipsWith' ('closed' . 'closed')@+-- @\\f -> 'zipsWith' 'closed' ('zipsWith' 'closed' f) ≡ 'zipsWith' ('closed' . 'closed')@ -- zipsWith :: AGrate s t a b -> (a -> a -> b) -> s -> s -> t zipsWith o aab s1 s2 = withGrate o $ \sabt -> sabt $ \get -> aab (get s1) (get s2) {-# INLINE zipsWith #-} -kzipsWith :: Monoid k => ACxgrate k s t a b -> (k -> a -> a -> b) -> s -> s -> t+kzipsWith :: (Additive-Monoid) k => ACxgrate k s t a b -> (k -> a -> a -> b) -> s -> s -> t kzipsWith o kaab s1 s2 = withCxgrate o $ \sakbt -> sakbt $ \sa k -> kaab k (sa s1) (sa s2) {-# INLINE kzipsWith #-} 

@@ -18,6 +18,8 @@ import Data.Functor.Apply as Export import Data.Semigroup.Foldable as Export import Data.Semigroup.Traversable as Export+import Data.Semiring as Export (type (-), Additive(..), Multiplicative(..))+import Data.Foldable as Export (foldr) import Data.Functor.Compose as Export import Data.Functor.Const as Export import Data.Functor.Contravariant as Export@@ -32,4 +34,4 @@ import Data.Profunctor.Rep as Export (Representable(..), Corepresentable(..)) import Data.Tagged as Export import Data.Void as Export-import Prelude as Export hiding (Num(..), all, any, min, max, head, tail, elem, notElem, userError)+import Numeric.Prelude as Export

@@ -54,78 +54,46 @@ import Data.Bifunctor as B import Data.Foldable import Data.Semigroup-import Data.Profunctor.Optic.Import+import Data.Profunctor.Optic.Import as I import Data.Profunctor.Optic.Types import Data.Profunctor.Strong import GHC.Generics (Generic)  import qualified Control.Category as C --- $setup--- >>> :set -XNoOverloadedStrings--- >>> :set -XTypeApplications--- >>> :set -XFlexibleContexts--- >>> :set -XTupleSections--- >>> :set -XRankNTypes--- >>> import Data.Semigroup--- >>> import Data.Semiring--- >>> import Data.Int.Instance ()--- >>> import Data.Map--- >>> :load Data.Profunctor.Optic--- >>> let itraversed :: Ord k => Ixtraversal k (Map k a) (Map k b) a b ; itraversed = itraversalVl traverseWithKey--- >>> let foobar = fromList [(0::Int, fromList [(0,"foo"), (1,"bar")]), (1, fromList [(0,"baz"), (1,"bip")])]--- >>> let exercises :: Map String (Map String Int); exercises = fromList [("Monday", fromList [("pushups", 10), ("crunches", 20)]), ("Wednesday", fromList [("pushups", 15), ("handstands", 3)]), ("Friday", fromList [("crunches", 25), ("handstands", 5)])] - --------------------------------------------------------------------- -- Indexing ---------------------------------------------------------------------  infixr 8 % --- | Compose two indexed traversals, combining indices.------ Its precedence is one lower than that of function composition, which allows /./ to be nested in /%/.------ >>> ilists (itraversed . itraversed) exercises--- [("crunches",25),("handstands",5),("crunches",20),("pushups",10),("handstands",3),("pushups",15)]------ >>> ilists (itraversed % itraversed) exercises --- [("Fridaycrunches",25),("Fridayhandstands",5),("Mondaycrunches",20),("Mondaypushups",10),("Wednesdayhandstands",3),("Wednesdaypushups",15)]------ If you only need the final index then use /./:------ >>> ilists (itraversed . itraversed) foobar--- [(0,"foo"),(1,"bar"),(0,"baz"),(1,"bip")]------ This is identical to the more convoluted:------ >>> ilistsFrom (ilast itraversed % ilast itraversed) (Last 0) foobar & fmapped . first' ..~ getLast--- [(0,"foo"),(1,"bar"),(0,"baz"),(1,"bip")]----(%) :: Semigroup i => Representable p => IndexedOptic p i b1 b2 a1 a2 -> IndexedOptic p i c1 c2 b1 b2 -> IndexedOptic p i c1 c2 a1 a2+(%) :: (Additive-Semigroup) i => Representable p => IndexedOptic p i b1 b2 a1 a2 -> IndexedOptic p i c1 c2 b1 b2 -> IndexedOptic p i c1 c2 a1 a2 f % g = repn $ \ia1a2 (ic,c1) ->            withIxrepn g ic c1 $ \ib b1 -> -            withIxrepn f ib b1 $ \ia a1 -> ia1a2 (ib <> ia, a1)+            withIxrepn f ib b1 $ \ia a1 -> ia1a2 (ib I.+ ia, a1) {-# INLINE (%) #-} +{-+iadd :: Profunctor p => IndexedOptic p i s t a b -> IndexedOptic p (Additive i) s t a b+iadd = reix Additive unAdditive++imul :: Profunctor p => IndexedOptic p i s t a b -> IndexedOptic p (Multiplicative i) s t a b+imul = reix Multiplicative unMultiplicative+-} iinit :: Profunctor p => IndexedOptic p i s t a b -> IndexedOptic p (First i) s t a b iinit = reix First getFirst  ilast :: Profunctor p => IndexedOptic p i s t a b -> IndexedOptic p (Last i) s t a b ilast = reix Last getLast + -- | Map over the indices of an indexed optic. ----- >>> ilists (itraversed . reix (<>10) id itraversed) foobar--- [(10,"foo"),(11,"bar"),(10,"baz"),(11,"bip")]--- -- See also 'Data.Profunctor.Optic.Iso.reixed'. -- reix :: Profunctor p => (i -> j) -> (j -> i) -> IndexedOptic p i s t a b -> IndexedOptic p j s t a b reix ij ji = (. lmap (first' ij)) . (lmap (first' ji) .) --- >>> ilists (itraversed . imap head pure) [[1,2,3],[4,5,6]]--- [(0,1),(1,4)] imap :: Profunctor p => (s -> a) -> (b -> t) -> IndexedOptic p i s t a b imap sa bt = dimap (fmap sa) bt @@ -144,10 +112,10 @@ -- -- If you only need the final index then use /./. ---(#) :: Semigroup k => Corepresentable p => CoindexedOptic p k b1 b2 a1 a2 -> CoindexedOptic p k c1 c2 b1 b2 -> CoindexedOptic p k c1 c2 a1 a2+(#) :: (Additive-Semigroup) k => Corepresentable p => CoindexedOptic p k b1 b2 a1 a2 -> CoindexedOptic p k c1 c2 b1 b2 -> CoindexedOptic p k c1 c2 a1 a2 f # g = corepn $ \a1ka2 c1 kc ->            withCxrepn g c1 kc $ \b1 kb -> -            withCxrepn f b1 kb $ \a1 ka -> a1ka2 a1 (kb <> ka)+            withCxrepn f b1 kb $ \a1 ka -> a1ka2 a1 (kb I.+ ka) {-# INLINE (#) #-}  kinit :: Profunctor p => CoindexedOptic p k s t a b -> CoindexedOptic p (First k) s t a b

@@ -12,7 +12,6 @@   , Equality'   , Iso   , Iso'-    -- * Constructors   , iso   , isoVl   , imapping@@ -73,7 +72,6 @@ import Data.Profunctor.Optic.Types import Data.Profunctor.Yoneda (Coyoneda(..), Yoneda(..)) - import qualified Data.Functor.Rep as F import qualified Control.Monad as M (join) import qualified GHC.Generics as G@@ -83,14 +81,12 @@ -- >>> :set -XTypeApplications -- >>> :set -XAllowAmbiguousTypes -- >>> import Data.Monoid--- >>> import Data.Int.Instance () -- >>> import Data.List.Index -- >>> import Data.Semiring -- >>> import Data.Functor.Identity -- >>> import Data.Functor.Const -- >>> import Data.Profunctor.Types -- >>> :load Data.Profunctor.Optic--- >>> let itraversed :: Ixtraversal Int [a] [b] a b ; itraversed = itraversalVl itraverse  --------------------------------------------------------------------- -- 'Iso' @@ -136,9 +132,6 @@  -- | Lift an 'Iso' into an indexed version.  ----- >>> ilists (itraversed . imapping swapped) [(40,'f'),(41,'o'),(42,'o')]--- [(0,('f',40)),(1,('o',41)),(2,('o',42))]--- imapping :: Profunctor p => AIso s t a b -> IndexedOptic p i s t a b imapping o = withIso o imap {-# INLINE imapping #-}@@ -166,8 +159,6 @@ {-# INLINE contramapping #-}  -- | Lift a pair of 'Iso's into a pair of profunctors. ------ -- dimapping :: Profunctor p => Profunctor q => AIso s1 t1 a1 b1 -> AIso s2 t2 a2 b2 -> Iso (p a1 s2) (q b1 t2) (p s1 a2) (q t1 b2) dimapping f g = withIso f $ \sa1 bt1 -> withIso g $ \sa2 bt2 -> iso (dimap sa1 sa2) (dimap bt1 bt2)

@@ -40,18 +40,15 @@ 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.Semiring.V2--- >>> import Data.Semiring.V3+-- >>> import Data.Semimodule.Free+-- >>> import Data.Semimodule.Basis -- >>> :load Data.Profunctor.Optic  ---------------------------------------------------------------------@@ -120,9 +117,7 @@  -- | Transform an indexed Van Laarhoven lens into an indexed profunctor 'Lens'. ----- An 'Ixlens' is a valid 'Lens' and a valid 'IxTraversal'. ------ Compare 'lensVl' & 'Data.Profunctor.Optic.Traversal.itraversalVl'.+-- An 'Ixlens' is a valid 'Ixtraversal'. Compare 'Data.Profunctor.Optic.Traversal.itraversalVl'. -- -- /Caution/: In order for the generated optic to be well-defined, -- you must ensure that the input satisfies the following properties:@@ -205,31 +200,28 @@  -- | Obtain a 'Lens' from a representable functor. ----- >>> V2 3 1 ^. indexed I21+-- >>> V2 3 1 ^. indexed E21 -- 3--- >>> V3 "foo" "bar" "baz" & indexed I32 .~ "bip"+-- >>> V3 "foo" "bar" "baz" & indexed E32 .~ "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 i = lensVl $ lensRep i  +lensRep :: F.Representable f => Eq (F.Rep f) => F.Rep f -> forall g. Functor g => (a -> g a) -> f a -> g (f a) +lensRep i f s = setter s <$> f (getter s)+  where getter = flip F.index i+        setter s' b = F.tabulate $ \j -> bool (F.index s' j) b (i == j)+{-# INLINE lensRep #-}+ --------------------------------------------------------------------- -- Indexed optics  ---------------------------------------------------------------------  -- | TODO: Document ----- >>> ilists (ix @Int traversed . ix first' . ix traversed) [("foo",1), ("bar",2)]--- [(0,'f'),(1,'o'),(2,'o'),(0,'b'),(1,'a'),(2,'r')]--- -- >>> ilists (ix @Int traversed . ifirst . ix traversed) [("foo",1), ("bar",2)] -- [(0,'f'),(1,'o'),(2,'o'),(0,'b'),(1,'a'),(2,'r')]------ >>> ilists (ix @Int traversed % ix first' % ix traversed) [("foo",1), ("bar",2)]--- [(0,'f'),(1,'o'),(2,'o'),(1,'b'),(2,'a'),(3,'r')]--- -- >>> ilists (ix @Int traversed % ifirst % ix traversed) [("foo",1), ("bar",2)] -- [(0,'f'),(1,'o'),(2,'o'),(2,'b'),(3,'a'),(4,'r')] --

@@ -14,10 +14,6 @@   , (#^)   , (..~)   , (.~)-  , (**~)-  , (*~)-  , (//~)-  , (/~)   , (%%~)   , (%~)   , (##~)@@ -38,13 +34,11 @@ -- >>> :set -XFlexibleContexts -- >>> :set -XRankNTypes -- >>> import Data.List.Index as LI--- >>> import Data.Int.Instance () -- >>> import Data.Maybe -- >>> import Data.Monoid -- >>> :load Data.Profunctor.Optic--- >>> let iat :: Int -> Ixaffine' Int [a] a; iat i = iaffine' (\s -> flip LI.ifind s $ \n _ -> n==i) (\s a -> LI.modifyAt i (const a) s)  -infixr 4 .~, ..~, *~, **~, /~, //~, %~, %%~, #~, ##~+infixr 4 .~, ..~, %~, %%~, #~, ##~  infixl 8 ^., ^% @@ -74,20 +68,8 @@ -- >>> ("foo", 42) ^% ifirst -- (Just (),"foo") ----- >>> [(0,'f'),(1,'o'),(2,'o') :: (Int, Char)] ^% iat 2 . ifirst--- (Just 2,2)------ In order to 'iview' a 'Choice' optic (e.g. 'Ixaffine', 'Ixtraversal', 'Ixfold', etc),--- /a/ must have a 'Monoid' instance:------ >>> ([] :: [Int]) ^% iat 0--- (Nothing,0)------ >>> ([1] :: [Int]) ^% iat 0--- (Just 0,1)----(^%) :: Monoid i => s -> AIxview i s a -> (Maybe i, a)-(^%) s o = withPrimView o (B.first Just) . (mempty,) $ s+(^%) :: (Additive-Monoid) i => s -> AIxview i s a -> (Maybe i, a)+(^%) s o = withPrimView o (B.first Just) . (zero,) $ s {-# INLINE (^%) #-}  -- | Dual to '^.'.@@ -133,36 +115,12 @@ (.~) o b = o (const b) {-# INLINE (.~) #-} --- | Map over a representable optic.----(**~) :: Optic (Star f) s t a b -> (a -> f b) -> s -> f t-(**~) = withStar-{-# INLINE (**~) #-}---- | Set the focus of a representable optic.----(*~) :: Optic (Star f) s t a b -> f b -> s -> f t-(*~) o b = withStar o (const b)-{-# INLINE (*~) #-}---- | Map over a co-representable optic.----(//~) :: Optic (Costar f) s t a b -> (f a -> b) -> f s -> t-(//~) = withCostar-{-# INLINE (//~) #-}---- | Set the focus of a co-representable optic.----(/~) :: Optic (Costar f) s t a b -> b -> f s -> t-(/~) o b = withCostar o (const b)-{-# INLINE (/~) #-}- -- | Map over an indexed optic. -- -- See also '##~'. ---(%%~) :: Monoid i => AIxsetter i s t a b -> (i -> a -> b) -> s -> t-(%%~) o f = withIxsetter o f mempty+(%%~) :: (Additive-Monoid) i => AIxsetter i s t a b -> (i -> a -> b) -> s -> t+(%%~) o f = withIxsetter o f zero {-# INLINE (%%~) #-}  -- | Set the focus of an indexed optic.@@ -171,7 +129,7 @@ -- -- /Note/ if you're looking for the infix 'over' it is '..~'. ---(%~) :: Monoid i => AIxsetter i s t a b -> (i -> b) -> s -> t+(%~) :: (Additive-Monoid) i => AIxsetter i s t a b -> (i -> b) -> s -> t (%~) o = (%%~) o . (const .) {-# INLINE (%~) #-} @@ -181,14 +139,14 @@ -- --  See also '%%~'. ---(##~) :: Monoid k => ACxsetter k s t a b -> (k -> a -> b) -> s -> t -(##~) o f = withCxsetter o f mempty+(##~) :: (Additive-Monoid) k => ACxsetter k s t a b -> (k -> a -> b) -> s -> t +(##~) o f = withCxsetter o f zero {-# INLINE (##~) #-}  -- | Set the focus of a coindexed optic. -- --  See also '%~'. ---(#~) :: Monoid k => ACxsetter k s t a b -> (k -> b) -> s -> t +(#~) :: (Additive-Monoid) k => ACxsetter k s t a b -> (k -> b) -> s -> t  (#~) o kb = o ##~ flip (const kb)  {-# INLINE (#~) #-}

@@ -166,7 +166,6 @@ -- -- >>> Left 4 ^? left' -- Just 4--- -- >>> Right 4 ^? left' -- Nothing --@@ -210,13 +209,13 @@  -- | TODO: Document  ---ipreview :: Monoid i => AIxoption (i , a) i s a -> s -> Maybe (i , a)+ipreview :: (Additive-Monoid) i => AIxoption (i , a) i s a -> s -> Maybe (i , a) ipreview o = ipreviews o (,) {-# INLINE ipreview #-}  -- | TODO: Document  ---ipreviews :: Monoid i => AIxoption r i s a -> (i -> a -> r) -> s -> Maybe r+ipreviews :: (Additive-Monoid) i => AIxoption r i s a -> (i -> a -> r) -> s -> Maybe r ipreviews o f = withIxoption o (\i -> Just . f i) {-# INLINE ipreviews #-} 

@@ -34,7 +34,6 @@   , kover   , (##~)   , (<>~)-  , (><~)     -- * Fold operators   , preview   , (^?)@@ -48,7 +47,6 @@   , (^%%)   , folds   , foldsa-  , foldsp   , foldsr   , ifoldsr   , ifoldsrFrom@@ -65,6 +63,8 @@   , ifoldslM   , traverses_   , itraverses_+  , sums+  , multiplies   , asums   , concats   , iconcats@@ -80,18 +80,14 @@   , joins'   , meets   , meets'-  , min -  , max +  , mins +  , maxes  ) where -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.Function import Data.Maybe-import Data.Monoid hiding (All(..), Any(..))+import Data.Monoid import Data.Profunctor.Optic.Carrier import Data.Profunctor.Optic.Types import Data.Profunctor.Optic.Iso@@ -101,15 +97,12 @@ import Data.Profunctor.Optic.Setter import Data.Profunctor.Optic.Fold import Data.Profunctor.Optic.Option-import Data.Profunctor.Optic.Traversal import Data.Profunctor.Optic.Affine import Data.Prd (Prd, Minimal(..), Maximal(..))-import Data.Prd.Lattice (Lattice(..))-import Data.Semiring (Semiring(..), Prod(..))+import Data.Semilattice  import qualified Control.Applicative as A-import qualified Data.Prd as Prd-import qualified Data.Semiring as Rng+import Data.Semiring as Rng import qualified Prelude as Pre  -- $setup@@ -119,18 +112,28 @@ -- >>> import Control.Exception hiding (catches) -- >>> import Data.Functor.Identity -- >>> import Data.List.Optic--- >>> import Data.Int.Instance () -- >>> import Data.Map as Map -- >>> import Data.Maybe -- >>> import Data.Monoid -- >>> import Data.Semiring hiding (unital,nonunital,presemiring)--- >>> import Data.Sequence as Seq hiding ((><))+-- >>> import Data.Sequence as Seq hiding ((*)) -- >>> :load Data.Profunctor.Optic + --------------------------------------------------------------------- -- Fold operators --------------------------------------------------------------------- +-- | The sum of a collection.+--+sums :: (Additive-Monoid) a => AFold ((Endo-Endo) a) s a -> s -> a+sums o = foldsl' o (+) zero++-- | The product of a collection.+--+multiplies :: (Multiplicative-Monoid) a => AFold ((Endo-Endo) a) s a -> s -> a+multiplies o = foldsl' o (*) one+ -- | The sum of a collection of actions, generalizing 'concats'. -- -- >>> asums both ("hello","world")@@ -143,7 +146,7 @@ -- 'asum' ≡ 'asums' 'folded' -- @ ---asums :: Alternative f => AFold (Endo (Endo (f a))) s (f a) -> s -> f a+asums :: Alternative f => AFold ((Endo-Endo) (f a)) s (f a) -> s -> f a asums o = foldsl' o (<|>) A.empty {-# INLINE asums #-} @@ -169,8 +172,8 @@ -- >>> iconcats itraversed (\i x -> [i + x, i + x + 1]) [1,2,3,4] -- [1,2,3,4,5,6,7,8] ---iconcats :: Monoid i => AIxfold [r] i s a -> (i -> a -> [r]) -> s -> [r]-iconcats o f = withIxfold o f mempty+iconcats :: (Additive-Monoid) i => AIxfold [r] i s a -> (i -> a -> [r]) -> s -> [r]+iconcats o f = withIxfold o f zero {-# INLINE iconcats #-}  -- | TODO: Document@@ -195,69 +198,69 @@ -- 'Data.Foldable.find' ≡ 'finds' 'folded' -- @ ---finds :: AFold (Endo (Maybe a)) s a -> (a -> Bool) -> s -> Maybe a+finds :: AFold ((Maybe-Endo) a) s a -> (a -> Bool) -> s -> Maybe a finds o f = foldsr o (\a y -> if f a then Just a else y) Nothing {-# INLINE finds #-}  -- | Find the first focus of an indexed optic that satisfies a predicate, if one exists. ---ifinds :: Monoid i => AIxfold (Endo (Maybe (i, a))) i s a -> (i -> a -> Bool) -> s -> Maybe (i, a)+ifinds :: (Additive-Monoid) i => AIxfold ((Maybe-Endo) (i, a)) i s a -> (i -> a -> Bool) -> s -> Maybe (i, a) ifinds o f = ifoldsr o (\i a y -> if f i a then Just (i,a) else y) Nothing {-# INLINE ifinds #-}  -- | Determine whether an optic has at least one focus. ---has :: AFold Any s a -> s -> Bool-has o = withFold o (const True)+has :: AFold (Additive Bool) s a -> s -> Bool+has o s = unAdditive $ withFold o (const $ Additive True) s {-# INLINE has #-}  -- | Determine whether an optic does not have a focus. ---hasnt :: AFold All s a -> s -> Bool-hasnt o = foldsp o (const False)+hasnt :: AFold (Multiplicative Bool) s a -> s -> Bool+hasnt o s = unMultiplicative $ withFold o (const $ Multiplicative False) s {-# INLINE hasnt #-}  -- | Determine whether the targets of a `Fold` contain a given element. ---elem :: Eq a => AFold Any s a -> a -> s -> Bool-elem o a = withFold o (== a)+elem :: Eq a => AFold (Additive Bool) s a -> a -> s -> Bool+elem o a s = unAdditive $ withFold o (\x -> Additive $ x == a) s  -- | Determine whether the foci of an optic contain an element equivalent to a given element. ---pelem :: Prd a => AFold Any s a -> a -> s -> Bool-pelem o a = withFold o (Prd.=~ a)+pelem :: Prd a => AFold (Additive Bool) s a -> a -> s -> Bool+pelem o a s = unAdditive $ withFold o (\x -> Additive $ x =~ a) s {-# INLINE pelem #-}  -- | Compute the minimum of the targets of a totally ordered fold.  ---min :: Ord a => AFold (Endo (Endo a)) s a -> a -> s -> a-min o = foldsl' o Pre.min+mins :: Pre.Ord a => AFold ((Endo-Endo) a) s a -> a -> s -> a+mins o = foldsl' o Pre.min  -- | Compute the maximum of the targets of a totally ordered fold. ---max :: Ord a => AFold (Endo (Endo a)) s a -> a -> s -> a-max o = foldsl' o Pre.max+maxes :: Pre.Ord a => AFold ((Endo-Endo) a) s a -> a -> s -> a+maxes o = foldsl' o Pre.max  -- | Compute the join of the foci of an optic.  ---joins :: Lattice a => AFold (Endo (Endo a)) s a -> a -> s -> a-joins o = foldsl' o (\/)+joins :: Lattice a => AFold ((Endo-Endo) a) s a -> a -> s -> a+joins o = foldsl' o (∨) {-# INLINE joins #-}  -- | Compute the join of the foci of an optic including a least element. ---joins' :: Lattice a => Minimal a => AFold (Endo (Endo a)) s a -> s -> a+joins' :: Lattice a => Minimal a => AFold ((Endo-Endo) a) s a -> s -> a joins' o = joins o minimal {-# INLINE joins' #-}  -- | Compute the meet of the foci of an optic . ---meets :: Lattice a => AFold (Endo (Endo a)) s a -> a -> s -> a-meets o = foldsl' o (/\)+meets :: Lattice a => AFold ((Endo-Endo) a) s a -> a -> s -> a+meets o = foldsl' o (∧) {-# INLINE meets #-}  -- | Compute the meet of the foci of an optic including a greatest element. ---meets' :: Lattice a => Maximal a => AFold (Endo (Endo a)) s a -> s -> a+meets' :: Lattice a => Maximal a => AFold ((Endo-Endo) a) s a -> s -> a meets' o = meets o maximal {-# INLINE meets' #-}

@@ -13,13 +13,10 @@   , Cxprism'   , prism   , prism'-  , kprism   , handling   , clonePrism     -- * Optics-  , kright   , just-  , kjust   , nothing   , compared   , prefixed@@ -46,7 +43,7 @@ import Control.Monad (guard) import Data.Bifunctor as B import Data.Bits (Bits, bit, testBit)-import Data.List (stripPrefix)+import Data.List (stripPrefix,(++)) import Data.Prd import Data.Profunctor.Choice import Data.Profunctor.Optic.Carrier@@ -60,11 +57,8 @@ -- >>> :set -XFlexibleContexts -- >>> :set -XTypeOperators -- >>> :set -XRankNTypes--- >>> import Data.Int.Instance () -- >>> import Data.List.NonEmpty -- >>> :load Data.Profunctor.Optic--- >>> let catchOn :: Int -> Cxprism' Int (Maybe String) String ; catchOn n = kjust $ \k -> if k==n then Just "caught" else Nothing--- >>> let catchFoo :: b -> Cxprism String (String + a) (String + b) a b; catchFoo b = kright $ \e k -> if e == "fooError" && k == mempty then Right b else Left e  --------------------------------------------------------------------- -- 'Prism' & 'Cxprism'@@ -99,11 +93,6 @@ prism' :: (s -> Maybe a) -> (a -> s) -> Prism' s a prism' sa as = flip prism as $ \s -> maybe (Left s) Right (sa s) --- | Obtain a 'Cxprism'' from a reviewer and a matcher function that returns either a match or a failure handler.----kprism :: (s -> (k -> t) + a) -> (b -> t) -> Cxprism k s t a b-kprism skta bt = prism skta (bt .)- -- | Obtain a 'Prism' from its free tensor representation. -- -- Useful for constructing prisms from try and handle functions.@@ -122,10 +111,10 @@  -- | Focus on the `Just` constructor of `Maybe`. ----- >>> Just 1 :| [Just 2, Just 3] & just //~ sum+-- >>> Just 1 :| [Just 2, Just 3] & withCostar just sum -- Just 6 ----- >>> Nothing :| [Just 2, Just 3] & just //~ sum+-- >>> Nothing :| [Just 2, Just 3] & withCostar just sum -- Nothing -- just :: Prism (Maybe a) (Maybe b) a b@@ -138,7 +127,7 @@  -- | Focus on comparability to a given element of a partial order. ---compared :: Eq a => Prd a => a -> Prism' a Ordering+compared :: Prd a => a -> Prism' a Ordering compared x = flip prism' (const x) (pcompare x)  -- | Focus on the remainder of a list with a given prefix.@@ -198,34 +187,6 @@ asyncException :: Exception e => Prism' SomeException e asyncException = prism' asyncExceptionFromException asyncExceptionToException ------------------------------------------------------------------------- Coindexed optics-------------------------------------------------------------------------- | Coindexed prism into the `Right` constructor of `Either`.------ >>> kset (catchFoo "Caught foo") id $ Left "fooError"--- Right "Caught foo"------ >>> kset (catchFoo "Caught foo") id $ Left "barError"--- Left "barError"----kright :: (e -> k -> e + b) -> Cxprism k (e + a) (e + b) a b-kright ekeb = flip kprism Right $ either (Left . ekeb) Right---- | Coindexed prism into the `Just` constructor of `Maybe`.------ >>> Just "foo" & catchOn 1 ##~ (\k msg -> show k ++ ": " ++ msg)--- Just "0: foo"------ >>> Nothing & catchOn 1 ##~ (\k msg -> show k ++ ": " ++ msg)--- Nothing------ >>> Nothing & catchOn 0 ##~ (\k msg -> show k ++ ": " ++ msg)--- Just "caught"----kjust :: (k -> Maybe b) -> Cxprism k (Maybe a) (Maybe b) a b-kjust kb = flip kprism Just $ maybe (Left kb) Right  --------------------------------------------------------------------- -- Operators

@@ -52,7 +52,6 @@   , (%%~)   , (##~)   , (<>~)-  , (><~)     -- * mtl   , locally   , scribe@@ -65,7 +64,6 @@   , (%%=)   , (##=)   , (<>=)-  , (><=) ) where  import Control.Applicative (liftA)@@ -79,7 +77,6 @@ import Data.Profunctor.Optic.Index import Data.Profunctor.Optic.Operator import Data.Profunctor.Optic.Types-import Data.Semiring  import qualified Control.Exception as Ex import qualified Data.Functor.Rep as F@@ -96,21 +93,18 @@ -- >>> import Control.Monad.Reader -- >>> import Control.Monad.Writer -- >>> import Data.Bool (bool)--- >>> import Data.Bool.Instance () -- >>> import Data.Complex -- >>> import Data.Functor.Rep -- >>> import Data.Functor.Identity -- >>> import Data.Functor.Contravariant--- >>> import Data.Int.Instance () -- >>> import Data.List.Index as LI -- >>> import Data.IntSet as IntSet -- >>> import Data.Set as Set -- >>> import Data.Tuple (swap) -- >>> :load Data.Profunctor.Optic--- >>> let catchOn :: Int -> Cxprism' Int (Maybe String) String ; catchOn n = kjust $ \k -> if k==n then Just "caught" else Nothing--- >>> let itraversed :: Ixtraversal Int [a] [b] a b ; itraversed = itraversalVl itraverse -- >>> let iat :: Int -> Ixaffine' Int [a] a; iat i = iaffine' (\s -> flip LI.ifind s $ \n _ -> n==i) (\s a -> LI.modifyAt i (const a) s)  + --------------------------------------------------------------------- -- Setter ---------------------------------------------------------------------@@ -369,7 +363,7 @@ -- Operators --------------------------------------------------------------------- -infixr 4 <>~, ><~+infixr 4 <>~   -- | Prefix variant of '.~'. --@@ -389,11 +383,10 @@ -- -- >>> iset (iat 2) (2-) [1,2,3 :: Int] -- [1,2,0]--- -- >>> iset (iat 5) (const 0) [1,2,3 :: Int] -- [1,2,3] ---iset :: Monoid i => AIxsetter i s t a b -> (i -> b) -> s -> t+iset :: (Additive-Monoid) i => AIxsetter i s t a b -> (i -> b) -> s -> t iset o = iover o . (const .) {-# INLINE iset #-} @@ -401,7 +394,7 @@ -- -- Equivalent to 'kover' with the current value ignored. ---kset :: Monoid k => ACxsetter k s t a b -> (k -> b) -> s -> t +kset :: (Additive-Monoid) k => ACxsetter k s t a b -> (k -> b) -> s -> t  kset o kb = kover o $ flip (const kb) {-# INLINE kset #-} @@ -416,13 +409,10 @@ -- -- >>> over fmapped (+1) (Just 1) -- Just 2--- -- >>> over fmapped (*10) [1,2,3] -- [10,20,30]--- -- >>> over first' (+1) (1,2) -- (2,2)--- -- >>> over first' show (10,20) -- ("10",20) --@@ -434,25 +424,21 @@ -- -- >>> iover (iat 1) (+) [1,2,3 :: Int] -- [1,3,3]--- -- >>> iover (iat 5) (+) [1,2,3 :: Int] -- [1,2,3] ---iover :: Monoid i => AIxsetter i s t a b -> (i -> a -> b) -> s -> t+iover :: (Additive-Monoid) i => AIxsetter i s t a b -> (i -> a -> b) -> s -> t iover = (%%~) {-# INLINE iover #-}  -- | Prefix alias of '##~'. ---kover :: Monoid k => ACxsetter k s t a b -> (k -> a -> b) -> s -> t +kover :: (Additive-Monoid) k => ACxsetter k s t a b -> (k -> a -> b) -> s -> t  kover = (##~) {-# INLINE kover #-}  -- | Modify the target by adding another value. ----- >>> both <>~ True $ (False,True)--- (True,True)--- -- >>> both <>~ "!" $ ("bar","baz") -- ("bar!","baz!") --@@ -460,18 +446,6 @@ l <>~ n = over l (<> n) {-# INLINE (<>~) #-} --- | Modify the target by multiplying by another value.------ >>> both ><~ False $ (False,True)--- (False,False)------ >>> both ><~ ["!"] $ (["bar","baz"], [])--- (["bar!","baz!"],[])----(><~) :: Semiring a => Optic (->) s t a a -> a -> s -> t-l ><~ n = over l (>< n)-{-# INLINE (><~) #-}- --------------------------------------------------------------------- -- Mtl ---------------------------------------------------------------------@@ -485,7 +459,6 @@ -- -- >>> (1,1) & locally first' (+1) (uncurry (+)) -- 3--- -- >>> "," & locally (setter ($)) ("Hello" <>) (<> " world!") -- "Hello, world!" --@@ -501,7 +474,7 @@ scribe o s = Writer.tell $ set o mempty s {-# INLINE scribe #-} -infix 4 .=, ..=, %=, %%=, #=, ##=, <>=, ><=+infix 4 .=, ..=, %=, %%=, #=, ##=, <>=  -- | Replace the target(s) of a settable in a monadic state. --@@ -521,7 +494,6 @@ -- -- >>> execState (do first' .= 1; second' .= 2) (3,4) -- (1,2)--- -- >>> execState (both .= 3) (1,2) -- (3,3) --@@ -531,13 +503,13 @@  -- | TODO: Document  ---(%=) :: MonadState s m => Monoid i => AIxsetter i s s a b -> (i -> b) -> m ()+(%=) :: MonadState s m => (Additive-Monoid) i => AIxsetter i s s a b -> (i -> b) -> m () o %= b = State.modify (o %~ b) {-# INLINE (%=) #-}  -- | TODO: Document  ---(#=) :: MonadState s m => Monoid k => ACxsetter k s s a b -> (k -> b) -> m ()+(#=) :: MonadState s m => (Additive-Monoid) k => ACxsetter k s s a b -> (k -> b) -> m () o #= f = State.modify (o #~ f) {-# INLINE (#=) #-} @@ -547,10 +519,8 @@ -- -- >>> execState (do just ..= (+1) ) Nothing -- Nothing--- -- >>> execState (do first' ..= (+1) ;second' ..= (+2)) (1,2) -- (2,4)--- -- >>> execState (do both ..= (+1)) (1,2) -- (2,3) --@@ -560,33 +530,21 @@  -- | TODO: Document  ---(%%=) :: MonadState s m => Monoid i => AIxsetter i s s a b -> (i -> a -> b) -> m () +(%%=) :: MonadState s m => (Additive-Monoid) i => AIxsetter i s s a b -> (i -> a -> b) -> m ()  o %%= f = State.modify (o %%~ f) {-# INLINE (%%=) #-}  -- | TODO: Document  ---(##=) :: MonadState s m => Monoid k => ACxsetter k s s a b -> (k -> a -> b) -> m () +(##=) :: MonadState s m => (Additive-Monoid) k => ACxsetter k s s a b -> (k -> a -> b) -> m ()  o ##= f = State.modify (o ##~ f) {-# INLINE (##=) #-}  -- | Modify the target(s) of a settable optic by adding a value. ----- >>> execState (both <>= False) (False,True)--- (False,True)--- -- >>> execState (both <>= "!!!") ("hello","world") -- ("hello!!!","world!!!") -- (<>=) :: MonadState s m => Semigroup a => Optic' (->) s a -> a -> m () o <>= a = State.modify (o <>~ a) {-# INLINE (<>=) #-}---- | Modify the target(s) of a settable optic by mulitiplying by a value.------ >>> execState (both ><= False) (False,True)--- (False,False)----(><=) :: MonadState s m => Semiring a => Optic' (->) s a -> a -> m ()-o ><= a = State.modify (o ><~ a)-{-# INLINE (><=) #-}

@@ -47,8 +47,6 @@   , withTraversal1   , withIxtraversal1     -- * Operators-  , (*~)-  , (**~)   , sequences   , sequences1 ) where@@ -76,14 +74,12 @@ -- >>> :set -XTupleSections -- >>> :set -XRankNTypes -- >>> import Data.Maybe--- >>> import Data.Int.Instance () -- >>> import Data.List.NonEmpty (NonEmpty(..)) -- >>> import qualified Data.List.NonEmpty as NE -- >>> import Data.Functor.Identity -- >>> import Data.List.Index -- >>> :load Data.Profunctor.Optic--- >>> let catchOn :: Int -> Cxprism' Int (Maybe String) String ; catchOn n = kjust $ \k -> if k==n then Just "caught" else Nothing--- >>> let itraversed :: Ixtraversal Int [a] [b] a b ; itraversed = itraversalVl itraverse+-- >>> let itraversed :: Ixtraversal Int Int [a] [b] a b ; itraversed = itraversalVl itraverse  --------------------------------------------------------------------- -- 'Traversal' & 'Ixtraversal'@@ -135,8 +131,8 @@ -- -- See 'Data.Profunctor.Optic.Property'. ---itraversing :: Monoid i => Traversable f => (s -> (i , a)) -> (s -> b -> t) -> Ixtraversal i (f s) (f t) a b-itraversing sia sbt = repn (\iab -> traverse (curry iab mempty) . snd) . ilens sia sbt +itraversing :: (Additive-Monoid) i => Traversable f => (s -> (i , a)) -> (s -> b -> t) -> Ixtraversal i (f s) (f t) a b+itraversing sia sbt = repn (\iab -> traverse (curry iab zero) . snd) . ilens sia sbt   -- | Obtain a profunctor 'Traversal' from a Van Laarhoven 'Traversal'. --@@ -172,31 +168,27 @@ -- -- >>> ilists (noix traversed . itraversed) ["foo", "bar"] -- [(0,'f'),(1,'o'),(2,'o'),(0,'b'),(1,'a'),(2,'r')]--- -- >>> ilists (itraversed . noix traversed) ["foo", "bar"] -- [(0,'f'),(0,'o'),(0,'o'),(0,'b'),(0,'a'),(0,'r')] ---noix :: Monoid i => Traversal s t a b -> Ixtraversal i s t a b-noix o = itraversalVl $ \iab s -> flip runStar s . o . Star $ iab mempty+noix :: (Additive-Monoid) i => Traversal s t a b -> Ixtraversal i s t a b+noix o = itraversalVl $ \iab s -> flip runStar s . o . Star $ iab zero  -- | Index a traversal with a 'Data.Semiring'. -- -- >>> ilists (ix traversed . ix traversed) ["foo", "bar"] -- [((),'f'),((),'o'),((),'o'),((),'b'),((),'a'),((),'r')]--- -- >>> ilists (ix @Int traversed . ix traversed) ["foo", "bar"] -- [(0,'f'),(1,'o'),(2,'o'),(0,'b'),(1,'a'),(2,'r')]--- -- >>> ilists (ix @[()] traversed . ix traversed) ["foo", "bar"] -- [([],'f'),([()],'o'),([(),()],'o'),([],'b'),([()],'a'),([(),()],'r')]--- -- >>> ilists (ix @[()] traversed % ix traversed) ["foo", "bar"] -- [([],'f'),([()],'o'),([(),()],'o'),([()],'b'),([(),()],'a'),([(),(),()],'r')] ---ix :: Monoid i => Semiring i => Traversal s t a b -> Ixtraversal i s t a b+ix :: Semiring i => Traversal s t a b -> Ixtraversal i s t a b ix o = itraversalVl $ \f s ->-  flip evalState mempty . getCompose . flip runStar s . o . Star $ \a ->-    Compose $ (f <$> get <*> pure a) <* modify (<> sunit) +  flip evalState zero . getCompose . flip runStar s . o . Star $ \a ->+    Compose $ (f <$> get <*> pure a) <* modify (+ one)   --------------------------------------------------------------------- -- 'Traversal1'

@@ -2,6 +2,7 @@ {-# LANGUAGE RankNTypes            #-} {-# LANGUAGE TypeOperators         #-} {-# LANGUAGE TupleSections         #-}+{-# LANGUAGE FlexibleContexts      #-} module Data.Profunctor.Optic.View (     -- * Types     View@@ -74,12 +75,9 @@ -- >>> import Data.Either -- >>> import Control.Monad.State -- >>> import Control.Monad.Writer--- >>> import Data.Int.Instance () -- >>> import Data.List.Index as LI -- >>> :load Data.Profunctor.Optic Data.Either.Optic Data.Tuple.Optic--- >>> let catchOn :: Int -> Cxprism' Int (Maybe String) String ; catchOn n = kjust $ \k -> if k==n then Just "caught" else Nothing -- >>> let itraversed :: Ixtraversal Int [a] [b] a b ; itraversed = itraversalVl itraverse--- >>> let iat :: Int -> Ixaffine' Int [a] a; iat i = iaffine' (\s -> flip LI.ifind s $ \n _ -> n==i) (\s a -> LI.modifyAt i (const a) s)   --------------------------------------------------------------------- -- 'View' & 'Review'@@ -251,25 +249,8 @@ -- >>> iview ifirst ("foo", 42) -- (Just (),"foo") ----- >>> iview (iat 3 . ifirst) [(0,'f'),(1,'o'),(2,'o'),(3,'b'),(4,'a'),(5,'r') :: (Int, Char)]--- (Just 3,3)------ In order to 'iview' a 'Choice' optic (e.g. 'Ixaffine', 'Ixtraversal', 'Ixfold', etc),--- /a/ must have a 'Monoid' instance:------ >>> iview (iat 0) ([] :: [Int])--- (Nothing,0)--- >>> iview (iat 0) ([1] :: [Int])--- (Just 0,1)------ /Note/ when applied to a 'Ixtraversal' or 'Ixfold', then 'iview' will return a monoidal --- summary of the indices tupled with a monoidal summary of the values:------ >>> (iview @_ @_ @Int @Int) itraversed [1,2,3,4]--- (Just 6,10)----iview :: MonadReader s m => Monoid i => AIxview i s a -> m (Maybe i , a)-iview o = asks $ withPrimView o (B.first Just) . (mempty,)+iview :: MonadReader s m => (Additive-Monoid) i => AIxview i s a -> m (Maybe i , a)+iview o = asks $ withPrimView o (B.first Just) . (zero,) {-# INLINE iview #-}  -- | Map each part of a structure viewed to a semantic editor combinator.@@ -282,17 +263,6 @@ -- >>> views both id (["foo"], ["bar", "baz"]) -- ["foo","bar","baz"] ----- @--- 'views' ::                'AView' s a       -> (a -> r) -> s -> r--- 'views' ::                'Iso'' s a        -> (a -> r) -> s -> r--- 'views' ::                'Lens'' s a       -> (a -> r) -> s -> r--- 'views' ::                'Coprism'' s a    -> (a -> r) -> s -> r--- 'views' :: 'Monoid' r    => 'Traversal'' s a  -> (a -> r) -> s -> r--- 'views' :: 'Semigroup' r => 'Traversal1'' s a -> (a -> r) -> s -> r--- 'views' :: 'Monoid' r    => 'Fold' s a        -> (a -> r) -> s -> r--- 'views' :: 'Semigroup' r => 'Fold1' s a       -> (a -> r) -> s -> r--- @--- views :: MonadReader s m => Optic' (Star (Const r)) s a -> (a -> r) -> m r views o f = asks $ withPrimView o f {-# INLINE views #-}@@ -301,19 +271,10 @@ -- -- 'iviews' ≡ 'iwithFold' ----- >>> iviews (iat 2) (-) ([0,1,2] :: [Int])--- 0------ In order to 'iviews' a 'Choice' optic (e.g. 'Ixaffine', 'Ixtraversal', 'Ixfold', etc),--- /a/ must have a 'Monoid' instance (here from the 'rings' package):------ >>> iviews (iat 3) (flip const) ([1] :: [Int])--- 0------ Use 'iview' if there is a need to disambiguate between 'mempty' as a miss vs. as a return value.+-- Use 'iview' if there is a need to disambiguate between 'zero' as a miss vs. as a return value. ---iviews :: MonadReader s m => Monoid i => IndexedOptic' (Star (Const r)) i s a -> (i -> a -> r) -> m r-iviews o f = asks $ withPrimView o (uncurry f) . (mempty,) +iviews :: MonadReader s m => (Additive-Monoid) i => IndexedOptic' (Star (Const r)) i s a -> (i -> a -> r) -> m r+iviews o f = asks $ withPrimView o (uncurry f) . (zero,)   -- | TODO: Document --@@ -323,7 +284,7 @@  -- | Bring the index and value of an indexed optic into the current environment as a pair. ---iuse :: MonadState s m => Monoid i => AIxview i s a -> m (Maybe i , a)+iuse :: MonadState s m => (Additive-Monoid) i => AIxview i s a -> m (Maybe i , a) iuse o = gets (iview o)  -- | Use the target of a 'Lens', 'Data.Profunctor.Optic.Iso.Iso' or@@ -334,27 +295,14 @@ -- >>> evalState (uses first' length) ("hello","world!") -- 5 ----- @--- 'uses' :: 'MonadState' s m             => 'Data.Profunctor.Optic.Iso.Iso'' s a       -> (a -> r) -> m r--- 'uses' :: 'MonadState' s m             => 'Data.Profunctor.Optic.View.View' s a     -> (a -> r) -> m r--- 'uses' :: 'MonadState' s m             => 'Data.Profunctor.Optic.Lens.Lens'' s a      -> (a -> r) -> m r--- 'uses' :: 'MonadState' s m             => 'Data.Profunctor.Optic.Prism.Coprism'' s a      -> (a -> r) -> m r--- 'uses' :: 'MonadState' s m => 'Data.Monoid.Monoid' r => 'Data.Profunctor.Optic.Traversal.Traversal'' s a -> (a -> r) -> m r--- 'uses' :: 'MonadState' s m => 'Data.Monoid.Monoid' r => 'Data.Profunctor.Optic.Fold.Fold' s a       -> (a -> r) -> m r--- @------ @--- 'uses' :: 'MonadState' s m => 'Getting' r s t a b -> (a -> r) -> m r--- @--- uses :: MonadState s m => Optic' (Star (Const r)) s a -> (a -> r) -> m r uses l f = gets (views l f) {-# INLINE uses #-}  -- | Bring a function of the index and value of an indexed optic into the current environment. ---iuses :: MonadState s m => Monoid i => IndexedOptic' (Star (Const r)) i s a -> (i -> a -> r) -> m r-iuses o f = gets $ withPrimView o (uncurry f) . (mempty,)+iuses :: MonadState s m => (Additive-Monoid) i => IndexedOptic' (Star (Const r)) i s a -> (i -> a -> r) -> m r+iuses o f = gets $ withPrimView o (uncurry f) . (zero,)  -- | A prefix alias of '#^'. --@@ -366,12 +314,6 @@ -- >>> review (from succ) 5 -- 6 ----- @--- 'review' :: 'Iso'' s a   -> a -> s--- 'review' :: 'Prism'' s a -> a -> s--- 'review' :: 'Colens'' s a -> a -> s--- @--- review :: MonadReader b m => AReview t b -> m t review o = reviews o id {-# INLINE review #-}@@ -395,12 +337,6 @@ -- >>> reviews (from succ) (*2) 3 -- 8 ----- @--- 'reviews' :: 'Iso'' t b -> (t -> r) -> b -> r--- 'reviews' :: 'Prism'' t b -> (t -> r) -> b -> r--- 'reviews' :: 'Colens'' t b -> (t -> r) -> b -> r--- @--- reviews :: MonadReader b m => AReview t b -> (t -> r) -> m r reviews o f = asks $ withPrimReview o f {-# INLINE reviews #-}@@ -427,12 +363,6 @@ -- >>> evalState (reuse (from succ)) 5 -- 6 ----- @--- 'reuse' :: 'MonadState' a m => 'Iso'' s a   -> m s--- 'reuse' :: 'MonadState' a m => 'Prism'' s a -> m s--- 'reuse' :: 'MonadState' a m => 'Colens'' s a -> m s--- @--- reuse :: MonadState b m => AReview t b -> m t reuse o = gets (unTagged #. o .# Tagged) {-# INLINE reuse #-}@@ -452,12 +382,6 @@ -- -- >>> evalState (reuses left' isLeft) (5 :: Int) -- True------ @--- 'reuses' :: 'MonadState' a m => 'Iso'' s a   -> (s -> r) -> m r--- 'reuses' :: 'MonadState' a m => 'Prism'' s a -> (s -> r) -> m r--- 'reuses' :: 'MonadState' a m => 'Prism'' s a -> (s -> r) -> m r--- @ -- reuses :: MonadState b m => AReview t b -> (t -> r) -> m r reuses o tr = gets (tr . unTagged #. o .# Tagged)

@@ -9,8 +9,6 @@     curried   , swapped   , associated-  , first-  , second   , t21   , t22   , t31@@ -34,12 +32,6 @@ --------------------------------------------------------------------- -- Optics  -----------------------------------------------------------------------first :: Lens (a , c) (b , c) a b-first = first'--second :: Lens (c , a) (c , b) a b-second = second'  t21 :: Lens (a,b) (a',b) a a' t21 = lensVl $ \f ~(a,b) -> (\a' -> (a',b)) <$> f a

@@ -1,5 +1,8 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE NoImplicitPrelude #-}+ import Test.DocTest+import Prelude (IO)  main :: IO () main = doctest