Make Getter compose and define AGetter/cloneGetter

Author: LiamGoodacre

src/Data/Lens.purs

@@ -28,8 +28,8 @@ import Data.Lens.Grate (Grate, Grate', zipWithOf, zipFWithOf, collectOf)
 import Data.Lens.Lens (ALens, ALens', Lens, Lens', cloneLens, lens, lens', withLens)
 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', Fold, Fold', Getter, Getter', 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.Types (class Wander, ALens, ALens', APrism, APrism', AnIso, AnIso', 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, (^.))
+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, toListOf, toListOfOn, unfolded, (^..), (^?))
 import Data.Lens.Common (_1, _2, _Just, _Left, _Nothing, _Right, first, left, right, second, united)

src/Data/Lens/Getter.purs

@@ -2,42 +2,43 @@
 module Data.Lens.Getter
   ( (^.), viewOn
   , view, to, takeBoth, use, iview, iuse
+  , cloneGetter
   , module Data.Lens.Types
   ) where
 
 import Prelude
 
 import Control.Monad.State.Class (class MonadState, gets)
 import Data.Lens.Internal.Forget (Forget(..))
-import Data.Lens.Types (Getter, Fold, Optic, IndexedGetter, Indexed(..), IndexedFold)
+import Data.Lens.Types (Getter, AGetter, Fold, Optic, IndexedGetter, Indexed(..), IndexedFold)
 import Data.Newtype (unwrap)
 import Data.Profunctor.Strong ((&&&))
 import Data.Tuple (Tuple)
 
 infixl 8 viewOn as ^.
 
 -- | View the focus of a `Getter`.
-view :: forall s t a b. Getter s t a b -> s -> a
+view :: forall s t a b. AGetter s t a b -> s -> a
 view l = unwrap (l (Forget identity))
 
 -- | View the focus of a `Getter` and its index.
 iview :: forall i s t a b. IndexedFold (Tuple i a) i s t a b -> s -> Tuple i a
 iview l = unwrap (l (Indexed $ Forget identity))
 
 -- | Synonym for `view`, flipped.
-viewOn :: forall s t a b. s -> Getter s t a b -> a
+viewOn :: forall s t a b. s -> AGetter s t a b -> a
 viewOn s l = view l s
 
 -- | Convert a function into a getter.
-to :: forall r s t a b. (s -> a) -> Fold r s t a b
+to :: forall s t a b. (s -> a) -> Getter s t a b
 to f p = Forget (unwrap p <<< f)
 
+cloneGetter :: forall s t a b. AGetter s t a b -> Getter s t a b
+cloneGetter g = to (view g)
+
 -- | Combine two getters.
-takeBoth :: forall s t a b c d. Getter s t a b -> Getter s t c d -> Getter s t (Tuple a c) (Tuple b d)
-takeBoth l r a = cmps (l (Forget identity)) (r (Forget identity))
-  where
-    cmps :: Forget a s t -> Forget c s t -> Forget (Tuple a c) s t
-    cmps (Forget f) (Forget g) = Forget (f &&& g)
+takeBoth :: forall s t a b c d. AGetter s t a b -> AGetter s t c d -> Getter s t (Tuple a c) (Tuple b d)
+takeBoth l r = to (view l &&& view r)
 
 -- | View the focus of a `Getter` in the state of a monad.
 use :: forall s t a b m. MonadState s m => Getter s t a b -> m a

src/Data/Lens/Types.purs

@@ -119,9 +119,12 @@ type AGrate s t a b = Optic (Grating a b) s t a b
 type AGrate' s a = AGrate s s a a
 
 -- | A getter.
-type Getter s t a b = Fold a s t a b
+type Getter s t a b = forall r. Fold r s t a b
 type Getter' s a = Getter s s a a
 
+type AGetter s t a b = Fold a s t a b
+type AGetter' s a = AGetter s s a a
+
 -- | A setter.
 type Setter s t a b = Optic Function s t a b
 type Setter' s a = Setter s s a a

test/Main.purs

@@ -32,6 +32,16 @@ bar = prop (SProxy :: SProxy "bar")
 barAndFoo :: forall a b r. Getter' { bar :: a, foo :: b | r } (Tuple a b)
 barAndFoo = takeBoth bar foo
 
+fooGetter :: forall x. Getter' { foo :: x } x
+fooGetter = foo
+
+barGetter :: forall x. Getter' { bar :: x } x
+barGetter = bar
+
+-- check we can compose getters
+fooBarGetter :: forall x. Getter' { foo :: { bar :: x } } x
+fooBarGetter = foo <<< bar
+
 type Foo a = { foo :: Maybe { bar :: Array a } }
 
 doc :: Foo String