Merge pull request #96 from LiamGoodacre/feature/sum-lens

Support inverse of `lens'`

Author: thomashoneyman

src/Data/Lens.purs

@@ -25,7 +25,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', withLens)
+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.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)

src/Data/Lens/Lens.purs

@@ -8,11 +8,13 @@ module Data.Lens.Lens
   , ilens'
   , withIndexedLens
   , cloneIndexedLens
+  , lensStore
   , module Data.Lens.Types
   ) where
 
 import Prelude
 
+import Control.Apply (lift2)
 import Data.Lens.Internal.Shop (Shop(..))
 import Data.Lens.Internal.Indexed (Indexed(..))
 import Data.Lens.Types
@@ -64,3 +66,23 @@ withIndexedLens l f = case l (Indexed (Shop identity \_ b -> b)) of Shop x y ->
 
 cloneIndexedLens :: forall i s t a b. AnIndexedLens i s t a b -> IndexedLens i s t a b
 cloneIndexedLens l = withIndexedLens l \x y p -> ilens x y p
+
+-- | Converts a lens into the form that `lens'` accepts.
+-- |
+-- | Can be useful when defining a lens where the focus appears under multiple
+-- | constructors of an algebraic data type.  This function would be called for
+-- | each case of the data type.
+-- |
+-- | For example:
+-- |
+-- | ```
+-- | data LensStoreExample = LensStoreA Int | LensStoreB (Tuple Boolean Int)
+-- |
+-- | lensStoreExampleInt :: Lens' LensStoreExample Int
+-- | lensStoreExampleInt = lens' case _ of
+-- |   LensStoreA i -> map LensStoreA <$> lensStore identity i
+-- |   LensStoreB i -> map LensStoreB <$> lensStore _2 i
+-- | ```
+lensStore :: forall s t a b . ALens s t a b -> s -> Tuple a (b -> t)
+lensStore l = withLens l (lift2 Tuple)
+

test/Main.purs

@@ -5,7 +5,7 @@ import Prelude
 import Control.Monad.State (evalState, get)
 import Data.Distributive (class Distributive)
 import Data.Either (Either(..))
-import Data.Lens (Getter', Prism', _1, _2, _Just, _Left, collectOf, lens, preview, prism', takeBoth, toArrayOf, traversed, view)
+import Data.Lens (Getter', Prism', _1, _2, _Just, _Left, collectOf, lens, lens', preview, prism', takeBoth, toArrayOf, traversed, view, lensStore)
 import Data.Lens.Fold ((^?))
 import Data.Lens.Fold.Partial ((^?!), (^@?!))
 import Data.Lens.Grate (Grate, cloneGrate, grate, zipWithOf)
@@ -121,6 +121,14 @@ cloneTraversalTest =
       wrapper = { traversal: t }
   in preview (cloneTraversal wrapper.traversal) [ 0, 1, 2 ]
 
+-- lensStore example
+data LensStoreExample = LensStoreA Int | LensStoreB (Tuple Boolean Int)
+
+lensStoreExampleInt :: Lens' LensStoreExample Int
+lensStoreExampleInt = lens' case _ of
+  LensStoreA i -> map LensStoreA <$> lensStore identity i
+  LensStoreB i -> map LensStoreB <$> lensStore _2 i
+
 main :: Effect Unit
 main = do
   logShow $ view bars doc