diff --git a/CHANGELOG.md b/CHANGELOG.md index 4e61d62..9a7494e 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: diff --git a/src/Data/Lens.purs b/src/Data/Lens.purs index 9ab486b..b6c06b4 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, lensFF, lensF', withLens, lensStore) +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, (%=), (%~), (&&=), (&&~), (*=), (*~), (+=), (+~), (-=), (-~), (.=), (.~), (//=), (//~), (<>=), (<>~), (?=), (?~), (||=), (||~)) 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, _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 e73af81..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, _2, 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, _Right, left, right) -import Data.Lens.Prism.Maybe (_Just, _Nothing) +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.purs b/src/Data/Lens/Lens.purs index 675193d..dd3cfcb 100644 --- a/src/Data/Lens/Lens.purs +++ b/src/Data/Lens/Lens.purs @@ -2,6 +2,9 @@ module Data.Lens.Lens ( lens , lens' + , lensF + , lensFF + , lensF' , withLens , cloneLens , ilens @@ -41,9 +44,18 @@ 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) + +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) +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/Lens/Tuple.purs b/src/Data/Lens/Lens/Tuple.purs index a7b9ded..16cc19f 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 + , _1F + , _2F , 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) -- | 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,13 @@ _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. +_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. +_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.purs b/src/Data/Lens/Prism.purs index 5f04a91..9462ec8 100644 --- a/src/Data/Lens/Prism.purs +++ b/src/Data/Lens/Prism.purs @@ -67,6 +67,7 @@ -- | ``` module Data.Lens.Prism ( prism', prism + , prismF, prismF', prismFF, prismFF' , only, nearly , review , is, isn't, matching @@ -78,6 +79,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 @@ -86,7 +88,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, traverse) +import Data.Traversable (class Traversable, sequence, traverse) -- | Create a `Prism` from a constructor and a matcher function that -- | produces an `Either`: @@ -104,6 +106,18 @@ import Data.Traversable (class Traversable, traverse) 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 = 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 = prismFF' 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 1c2cd87..5a4e0b1 100644 --- a/src/Data/Lens/Prism/Either.purs +++ b/src/Data/Lens/Prism/Either.purs @@ -1,11 +1,15 @@ module Data.Lens.Prism.Either ( _Left , _Right + , _LeftF + , _RightF , module Data.Profunctor.Choice ) where -import Data.Either (Either) -import Data.Lens.Prism (Prism) +import Prelude +import Data.Bifunctor (lmap) +import Data.Either (Either(..)) +import Data.Lens.Prism (Prism, prism) import Data.Profunctor.Choice (left, right) -- | Prism for the `Left` constructor of `Either`. @@ -15,3 +19,16 @@ _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 + +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 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 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 73abe3a..f069efb 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. +_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. +_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 0c09507..dee1b15 100644 --- a/src/Data/Lens/Record.purs +++ b/src/Data/Lens/Record.purs @@ -1,7 +1,6 @@ -module Data.Lens.Record (prop) where +module Data.Lens.Record (prop, propF) where import Prelude - import Data.Lens (Lens, lens) import Data.Symbol (class IsSymbol) import Prim.Row as Row @@ -26,3 +25,14 @@ prop => proxy l -> Lens (Record r1) (Record r2) a b prop l = lens (get l) (flip (set l)) + +-- | Like `prop`, but for monadic contexts +propF + :: forall l r1 r2 r a b proxy f + . IsSymbol l + => Row.Cons l a r r1 + => Row.Cons l b r r2 + => Functor f + => proxy l + -> Lens (Record r1) (f (Record r2)) a (f b) +propF l = lens (get l) (map <<< flip (set l)) diff --git a/src/Data/Lens/Traversal.purs b/src/Data/Lens/Traversal.purs index 0d6bbe2..d4958f3 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 @@ -36,12 +37,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.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.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. @@ -53,6 +56,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