From 2e55819cf4c71fcb5766414fb87892a58e7db47b Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Mon, 22 Mar 2021 21:38:05 +0200 Subject: [PATCH 01/12] Adds "monadic" lenses and prisms --- src/Data/Lens/Lens/Tuple.purs | 22 ++++++++- src/Data/Lens/Prism/Either.purs | 13 +++++- src/Data/Lens/Prism/Maybe.purs | 10 ++++- src/Data/Lens/Traversal.purs | 79 ++++++++++++++++----------------- 4 files changed, 78 insertions(+), 46 deletions(-) diff --git a/src/Data/Lens/Lens/Tuple.purs b/src/Data/Lens/Lens/Tuple.purs index a7b9ded..baecb04 100644 --- a/src/Data/Lens/Lens/Tuple.purs +++ b/src/Data/Lens/Lens/Tuple.purs @@ -1,12 +1,16 @@ module Data.Lens.Lens.Tuple ( _1 , _2 + , _1M + , _2M , module Data.Profunctor.Strong ) where -import Data.Lens.Lens (Lens) +import Prelude +import Data.Lens.Lens (Lens, lens) import Data.Profunctor.Strong (first, second) -import Data.Tuple (Tuple) +import Data.Tuple (Tuple, fst, snd) +import Data.Tuple.Nested ((/\)) -- | Lens for the first component of a `Tuple`. _1 :: forall a b c. Lens (Tuple a c) (Tuple b c) a b @@ -15,3 +19,17 @@ _1 = first -- | Lens for the second component of a `Tuple`. _2 :: forall a b c. Lens (Tuple c a) (Tuple c b) a b _2 = second + +-- | Lens for the first component of a `Tuple` in a monadic context. +_1M :: forall a b c m. Monad m => Lens (Tuple a c) (m (Tuple b c)) a (m b) +_1M = + lens fst \(_ /\ b) ma -> do + a <- ma + pure $ a /\ b + +-- | Lens for the second component of a `Tuple` in a monadic context. +_2M :: forall a b c m. Monad m => Lens (Tuple c a) (m (Tuple c b)) a (m b) +_2M = + lens snd \(a /\ _) mb -> do + b <- mb + pure $ a /\ b diff --git a/src/Data/Lens/Prism/Either.purs b/src/Data/Lens/Prism/Either.purs index 1c2cd87..5b771de 100644 --- a/src/Data/Lens/Prism/Either.purs +++ b/src/Data/Lens/Prism/Either.purs @@ -4,8 +4,9 @@ module Data.Lens.Prism.Either , module Data.Profunctor.Choice ) where -import Data.Either (Either) -import Data.Lens.Prism (Prism) +import Prelude +import Data.Either (Either(..), either) +import Data.Lens.Prism (Prism, prism) import Data.Profunctor.Choice (left, right) -- | Prism for the `Left` constructor of `Either`. @@ -15,3 +16,11 @@ _Left = left -- | Prism for the `Right` constructor of `Either`. _Right :: forall a b c. Prism (Either c a) (Either c b) a b _Right = right + +-- | Prism for the `Left` constructor of `Either` in a monadic context. +_LeftM :: forall a b c m. Monad m => Prism (Either a c) (m (Either b c)) a (m b) +_LeftM = prism (map Left) (either Right (Left <<< pure <<< Right)) + +-- | Prism for the `Right` constructor of `Either` in a monadic context. +_RightM :: forall a b c m. Monad m => Prism (Either c a) (m (Either c b)) a (m b) +_RightM = prism (map Right) (either (Left <<< pure <<< Left) Right) diff --git a/src/Data/Lens/Prism/Maybe.purs b/src/Data/Lens/Prism/Maybe.purs index 73abe3a..967bb12 100644 --- a/src/Data/Lens/Prism/Maybe.purs +++ b/src/Data/Lens/Prism/Maybe.purs @@ -1,10 +1,8 @@ module Data.Lens.Prism.Maybe where import Prelude - import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe) - import Data.Lens.Prism (Prism, prism) -- | Prism for the `Nothing` constructor of `Maybe`. @@ -14,3 +12,11 @@ _Nothing = prism (const Nothing) $ maybe (Right unit) (const $ Left Nothing) -- | Prism for the `Just` constructor of `Maybe`. _Just :: forall a b. Prism (Maybe a) (Maybe b) a b _Just = prism Just $ maybe (Left Nothing) Right + +-- | Prism for the `Nothing` constructor of `Maybe` in a monadic context. +_NothingM :: forall a b m. Monad m => Prism (Maybe a) (m (Maybe b)) Unit (m Unit) +_NothingM = prism (const $ pure Nothing) (maybe (Right unit) (const $ Left $ pure Nothing)) + +-- | Prism for the `Just` constructor of `Maybe` in a monadic context. +_JustM :: forall a b m. Monad m => Prism (Maybe a) (m (Maybe b)) a (m b) +_JustM = prism (map Just) (maybe (Left $ pure Nothing) Right) diff --git a/src/Data/Lens/Traversal.purs b/src/Data/Lens/Traversal.purs index 888b6d9..e59a0e0 100644 --- a/src/Data/Lens/Traversal.purs +++ b/src/Data/Lens/Traversal.purs @@ -16,7 +16,6 @@ -- | ``` -- | -- | Many of the functions you'll use are documented in `Data.Lens.Fold`. - module Data.Lens.Traversal ( traversed , element @@ -30,7 +29,6 @@ module Data.Lens.Traversal ) where import Prelude - import Control.Alternative (class Alternative) import Control.Plus (empty) import Data.Lens.Indexed (iwander, positions, unIndex) @@ -53,8 +51,8 @@ traversed :: forall t a b. Traversable t => Traversal (t a) (t b) a b traversed = wander traverse -- | Turn a pure profunctor `Traversal` into a `lens`-like `Traversal`. -traverseOf - :: forall f s t a b . Optic (Star f) s t a b -> (a -> f b) -> s -> f t +traverseOf :: + forall f s t a b. Optic (Star f) s t a b -> (a -> f b) -> s -> f t traverseOf = under Star -- | Sequence the foci of an optic, pulling out an "effect". @@ -81,21 +79,21 @@ traverseOf = under Star -- | [0.15556037108154985,0.28500369615270515] -- | unit -- | ``` -sequenceOf - :: forall f s t a . Optic (Star f) s t (f a) a -> s -> f t +sequenceOf :: + forall f s t a. Optic (Star f) s t (f a) a -> s -> f t sequenceOf t = traverseOf t identity -- | Tries to map over a `Traversal`; returns `empty` if the traversal did -- | not have any new focus. -failover - :: forall f s t a b - . Alternative f - => Optic (Star (Tuple (Disj Boolean))) s t a b - -> (a -> b) - -> s - -> f t +failover :: + forall f s t a b. + Alternative f => + Optic (Star (Tuple (Disj Boolean))) s t a b -> + (a -> b) -> + s -> + f t failover t f s = case unwrap (t $ Star $ Tuple (Disj true) <<< f) s of - Tuple (Disj true) x -> pure x + Tuple (Disj true) x -> pure x Tuple (Disj false) _ -> empty -- | Combine an index and a traversal to narrow the focus to a single @@ -108,40 +106,41 @@ failover t f s = case unwrap (t $ Star $ Tuple (Disj true) <<< f) s of -- | The resulting traversal is called an *affine traversal*, which -- | means that the traversal focuses on one or zero (if the index is out of range) -- | results. -element - :: forall p s t a - . Wander p - => Int - -> Traversal s t a a - -> Optic p s t a a +element :: + forall p s t a. + Wander p => + Int -> + Traversal s t a a -> + Optic p s t a a element n tr = unIndex $ elementsOf (positions tr) (_ == n) -- | Traverse elements of an `IndexedTraversal` whose index satisfy a predicate. -elementsOf - :: forall p i s t a - . Wander p - => IndexedTraversal i s t a a - -> (i -> Boolean) - -> IndexedOptic p i s t a a -elementsOf tr pr = iwander \f -> - unwrap $ tr $ Indexed $ Star $ \(Tuple i a) -> if pr i then f i a else pure a +elementsOf :: + forall p i s t a. + Wander p => + IndexedTraversal i s t a a -> + (i -> Boolean) -> + IndexedOptic p i s t a a +elementsOf tr pr = + iwander \f -> + unwrap $ tr $ Indexed $ Star $ \(Tuple i a) -> if pr i then f i a else pure a -- | Turn a pure profunctor `IndexedTraversal` into a `lens`-like `IndexedTraversal`. -itraverseOf - :: forall f i s t a b - . IndexedOptic (Star f) i s t a b - -> (i -> a -> f b) - -> s - -> f t +itraverseOf :: + forall f i s t a b. + IndexedOptic (Star f) i s t a b -> + (i -> a -> f b) -> + s -> + f t itraverseOf t = under Star (t <<< Indexed) <<< uncurry -- | Flipped version of `itraverseOf`. -iforOf - :: forall f i s t a b - . IndexedOptic (Star f) i s t a b - -> s - -> (i -> a -> f b) - -> f t +iforOf :: + forall f i s t a b. + IndexedOptic (Star f) i s t a b -> + s -> + (i -> a -> f b) -> + f t iforOf = flip <<< itraverseOf cloneTraversal :: forall s t a b. ATraversal s t a b -> Traversal s t a b From 8f629eccac6c1938311d1e5ef7470dbd289ca73e Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Mon, 22 Mar 2021 23:20:54 +0200 Subject: [PATCH 02/12] Adds traversedM --- src/Data/Lens/Record.purs | 31 +++++++++++++++++++++++-------- src/Data/Lens/Traversal.purs | 10 ++++++++-- 2 files changed, 31 insertions(+), 10 deletions(-) diff --git a/src/Data/Lens/Record.purs b/src/Data/Lens/Record.purs index 0c09507..2886ce0 100644 --- a/src/Data/Lens/Record.purs +++ b/src/Data/Lens/Record.purs @@ -1,7 +1,6 @@ module Data.Lens.Record (prop) where import Prelude - import Data.Lens (Lens, lens) import Data.Symbol (class IsSymbol) import Prim.Row as Row @@ -18,11 +17,27 @@ import Record (get, set) -- | prop (Proxy :: Proxy "foo") -- | :: forall a b r. Lens { foo :: a | r } { foo :: b | r } a b -- | ``` -prop - :: forall l r1 r2 r a b proxy - . IsSymbol l - => Row.Cons l a r r1 - => Row.Cons l b r r2 - => proxy l - -> Lens (Record r1) (Record r2) a b +prop :: + forall l r1 r2 r a b proxy. + IsSymbol l => + Row.Cons l a r r1 => + Row.Cons l b r r2 => + proxy l -> + Lens (Record r1) (Record r2) a b prop l = lens (get l) (flip (set l)) + +-- | Like `prop`, but for monadic contexts +propM :: + forall l r1 r2 r a b proxy m. + IsSymbol l => + Row.Cons l a r r1 => + Row.Cons l b r r2 => + Monad m => + proxy l -> + Lens (Record r1) (m (Record r2)) a (m b) +propM l = + lens (get l) + ( \s mb -> do + b <- mb + pure $ set l b s + ) diff --git a/src/Data/Lens/Traversal.purs b/src/Data/Lens/Traversal.purs index e59a0e0..2b81004 100644 --- a/src/Data/Lens/Traversal.purs +++ b/src/Data/Lens/Traversal.purs @@ -33,12 +33,14 @@ import Control.Alternative (class Alternative) import Control.Plus (empty) import Data.Lens.Indexed (iwander, positions, unIndex) import Data.Lens.Internal.Bazaar (Bazaar(..), runBazaar) -import Data.Lens.Types (ATraversal, IndexedTraversal, IndexedOptic, Indexed(..), Traversal, Optic, class Wander, wander) +import Data.Lens.Lens (lens') import Data.Lens.Types (Traversal, Traversal') as ExportTypes +import Data.Lens.Types (class Wander, ATraversal, Indexed(..), IndexedOptic, IndexedTraversal, Traversal, Optic, wander) import Data.Monoid.Disj (Disj(..)) import Data.Newtype (under, unwrap) import Data.Profunctor.Star (Star(..)) -import Data.Traversable (class Traversable, traverse) +import Data.Profunctor.Strong (class Strong) +import Data.Traversable (class Traversable, sequence, traverse) import Data.Tuple (Tuple(..), uncurry) -- | A `Traversal` for the elements of a `Traversable` functor. @@ -50,6 +52,10 @@ import Data.Tuple (Tuple(..), uncurry) traversed :: forall t a b. Traversable t => Traversal (t a) (t b) a b traversed = wander traverse +-- Like `traversed`, but for monadic output. +traversedM :: forall t a b m p. Traversable t => Wander p => Strong p => Monad m => Optic p (t a) (m (t b)) a (m b) +traversedM = lens' (flip Tuple sequence) <<< traversed + -- | Turn a pure profunctor `Traversal` into a `lens`-like `Traversal`. traverseOf :: forall f s t a b. Optic (Star f) s t a b -> (a -> f b) -> s -> f t From 3c88ee7657f04018b495b779baae2d68a1109803 Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Mon, 22 Mar 2021 23:23:53 +0200 Subject: [PATCH 03/12] Changes formatting to previous style --- src/Data/Lens/Traversal.purs | 81 ++++++++++++++++++------------------ 1 file changed, 41 insertions(+), 40 deletions(-) diff --git a/src/Data/Lens/Traversal.purs b/src/Data/Lens/Traversal.purs index 2b81004..3f1bd02 100644 --- a/src/Data/Lens/Traversal.purs +++ b/src/Data/Lens/Traversal.purs @@ -16,6 +16,7 @@ -- | ``` -- | -- | Many of the functions you'll use are documented in `Data.Lens.Fold`. + module Data.Lens.Traversal ( traversed , element @@ -29,13 +30,14 @@ module Data.Lens.Traversal ) where import Prelude + import Control.Alternative (class Alternative) import Control.Plus (empty) import Data.Lens.Indexed (iwander, positions, unIndex) import Data.Lens.Internal.Bazaar (Bazaar(..), runBazaar) import Data.Lens.Lens (lens') +import Data.Lens.Types (ATraversal, IndexedTraversal, IndexedOptic, Indexed(..), Traversal, Optic, class Wander, wander) import Data.Lens.Types (Traversal, Traversal') as ExportTypes -import Data.Lens.Types (class Wander, ATraversal, Indexed(..), IndexedOptic, IndexedTraversal, Traversal, Optic, wander) import Data.Monoid.Disj (Disj(..)) import Data.Newtype (under, unwrap) import Data.Profunctor.Star (Star(..)) @@ -57,8 +59,8 @@ traversedM :: forall t a b m p. Traversable t => Wander p => Strong p => Monad m traversedM = lens' (flip Tuple sequence) <<< traversed -- | Turn a pure profunctor `Traversal` into a `lens`-like `Traversal`. -traverseOf :: - forall f s t a b. Optic (Star f) s t a b -> (a -> f b) -> s -> f t +traverseOf + :: forall f s t a b . Optic (Star f) s t a b -> (a -> f b) -> s -> f t traverseOf = under Star -- | Sequence the foci of an optic, pulling out an "effect". @@ -85,21 +87,21 @@ traverseOf = under Star -- | [0.15556037108154985,0.28500369615270515] -- | unit -- | ``` -sequenceOf :: - forall f s t a. Optic (Star f) s t (f a) a -> s -> f t +sequenceOf + :: forall f s t a . Optic (Star f) s t (f a) a -> s -> f t sequenceOf t = traverseOf t identity -- | Tries to map over a `Traversal`; returns `empty` if the traversal did -- | not have any new focus. -failover :: - forall f s t a b. - Alternative f => - Optic (Star (Tuple (Disj Boolean))) s t a b -> - (a -> b) -> - s -> - f t +failover + :: forall f s t a b + . Alternative f + => Optic (Star (Tuple (Disj Boolean))) s t a b + -> (a -> b) + -> s + -> f t failover t f s = case unwrap (t $ Star $ Tuple (Disj true) <<< f) s of - Tuple (Disj true) x -> pure x + Tuple (Disj true) x -> pure x Tuple (Disj false) _ -> empty -- | Combine an index and a traversal to narrow the focus to a single @@ -112,41 +114,40 @@ failover t f s = case unwrap (t $ Star $ Tuple (Disj true) <<< f) s of -- | The resulting traversal is called an *affine traversal*, which -- | means that the traversal focuses on one or zero (if the index is out of range) -- | results. -element :: - forall p s t a. - Wander p => - Int -> - Traversal s t a a -> - Optic p s t a a +element + :: forall p s t a + . Wander p + => Int + -> Traversal s t a a + -> Optic p s t a a element n tr = unIndex $ elementsOf (positions tr) (_ == n) -- | Traverse elements of an `IndexedTraversal` whose index satisfy a predicate. -elementsOf :: - forall p i s t a. - Wander p => - IndexedTraversal i s t a a -> - (i -> Boolean) -> - IndexedOptic p i s t a a -elementsOf tr pr = - iwander \f -> - unwrap $ tr $ Indexed $ Star $ \(Tuple i a) -> if pr i then f i a else pure a +elementsOf + :: forall p i s t a + . Wander p + => IndexedTraversal i s t a a + -> (i -> Boolean) + -> IndexedOptic p i s t a a +elementsOf tr pr = iwander \f -> + unwrap $ tr $ Indexed $ Star $ \(Tuple i a) -> if pr i then f i a else pure a -- | Turn a pure profunctor `IndexedTraversal` into a `lens`-like `IndexedTraversal`. -itraverseOf :: - forall f i s t a b. - IndexedOptic (Star f) i s t a b -> - (i -> a -> f b) -> - s -> - f t +itraverseOf + :: forall f i s t a b + . IndexedOptic (Star f) i s t a b + -> (i -> a -> f b) + -> s + -> f t itraverseOf t = under Star (t <<< Indexed) <<< uncurry -- | Flipped version of `itraverseOf`. -iforOf :: - forall f i s t a b. - IndexedOptic (Star f) i s t a b -> - s -> - (i -> a -> f b) -> - f t +iforOf + :: forall f i s t a b + . IndexedOptic (Star f) i s t a b + -> s + -> (i -> a -> f b) + -> f t iforOf = flip <<< itraverseOf cloneTraversal :: forall s t a b. ATraversal s t a b -> Traversal s t a b From 0f5f6f39853eb33dffc97666d997869dc2780f31 Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Mon, 22 Mar 2021 23:25:20 +0200 Subject: [PATCH 04/12] Adds traversedM and propM --- src/Data/Lens/Record.purs | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/Data/Lens/Record.purs b/src/Data/Lens/Record.purs index 2886ce0..643b69f 100644 --- a/src/Data/Lens/Record.purs +++ b/src/Data/Lens/Record.purs @@ -17,24 +17,24 @@ import Record (get, set) -- | prop (Proxy :: Proxy "foo") -- | :: forall a b r. Lens { foo :: a | r } { foo :: b | r } a b -- | ``` -prop :: - forall l r1 r2 r a b proxy. - IsSymbol l => - Row.Cons l a r r1 => - Row.Cons l b r r2 => - proxy l -> - Lens (Record r1) (Record r2) a b +prop + :: forall l r1 r2 r a b proxy + . IsSymbol l + => Row.Cons l a r r1 + => Row.Cons l b r r2 + => proxy l + -> Lens (Record r1) (Record r2) a b prop l = lens (get l) (flip (set l)) -- | Like `prop`, but for monadic contexts -propM :: - forall l r1 r2 r a b proxy m. - IsSymbol l => - Row.Cons l a r r1 => - Row.Cons l b r r2 => - Monad m => - proxy l -> - Lens (Record r1) (m (Record r2)) a (m b) +propM + :: forall l r1 r2 r a b proxy m + . IsSymbol l + => Row.Cons l a r r1 + => Row.Cons l b r r2 + => Monad m + => proxy l + -> Lens (Record r1) (m (Record r2)) a (m b) propM l = lens (get l) ( \s mb -> do From 362adb591ece7611efde2e9fe6002a7db27d8cc9 Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Mon, 22 Mar 2021 23:27:30 +0200 Subject: [PATCH 05/12] Adds note to changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index a278136..01a797e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,7 @@ Notable changes to this project are documented in this file. The format is based Breaking changes: New features: +- Adds lenses, prisms and traversals for working with monads. (@mikesol) Bugfixes: From 87a9682d5cc2eb37433be305558cb25766ef889f Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Tue, 23 Mar 2021 07:06:50 +0200 Subject: [PATCH 06/12] Adds lensF, lensF' and prismF --- src/Data/Lens/Lens.purs | 6 ++++++ src/Data/Lens/Prism.purs | 3 +++ 2 files changed, 9 insertions(+) diff --git a/src/Data/Lens/Lens.purs b/src/Data/Lens/Lens.purs index 675193d..8788406 100644 --- a/src/Data/Lens/Lens.purs +++ b/src/Data/Lens/Lens.purs @@ -41,9 +41,15 @@ import Data.Newtype(un) lens :: forall s t a b. (s -> a) -> (s -> b -> t) -> Lens s t a b lens get set = lens' \s -> Tuple (get s) \b -> set s b +lensF :: forall s t a b f. Functor f => (s -> a) -> (s -> b -> t) -> Lens s (f t) a (f b) +lensF get = lens get <<< (compose map) + lens' :: forall s t a b. (s -> Tuple a (b -> t)) -> Lens s t a b lens' to pab = dimap to (\(Tuple b f) -> f b) (first pab) +lensF' :: forall s t a b f. Functor f => (s -> Tuple a (b -> t)) -> Lens s (f t) a (f b) +lensF' = lens' <<< ((map <<< map) map) + withLens :: forall s t a b r. ALens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r withLens l f = case l (Shop identity \_ b -> b) of Shop x y -> f x y diff --git a/src/Data/Lens/Prism.purs b/src/Data/Lens/Prism.purs index d237ff3..02ca889 100644 --- a/src/Data/Lens/Prism.purs +++ b/src/Data/Lens/Prism.purs @@ -103,6 +103,9 @@ import Data.Profunctor.Choice (right) prism :: forall s t a b. (b -> t) -> (s -> Either t a) -> Prism s t a b prism to fro pab = dimap fro (either identity identity) (right (rmap to pab)) +prismF :: forall s t a b f. Functor f => Applicative f => (b -> t) -> (s -> Either t a) -> Prism s (f t) a (f b) +prismF to = prism (map to) <<< compose (either (Left <<< pure) Right) + -- | Create a `Prism` from a constructor and a matcher function that -- | produces a `Maybe`: -- | From d3c000ab9f53a3ea42568e98def2cb4409e5702d Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Tue, 23 Mar 2021 07:26:17 +0200 Subject: [PATCH 07/12] Fixes imports --- src/Data/Lens.purs | 6 +++--- src/Data/Lens/Common.purs | 6 +++--- src/Data/Lens/Lens.purs | 2 ++ src/Data/Lens/Prism.purs | 2 +- src/Data/Lens/Prism/Either.purs | 2 ++ src/Data/Lens/Traversal.purs | 1 + 6 files changed, 12 insertions(+), 7 deletions(-) diff --git a/src/Data/Lens.purs b/src/Data/Lens.purs index 9ab486b..04c2153 100644 --- a/src/Data/Lens.purs +++ b/src/Data/Lens.purs @@ -25,11 +25,11 @@ module Data.Lens import Data.Lens.Iso (AnIso, AnIso', Iso, Iso', Optic, Exchange(..), Re(..), au, auf, cloneIso, non, curried, flipped, iso, re, uncurried, under, withIso) import Data.Lens.Grate (Grate, Grate', zipWithOf, zipFWithOf, collectOf) -import Data.Lens.Lens (ALens, ALens', Lens, Lens', cloneLens, lens, lens', withLens, lensStore) -import Data.Lens.Prism (APrism, APrism', Prism, Prism', Review, Review', clonePrism, is, isn't, matching, nearly, only, prism, prism', review, withPrism) +import Data.Lens.Lens (ALens, ALens', Lens, Lens', cloneLens, lens, lens', lensF, lensF', withLens, lensStore) +import Data.Lens.Prism (APrism, APrism', Prism, Prism', Review, Review', clonePrism, is, isn't, matching, nearly, only, prism, prism', prismF, review, withPrism) import Data.Lens.Traversal (Traversal, Traversal', element, elementsOf, failover, itraverseOf, sequenceOf, traverseOf, traversed) import Data.Lens.Types (class Wander, ALens, ALens', APrism, APrism', AnIso, AnIso', ATraversal, ATraversal', Fold, Fold', Getter, Getter', AGetter, AGetter', IndexedFold, IndexedFold', IndexedGetter, IndexedGetter', IndexedOptic, IndexedOptic', IndexedSetter, IndexedSetter', IndexedTraversal, IndexedTraversal', Iso, Iso', Lens, Lens', Optic, Optic', Prism, Prism', Review, Review', Setter, Setter', Traversal, Traversal', Exchange(..), Forget(..), Indexed(..), Market(..), Re(..), Shop(..), Tagged(..), wander) import Data.Lens.Setter (IndexedSetter, Setter, Setter', Indexed(..), addModifying, addOver, appendModifying, appendOver, assign, assignJust, conjModifying, conjOver, disjModifying, disjOver, divModifying, divOver, iover, modifying, mulModifying, mulOver, over, set, setJust, subModifying, subOver, (%=), (%~), (&&=), (&&~), (*=), (*~), (+=), (+~), (-=), (-~), (.=), (.~), (//=), (//~), (<>=), (<>~), (?=), (?~), (||=), (||~)) import Data.Lens.Getter (Fold, Getter, IndexedFold, IndexedGetter, Optic, Indexed(..), iuse, iview, to, takeBoth, use, view, viewOn, (^.), cloneGetter) import Data.Lens.Fold (Fold, Fold', allOf, andOf, anyOf, elemOf, filtered, findOf, firstOf, foldMapOf, foldOf, folded, foldlOf, foldrOf, has, hasn't, iallOf, ianyOf, ifoldMapOf, ifoldlOf, ifoldrOf, itoListOf, itraverseOf_, lastOf, lengthOf, maximumOf, minimumOf, notElemOf, orOf, preview, previewOn, productOf, replicated, sequenceOf_, sumOf, toArrayOf, toArrayOfOn, toListOf, toListOfOn, unfolded, (^..), (^?)) -import Data.Lens.Common (_1, _2, _Just, _Left, _Nothing, _Right, first, left, right, second, united) +import Data.Lens.Common (_1, _2, _1M, _2M, _Just, _JustM, _Left, _LeftM, _Nothing, _NothingM, _Right, _RightM, first, left, right, second, united) diff --git a/src/Data/Lens/Common.purs b/src/Data/Lens/Common.purs index e73af81..b0b9ae7 100644 --- a/src/Data/Lens/Common.purs +++ b/src/Data/Lens/Common.purs @@ -8,10 +8,10 @@ module Data.Lens.Common ) where import Data.Lens.Types (Optic') -import Data.Lens.Lens.Tuple (_1, _2, first, second) +import Data.Lens.Lens.Tuple (_1, _1M, _2, _2M, first, second) import Data.Lens.Lens.Unit (united) -import Data.Lens.Prism.Either (_Left, _Right, left, right) -import Data.Lens.Prism.Maybe (_Just, _Nothing) +import Data.Lens.Prism.Either (_Left, _LeftM, _Right, _RightM, left, right) +import Data.Lens.Prism.Maybe (_Just, _JustM, _Nothing, _NothingM) -- | This is useful for when you want to restrict the type of another optic. -- | For example, suppose you have the following declarations: diff --git a/src/Data/Lens/Lens.purs b/src/Data/Lens/Lens.purs index 8788406..4afceef 100644 --- a/src/Data/Lens/Lens.purs +++ b/src/Data/Lens/Lens.purs @@ -2,6 +2,8 @@ module Data.Lens.Lens ( lens , lens' + , lensF + , lensF' , withLens , cloneLens , ilens diff --git a/src/Data/Lens/Prism.purs b/src/Data/Lens/Prism.purs index 02ca889..1b36c46 100644 --- a/src/Data/Lens/Prism.purs +++ b/src/Data/Lens/Prism.purs @@ -67,7 +67,7 @@ -- | ``` module Data.Lens.Prism - ( prism', prism + ( prism', prism, prismF , only, nearly , review , is, isn't, matching diff --git a/src/Data/Lens/Prism/Either.purs b/src/Data/Lens/Prism/Either.purs index 5b771de..7bd7946 100644 --- a/src/Data/Lens/Prism/Either.purs +++ b/src/Data/Lens/Prism/Either.purs @@ -1,6 +1,8 @@ module Data.Lens.Prism.Either ( _Left , _Right + , _LeftM + , _RightM , module Data.Profunctor.Choice ) where diff --git a/src/Data/Lens/Traversal.purs b/src/Data/Lens/Traversal.purs index 3f1bd02..b376b5f 100644 --- a/src/Data/Lens/Traversal.purs +++ b/src/Data/Lens/Traversal.purs @@ -19,6 +19,7 @@ module Data.Lens.Traversal ( traversed + , traversedM , element , traverseOf , sequenceOf From ca52e79f85692ff24fc8532d75d03cb2982f08bb Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Tue, 23 Mar 2021 08:39:40 +0200 Subject: [PATCH 08/12] Uses lmap where possible --- src/Data/Lens/Prism.purs | 3 ++- src/Data/Lens/Prism/Either.purs | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Data/Lens/Prism.purs b/src/Data/Lens/Prism.purs index 1b36c46..7f2f58e 100644 --- a/src/Data/Lens/Prism.purs +++ b/src/Data/Lens/Prism.purs @@ -78,6 +78,7 @@ module Data.Lens.Prism import Prelude import Control.MonadPlus (guard) +import Data.Bifunctor (lmap) import Data.Either (Either(..), either) import Data.HeytingAlgebra (tt, ff) import Data.Lens.Types (Prism, Prism', APrism, APrism', Review, Review') as ExportTypes @@ -104,7 +105,7 @@ prism :: forall s t a b. (b -> t) -> (s -> Either t a) -> Prism s t a b prism to fro pab = dimap fro (either identity identity) (right (rmap to pab)) prismF :: forall s t a b f. Functor f => Applicative f => (b -> t) -> (s -> Either t a) -> Prism s (f t) a (f b) -prismF to = prism (map to) <<< compose (either (Left <<< pure) Right) +prismF to = prism (map to) <<< compose (lmap pure) -- | Create a `Prism` from a constructor and a matcher function that -- | produces a `Maybe`: diff --git a/src/Data/Lens/Prism/Either.purs b/src/Data/Lens/Prism/Either.purs index 7bd7946..a94d113 100644 --- a/src/Data/Lens/Prism/Either.purs +++ b/src/Data/Lens/Prism/Either.purs @@ -7,6 +7,7 @@ module Data.Lens.Prism.Either ) where import Prelude +import Data.Bifunctor (lmap) import Data.Either (Either(..), either) import Data.Lens.Prism (Prism, prism) import Data.Profunctor.Choice (left, right) @@ -25,4 +26,4 @@ _LeftM = prism (map Left) (either Right (Left <<< pure <<< Right)) -- | Prism for the `Right` constructor of `Either` in a monadic context. _RightM :: forall a b c m. Monad m => Prism (Either c a) (m (Either c b)) a (m b) -_RightM = prism (map Right) (either (Left <<< pure <<< Left) Right) +_RightM = prism (map Right) (lmap (pure <<< Left)) From 243e8d7b419ba47b4c1e684c65f4bf19287dfd02 Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Tue, 23 Mar 2021 08:46:52 +0200 Subject: [PATCH 09/12] Uses lmap where possible --- src/Data/Lens/Prism/Either.purs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Data/Lens/Prism/Either.purs b/src/Data/Lens/Prism/Either.purs index a94d113..2ff4c73 100644 --- a/src/Data/Lens/Prism/Either.purs +++ b/src/Data/Lens/Prism/Either.purs @@ -8,7 +8,7 @@ module Data.Lens.Prism.Either import Prelude import Data.Bifunctor (lmap) -import Data.Either (Either(..), either) +import Data.Either (Either(..)) import Data.Lens.Prism (Prism, prism) import Data.Profunctor.Choice (left, right) @@ -20,9 +20,14 @@ _Left = left _Right :: forall a b c. Prism (Either c a) (Either c b) a b _Right = right +swap :: forall a b. Either a b -> Either b a +swap = case _ of + Left a -> Right a + Right a -> Left a + -- | Prism for the `Left` constructor of `Either` in a monadic context. _LeftM :: forall a b c m. Monad m => Prism (Either a c) (m (Either b c)) a (m b) -_LeftM = prism (map Left) (either Right (Left <<< pure <<< Right)) +_LeftM = prism (map Left) (lmap (pure <<< Right) <<< swap) -- | Prism for the `Right` constructor of `Either` in a monadic context. _RightM :: forall a b c m. Monad m => Prism (Either c a) (m (Either c b)) a (m b) From ae31a294e322b07184a99ddfcd1d72a7ea878365 Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Tue, 23 Mar 2021 09:59:03 +0200 Subject: [PATCH 10/12] Weakens constraint to applicative and functor --- src/Data/Lens.purs | 2 +- src/Data/Lens/Common.purs | 6 +++--- src/Data/Lens/Lens/Tuple.purs | 24 ++++++++++-------------- src/Data/Lens/Prism/Either.purs | 16 ++++++++-------- src/Data/Lens/Prism/Maybe.purs | 8 ++++---- src/Data/Lens/Record.purs | 17 ++++++----------- 6 files changed, 32 insertions(+), 41 deletions(-) diff --git a/src/Data/Lens.purs b/src/Data/Lens.purs index 04c2153..6087544 100644 --- a/src/Data/Lens.purs +++ b/src/Data/Lens.purs @@ -32,4 +32,4 @@ import Data.Lens.Types (class Wander, ALens, ALens', APrism, APrism', AnIso, AnI import Data.Lens.Setter (IndexedSetter, Setter, Setter', Indexed(..), addModifying, addOver, appendModifying, appendOver, assign, assignJust, conjModifying, conjOver, disjModifying, disjOver, divModifying, divOver, iover, modifying, mulModifying, mulOver, over, set, setJust, subModifying, subOver, (%=), (%~), (&&=), (&&~), (*=), (*~), (+=), (+~), (-=), (-~), (.=), (.~), (//=), (//~), (<>=), (<>~), (?=), (?~), (||=), (||~)) import Data.Lens.Getter (Fold, Getter, IndexedFold, IndexedGetter, Optic, Indexed(..), iuse, iview, to, takeBoth, use, view, viewOn, (^.), cloneGetter) import Data.Lens.Fold (Fold, Fold', allOf, andOf, anyOf, elemOf, filtered, findOf, firstOf, foldMapOf, foldOf, folded, foldlOf, foldrOf, has, hasn't, iallOf, ianyOf, ifoldMapOf, ifoldlOf, ifoldrOf, itoListOf, itraverseOf_, lastOf, lengthOf, maximumOf, minimumOf, notElemOf, orOf, preview, previewOn, productOf, replicated, sequenceOf_, sumOf, toArrayOf, toArrayOfOn, toListOf, toListOfOn, unfolded, (^..), (^?)) -import Data.Lens.Common (_1, _2, _1M, _2M, _Just, _JustM, _Left, _LeftM, _Nothing, _NothingM, _Right, _RightM, first, left, right, second, united) +import Data.Lens.Common (_1, _2, _1F, _2F, _Just, _JustF, _Left, _LeftF, _Nothing, _NothingF, _Right, _RightF, first, left, right, second, united) diff --git a/src/Data/Lens/Common.purs b/src/Data/Lens/Common.purs index b0b9ae7..d2ecf4f 100644 --- a/src/Data/Lens/Common.purs +++ b/src/Data/Lens/Common.purs @@ -8,10 +8,10 @@ module Data.Lens.Common ) where import Data.Lens.Types (Optic') -import Data.Lens.Lens.Tuple (_1, _1M, _2, _2M, first, second) +import Data.Lens.Lens.Tuple (_1, _1F, _2, _2F, first, second) import Data.Lens.Lens.Unit (united) -import Data.Lens.Prism.Either (_Left, _LeftM, _Right, _RightM, left, right) -import Data.Lens.Prism.Maybe (_Just, _JustM, _Nothing, _NothingM) +import Data.Lens.Prism.Either (_Left, _LeftF, _Right, _RightF, left, right) +import Data.Lens.Prism.Maybe (_Just, _JustF, _Nothing, _NothingF) -- | This is useful for when you want to restrict the type of another optic. -- | For example, suppose you have the following declarations: diff --git a/src/Data/Lens/Lens/Tuple.purs b/src/Data/Lens/Lens/Tuple.purs index baecb04..16cc19f 100644 --- a/src/Data/Lens/Lens/Tuple.purs +++ b/src/Data/Lens/Lens/Tuple.purs @@ -1,16 +1,16 @@ module Data.Lens.Lens.Tuple ( _1 , _2 - , _1M - , _2M + , _1F + , _2F , module Data.Profunctor.Strong ) where import Prelude + import Data.Lens.Lens (Lens, lens) import Data.Profunctor.Strong (first, second) -import Data.Tuple (Tuple, fst, snd) -import Data.Tuple.Nested ((/\)) +import Data.Tuple (Tuple(..), fst, snd) -- | Lens for the first component of a `Tuple`. _1 :: forall a b c. Lens (Tuple a c) (Tuple b c) a b @@ -21,15 +21,11 @@ _2 :: forall a b c. Lens (Tuple c a) (Tuple c b) a b _2 = second -- | Lens for the first component of a `Tuple` in a monadic context. -_1M :: forall a b c m. Monad m => Lens (Tuple a c) (m (Tuple b c)) a (m b) -_1M = - lens fst \(_ /\ b) ma -> do - a <- ma - pure $ a /\ b +_1F :: forall a b c f. Functor f => Lens (Tuple a c) (f (Tuple b c)) a (f b) +_1F = + lens fst (map <<< flip Tuple <<< snd) -- | Lens for the second component of a `Tuple` in a monadic context. -_2M :: forall a b c m. Monad m => Lens (Tuple c a) (m (Tuple c b)) a (m b) -_2M = - lens snd \(a /\ _) mb -> do - b <- mb - pure $ a /\ b +_2F :: forall a b c f. Functor f => Lens (Tuple c a) (f (Tuple c b)) a (f b) +_2F = + lens snd (map <<< Tuple <<< fst) diff --git a/src/Data/Lens/Prism/Either.purs b/src/Data/Lens/Prism/Either.purs index 2ff4c73..5a4e0b1 100644 --- a/src/Data/Lens/Prism/Either.purs +++ b/src/Data/Lens/Prism/Either.purs @@ -1,8 +1,8 @@ module Data.Lens.Prism.Either ( _Left , _Right - , _LeftM - , _RightM + , _LeftF + , _RightF , module Data.Profunctor.Choice ) where @@ -25,10 +25,10 @@ swap = case _ of Left a -> Right a Right a -> Left a --- | Prism for the `Left` constructor of `Either` in a monadic context. -_LeftM :: forall a b c m. Monad m => Prism (Either a c) (m (Either b c)) a (m b) -_LeftM = prism (map Left) (lmap (pure <<< Right) <<< swap) +-- | Prism for the `Left` constructor of `Either` in an applicative context. +_LeftF :: forall a b c f. Functor f => Applicative f => Prism (Either a c) (f (Either b c)) a (f b) +_LeftF = prism (map Left) (lmap (pure <<< Right) <<< swap) --- | Prism for the `Right` constructor of `Either` in a monadic context. -_RightM :: forall a b c m. Monad m => Prism (Either c a) (m (Either c b)) a (m b) -_RightM = prism (map Right) (lmap (pure <<< Left)) +-- | Prism for the `Right` constructor of `Either` in an applicative context. +_RightF :: forall a b c f. Functor f => Applicative f => Prism (Either c a) (f (Either c b)) a (f b) +_RightF = prism (map Right) (lmap (pure <<< Left)) diff --git a/src/Data/Lens/Prism/Maybe.purs b/src/Data/Lens/Prism/Maybe.purs index 967bb12..f069efb 100644 --- a/src/Data/Lens/Prism/Maybe.purs +++ b/src/Data/Lens/Prism/Maybe.purs @@ -14,9 +14,9 @@ _Just :: forall a b. Prism (Maybe a) (Maybe b) a b _Just = prism Just $ maybe (Left Nothing) Right -- | Prism for the `Nothing` constructor of `Maybe` in a monadic context. -_NothingM :: forall a b m. Monad m => Prism (Maybe a) (m (Maybe b)) Unit (m Unit) -_NothingM = prism (const $ pure Nothing) (maybe (Right unit) (const $ Left $ pure Nothing)) +_NothingF :: forall a b f. Functor f => Applicative f => Prism (Maybe a) (f (Maybe b)) Unit (f Unit) +_NothingF = prism (const $ pure Nothing) (maybe (Right unit) (const $ Left $ pure Nothing)) -- | Prism for the `Just` constructor of `Maybe` in a monadic context. -_JustM :: forall a b m. Monad m => Prism (Maybe a) (m (Maybe b)) a (m b) -_JustM = prism (map Just) (maybe (Left $ pure Nothing) Right) +_JustF :: forall a b f. Functor f => Applicative f => Prism (Maybe a) (f (Maybe b)) a (f b) +_JustF = prism (map Just) (maybe (Left $ pure Nothing) Right) diff --git a/src/Data/Lens/Record.purs b/src/Data/Lens/Record.purs index 643b69f..dee1b15 100644 --- a/src/Data/Lens/Record.purs +++ b/src/Data/Lens/Record.purs @@ -1,4 +1,4 @@ -module Data.Lens.Record (prop) where +module Data.Lens.Record (prop, propF) where import Prelude import Data.Lens (Lens, lens) @@ -27,17 +27,12 @@ prop prop l = lens (get l) (flip (set l)) -- | Like `prop`, but for monadic contexts -propM - :: forall l r1 r2 r a b proxy m +propF + :: forall l r1 r2 r a b proxy f . IsSymbol l => Row.Cons l a r r1 => Row.Cons l b r r2 - => Monad m + => Functor f => proxy l - -> Lens (Record r1) (m (Record r2)) a (m b) -propM l = - lens (get l) - ( \s mb -> do - b <- mb - pure $ set l b s - ) + -> Lens (Record r1) (f (Record r2)) a (f b) +propF l = lens (get l) (map <<< flip (set l)) From feb1e85c8f20fab377c4f9c6b6782e9109465003 Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Wed, 24 Mar 2021 12:07:43 +0200 Subject: [PATCH 11/12] Adds FF variants --- src/Data/Lens.purs | 4 ++-- src/Data/Lens/Lens.purs | 4 ++++ src/Data/Lens/Prism.purs | 6 +++++- 3 files changed, 11 insertions(+), 3 deletions(-) diff --git a/src/Data/Lens.purs b/src/Data/Lens.purs index 6087544..3d9e3d0 100644 --- a/src/Data/Lens.purs +++ b/src/Data/Lens.purs @@ -25,8 +25,8 @@ module Data.Lens import Data.Lens.Iso (AnIso, AnIso', Iso, Iso', Optic, Exchange(..), Re(..), au, auf, cloneIso, non, curried, flipped, iso, re, uncurried, under, withIso) import Data.Lens.Grate (Grate, Grate', zipWithOf, zipFWithOf, collectOf) -import Data.Lens.Lens (ALens, ALens', Lens, Lens', cloneLens, lens, lens', lensF, lensF', withLens, lensStore) -import Data.Lens.Prism (APrism, APrism', Prism, Prism', Review, Review', clonePrism, is, isn't, matching, nearly, only, prism, prism', prismF, review, withPrism) +import Data.Lens.Lens (ALens, ALens', Lens, Lens', cloneLens, lens, lens', lensF, lensFF, lensF', withLens, lensStore) +import Data.Lens.Prism (APrism, APrism', Prism, Prism', Review, Review', clonePrism, is, isn't, matching, nearly, only, prism, prism', prismF, prismFF, review, withPrism) import Data.Lens.Traversal (Traversal, Traversal', element, elementsOf, failover, itraverseOf, sequenceOf, traverseOf, traversed) import Data.Lens.Types (class Wander, ALens, ALens', APrism, APrism', AnIso, AnIso', ATraversal, ATraversal', Fold, Fold', Getter, Getter', AGetter, AGetter', IndexedFold, IndexedFold', IndexedGetter, IndexedGetter', IndexedOptic, IndexedOptic', IndexedSetter, IndexedSetter', IndexedTraversal, IndexedTraversal', Iso, Iso', Lens, Lens', Optic, Optic', Prism, Prism', Review, Review', Setter, Setter', Traversal, Traversal', Exchange(..), Forget(..), Indexed(..), Market(..), Re(..), Shop(..), Tagged(..), wander) import Data.Lens.Setter (IndexedSetter, Setter, Setter', Indexed(..), addModifying, addOver, appendModifying, appendOver, assign, assignJust, conjModifying, conjOver, disjModifying, disjOver, divModifying, divOver, iover, modifying, mulModifying, mulOver, over, set, setJust, subModifying, subOver, (%=), (%~), (&&=), (&&~), (*=), (*~), (+=), (+~), (-=), (-~), (.=), (.~), (//=), (//~), (<>=), (<>~), (?=), (?~), (||=), (||~)) diff --git a/src/Data/Lens/Lens.purs b/src/Data/Lens/Lens.purs index 4afceef..dd3cfcb 100644 --- a/src/Data/Lens/Lens.purs +++ b/src/Data/Lens/Lens.purs @@ -3,6 +3,7 @@ module Data.Lens.Lens ( lens , lens' , lensF + , lensFF , lensF' , withLens , cloneLens @@ -46,6 +47,9 @@ lens get set = lens' \s -> Tuple (get s) \b -> set s b lensF :: forall s t a b f. Functor f => (s -> a) -> (s -> b -> t) -> Lens s (f t) a (f b) lensF get = lens get <<< (compose map) +lensFF :: forall s t a b f. Functor f => Apply f => (s -> a) -> (s -> b -> t) -> Lens (f s) (f t) (f a) (f b) +lensFF get = lens (map get) <<< compose apply <<< map + lens' :: forall s t a b. (s -> Tuple a (b -> t)) -> Lens s t a b lens' to pab = dimap to (\(Tuple b f) -> f b) (first pab) diff --git a/src/Data/Lens/Prism.purs b/src/Data/Lens/Prism.purs index 7f2f58e..75035bc 100644 --- a/src/Data/Lens/Prism.purs +++ b/src/Data/Lens/Prism.purs @@ -67,7 +67,7 @@ -- | ``` module Data.Lens.Prism - ( prism', prism, prismF + ( prism', prism, prismF, prismFF , only, nearly , review , is, isn't, matching @@ -87,6 +87,7 @@ import Data.Maybe (Maybe, maybe) import Data.Newtype (under) import Data.Profunctor (dimap, rmap) import Data.Profunctor.Choice (right) +import Data.Traversable (class Traversable, sequence) -- | Create a `Prism` from a constructor and a matcher function that -- | produces an `Either`: @@ -107,6 +108,9 @@ prism to fro pab = dimap fro (either identity identity) (right (rmap to pab)) prismF :: forall s t a b f. Functor f => Applicative f => (b -> t) -> (s -> Either t a) -> Prism s (f t) a (f b) prismF to = prism (map to) <<< compose (lmap pure) +prismFF :: forall s t a b f. Functor f => Applicative f => Traversable f => (b -> t) -> (s -> Either t a) -> Prism (f s) (f t) (f a) (f b) +prismFF to = prism (map to) <<< (compose (lmap pure <<< sequence) <<< map) + -- | Create a `Prism` from a constructor and a matcher function that -- | produces a `Maybe`: -- | From 4b84b15ebb7152b7415c93aeb211dd97a9d6fa2d Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Wed, 24 Mar 2021 14:37:41 +0200 Subject: [PATCH 12/12] Weakens applicative constraint on prismF' and uses it to build prismF --- src/Data/Lens.purs | 2 +- src/Data/Lens/Prism.purs | 13 ++++++++++--- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/Data/Lens.purs b/src/Data/Lens.purs index 3d9e3d0..b6c06b4 100644 --- a/src/Data/Lens.purs +++ b/src/Data/Lens.purs @@ -26,7 +26,7 @@ module Data.Lens import Data.Lens.Iso (AnIso, AnIso', Iso, Iso', Optic, Exchange(..), Re(..), au, auf, cloneIso, non, curried, flipped, iso, re, uncurried, under, withIso) import Data.Lens.Grate (Grate, Grate', zipWithOf, zipFWithOf, collectOf) import Data.Lens.Lens (ALens, ALens', Lens, Lens', cloneLens, lens, lens', lensF, lensFF, lensF', withLens, lensStore) -import Data.Lens.Prism (APrism, APrism', Prism, Prism', Review, Review', clonePrism, is, isn't, matching, nearly, only, prism, prism', prismF, prismFF, review, withPrism) +import Data.Lens.Prism (APrism, APrism', Prism, Prism', Review, Review', clonePrism, is, isn't, matching, nearly, only, prism, prism', prismF, prismF', prismFF, prismFF', review, withPrism) import Data.Lens.Traversal (Traversal, Traversal', element, elementsOf, failover, itraverseOf, sequenceOf, traverseOf, traversed) import Data.Lens.Types (class Wander, ALens, ALens', APrism, APrism', AnIso, AnIso', ATraversal, ATraversal', Fold, Fold', Getter, Getter', AGetter, AGetter', IndexedFold, IndexedFold', IndexedGetter, IndexedGetter', IndexedOptic, IndexedOptic', IndexedSetter, IndexedSetter', IndexedTraversal, IndexedTraversal', Iso, Iso', Lens, Lens', Optic, Optic', Prism, Prism', Review, Review', Setter, Setter', Traversal, Traversal', Exchange(..), Forget(..), Indexed(..), Market(..), Re(..), Shop(..), Tagged(..), wander) import Data.Lens.Setter (IndexedSetter, Setter, Setter', Indexed(..), addModifying, addOver, appendModifying, appendOver, assign, assignJust, conjModifying, conjOver, disjModifying, disjOver, divModifying, divOver, iover, modifying, mulModifying, mulOver, over, set, setJust, subModifying, subOver, (%=), (%~), (&&=), (&&~), (*=), (*~), (+=), (+~), (-=), (-~), (.=), (.~), (//=), (//~), (<>=), (<>~), (?=), (?~), (||=), (||~)) diff --git a/src/Data/Lens/Prism.purs b/src/Data/Lens/Prism.purs index 75035bc..4ffd1e2 100644 --- a/src/Data/Lens/Prism.purs +++ b/src/Data/Lens/Prism.purs @@ -67,7 +67,8 @@ -- | ``` module Data.Lens.Prism - ( prism', prism, prismF, prismFF + ( prism', prism + , prismF, prismF', prismFF, prismFF' , only, nearly , review , is, isn't, matching @@ -105,11 +106,17 @@ import Data.Traversable (class Traversable, sequence) prism :: forall s t a b. (b -> t) -> (s -> Either t a) -> Prism s t a b prism to fro pab = dimap fro (either identity identity) (right (rmap to pab)) +prismF' :: forall s t a b f. Functor f => (t -> f t) -> (b -> t) -> (s -> Either t a) -> Prism s (f t) a (f b) +prismF' pure' to = prism (map to) <<< compose (lmap pure') + prismF :: forall s t a b f. Functor f => Applicative f => (b -> t) -> (s -> Either t a) -> Prism s (f t) a (f b) -prismF to = prism (map to) <<< compose (lmap pure) +prismF = prismF' pure + +prismFF' :: forall s t a b f. Functor f => Traversable f => (t -> f t) -> (b -> t) -> (s -> Either t a) -> Prism (f s) (f t) (f a) (f b) +prismFF' pure' to = prism (map to) <<< (compose (lmap pure' <<< sequence) <<< map) prismFF :: forall s t a b f. Functor f => Applicative f => Traversable f => (b -> t) -> (s -> Either t a) -> Prism (f s) (f t) (f a) (f b) -prismFF to = prism (map to) <<< (compose (lmap pure <<< sequence) <<< map) +prismFF = prismFF' pure -- | Create a `Prism` from a constructor and a matcher function that -- | produces a `Maybe`: