re function that reverses (at least) Isos and

`Prism`s.

Author: zrho

bower.json

@@ -23,6 +23,6 @@
     "purescript-profunctor": "~0.3.0",
     "purescript-sets": "~0.5.1",
     "purescript-unsafe-coerce": "~0.1.0",
-    "purescript-transformers": "~0.7.1"
+    "purescript-transformers": "~0.8.1"
   }
 }

src/Data/Lens/Fold.purs

@@ -12,7 +12,6 @@ import Prelude
 
 import Control.Apply ((*>))
 
-import Data.Const (Const(..), getConst)
 import Data.Either (Either(..), either)
 import Data.Foldable (Foldable, foldr)
 import Data.Functor.Contravariant (Contravariant)
@@ -32,6 +31,7 @@ import Data.Profunctor.Star (Star(..), runStar)
 import Data.Tuple (Tuple(..))
 
 import Data.Lens.Internal.Void (coerce)
+import Data.Lens.Internal.Forget (Forget (..), runForget)
 import Data.Lens.Types (Fold(), FoldP()) as ExportTypes
 import Data.Lens.Types (Optic(), OpticP(), Fold())
 
@@ -48,11 +48,11 @@ preview p = runFirst <<< foldMapOf p (First <<< Just)
 
 -- | Folds all foci of a `Fold` to one. Note that this is the same as `view`.
 foldOf :: forall s t a b. Fold a s t a b -> s -> a
-foldOf p = getConst <<< runStar (p (Star Const))
+foldOf p = runForget (p (Forget id))
 
 -- | Maps and then folds all foci of a `Fold`.
 foldMapOf :: forall s t a b r. Fold r s t a b -> (a -> r) -> s -> r
-foldMapOf p f = getConst <<< runStar (p (Star (Const <<< f)))
+foldMapOf p f = runForget (p (Forget f))
 
 -- | Right fold over a `Fold`.
 foldrOf :: forall s t a b r. Fold (Endo r) s t a b -> (a -> r -> r) -> r -> s -> r

src/Data/Lens/Getter.purs

@@ -6,20 +6,21 @@ module Data.Lens.Getter
   , module Data.Lens.Types
   ) where
 
-import Prelude ((<<<))
+import Prelude (id, (<<<))
 
 import Data.Const (Const(..), getConst)
 import Data.Functor.Contravariant (Contravariant, cmap)
 import Data.Profunctor.Star (Star(..), runStar)
 import Control.Monad.State.Class (MonadState, gets)
 
+import Data.Lens.Internal.Forget (Forget (..), runForget)
 import Data.Lens.Types (Getter(), Optic())
 
 infixl 8 ^.
 
 -- | View the focus of a `Getter`.
 view :: forall s t a b. Getter s t a b -> s -> a
-view l s = getConst (runStar (l (Star Const)) s)
+view l = runForget (l (Forget id))
 
 -- | Synonym for `view`, flipped.
 (^.) :: forall s t a b. s -> Getter s t a b -> a

src/Data/Lens/Internal/Forget.purs

@@ -0,0 +1,46 @@
+module Data.Lens.Internal.Forget where
+
+import Prelude
+
+import Data.Tuple (Tuple (..), fst, snd)
+import Data.Either (Either (..), either)
+import Data.Monoid (Monoid, mempty)
+import Data.Const (Const (..), getConst)
+import Data.Profunctor (Profunctor)
+import Data.Profunctor.Strong (Strong)
+import Data.Profunctor.Choice (Choice)
+import Data.Profunctor.Cochoice (Cochoice)
+
+import Data.Lens.Internal.Wander (Wander)
+
+-- | Profunctor that forgets the `b` value and returns (and accumulates) a
+-- | value of type `r`.
+-- |
+-- | `Forget r` is isomorphic to `Star (Const r)`, but can be given a `Cochoice`
+-- | instance.
+newtype Forget r a b = Forget (a -> r)
+
+-- | Unwrap a value of type `Forget`.
+runForget :: forall r a b. Forget r a b -> a -> r
+runForget (Forget z) = z
+
+instance profunctorForget :: Profunctor (Forget r) where
+  dimap f _ (Forget z) = Forget (z <<< f)
+
+instance choiceForget :: (Monoid r) => Choice (Forget r) where
+  left  (Forget z) = Forget (either z mempty)
+  right (Forget z) = Forget (either mempty z)
+
+instance strongForget :: Strong (Forget r) where
+  first  (Forget z) = Forget (z <<< fst)
+  second (Forget z) = Forget (z <<< snd)
+
+instance cochoiceForget :: Cochoice (Forget r) where
+  unleft  (Forget z) = Forget (z <<< Left)
+  unright (Forget z) = Forget (z <<< Right)
+
+instance wanderForget :: (Monoid r) => Wander (Forget r) where
+  wander f (Forget r) = Forget \s -> getConst (f (Const <<< r) s)
+
+-- forall s t a b. (forall f. (Applicative f) => (a -> f b) -> s -> f t)
+-- -> p a b -> p s t

src/Data/Lens/Internal/Re.purs

@@ -0,0 +1,36 @@
+-- | This module defines the `Re` profunctor
+
+module Data.Lens.Internal.Re where
+
+import Prelude
+
+import Data.Profunctor
+import Data.Profunctor.Strong
+import Data.Profunctor.Choice
+import Data.Profunctor.Cochoice
+import Data.Profunctor.Costrong
+
+--
+newtype Re p s t a b = Re (p b a -> p t s)
+
+runRe :: forall p s t a b. Re p s t a b -> p b a -> p t s
+runRe (Re r) = r
+
+instance profunctorRe :: (Profunctor p) => Profunctor (Re p s t) where
+  dimap f g (Re r) = Re (r <<< dimap g f)
+
+instance choiceRe :: (Choice p) => Cochoice (Re p s t) where
+  unleft (Re r) = Re (r <<< left)
+  unright (Re r) = Re (r <<< right)
+
+instance cochoiceRe :: (Cochoice p) => Choice (Re p s t) where
+  left (Re r) = Re (r <<< unleft)
+  right (Re r) = Re (r <<< unright)
+
+instance strongRe :: (Strong p) => Costrong (Re p s t) where
+  unfirst (Re r) = Re (r <<< first)
+  unsecond (Re r) = Re (r <<< second)
+
+instance costrongRe :: (Costrong p) => Strong (Re p s t) where
+  first (Re r) = Re (r <<< unfirst)
+  second (Re r) = Re (r <<< unsecond)

src/Data/Lens/Internal/Tagged.purs

@@ -4,7 +4,9 @@ module Data.Lens.Internal.Tagged where
 
 import Data.Profunctor (Profunctor)
 import Data.Profunctor.Choice (Choice)
+import Data.Profunctor.Costrong (Costrong)
 import Data.Either (Either(..))
+import Data.Tuple (Tuple(..))
 
 newtype Tagged a b = Tagged b
 
@@ -15,5 +17,9 @@ instance taggedChoice :: Choice Tagged where
   left  (Tagged x) = Tagged (Left x)
   right (Tagged x) = Tagged (Right x)
 
+instance taggedCostrong :: Costrong Tagged where
+  unfirst (Tagged (Tuple b _)) = Tagged b
+  unsecond (Tagged (Tuple _ c)) = Tagged c
+
 unTagged :: forall a b. Tagged a b -> b
 unTagged (Tagged x) = x

src/Data/Lens/Iso.purs

@@ -1,7 +1,7 @@
 -- | This module defines functions for working with isomorphisms.
 
 module Data.Lens.Iso
-  ( iso, withIso, cloneIso, au, auf, under, curried, uncurried, flipped
+  ( iso, withIso, cloneIso, re, au, auf, under, curried, uncurried, flipped
   , module Data.Lens.Types
   ) where
 
@@ -10,7 +10,7 @@ import Prelude ((<<<), flip, id)
 import Data.Profunctor (Profunctor, dimap, rmap)
 import Data.Tuple (Tuple(), curry, uncurry)
 
-import Data.Lens.Types (Iso(), IsoP(), AnIso(), AnIsoP(), Exchange(..))
+import Data.Lens.Types (Iso(), IsoP(), AnIso(), AnIsoP(), Optic(), Exchange(..), Re(..), runRe)
 
 -- | Create an `Iso` from a pair of morphisms.
 iso :: forall s t a b. (s -> a) -> (b -> t) -> Iso s t a b
@@ -25,6 +25,10 @@ withIso l f = case l (Exchange id id) of
 cloneIso :: forall s t a b. AnIso s t a b -> Iso s t a b
 cloneIso l = withIso l \x y p -> iso x y p
 
+-- | Reverses an optic.
+re :: forall p s t a b. Optic (Re p a b) s t a b -> Optic p b a t s
+re t = runRe (t (Re id))
+
 au :: forall s t a b e. AnIso s t a b -> ((b -> t) -> e -> s) -> e -> a
 au l = withIso l \sa bt f e -> sa (f bt e)
 

src/Data/Lens/Types.purs

@@ -6,20 +6,25 @@ module Data.Lens.Types
   , module Data.Lens.Internal.Market
   , module Data.Lens.Internal.Shop
   , module Data.Lens.Internal.Tagged
+  , module Data.Lens.Internal.Forget
   , module Data.Lens.Internal.Wander
+  , module Data.Lens.Internal.Re
   ) where
 
 import Data.Const (Const())
 import Data.Profunctor (Profunctor)
 import Data.Profunctor.Choice (Choice)
 import Data.Profunctor.Star (Star())
 import Data.Profunctor.Strong (Strong)
+import Data.Profunctor.Closed (Closed)
 
 import Data.Lens.Internal.Exchange (Exchange(..))
 import Data.Lens.Internal.Market (Market(..))
 import Data.Lens.Internal.Shop (Shop(..))
 import Data.Lens.Internal.Tagged (Tagged(..), unTagged)
+import Data.Lens.Internal.Forget (Forget(..), runForget)
 import Data.Lens.Internal.Wander (Wander, wander)
+import Data.Lens.Internal.Re (Re(..), runRe)
 
 -- | A general-purpose Data.Lens.
 type Optic p s t a b = p a b -> p s t
@@ -63,5 +68,5 @@ type Review s t a b = Optic Tagged s t a b
 type ReviewP s a = Review s s a a
 
 -- | A fold.
-type Fold r s t a b = Optic (Star (Const r)) s t a b
+type Fold r s t a b = Optic (Forget r) s t a b
 type FoldP r s a = Fold r s s a a