Adds "monadic" lenses and prisms

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:
 

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)

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:

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
 

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)

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`:
 -- | 

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))

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)

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))

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