replicated, folded and ALens.

Author: zrho

bower.json

@@ -21,6 +21,7 @@
     "purescript-const": "~0.5.0",
     "purescript-identity": "~0.4.0",
     "purescript-profunctor": "~0.3.0",
-    "purescript-lists": "~0.7.0"
+    "purescript-lists": "~0.7.0",
+    "purescript-unsafe-coerce": "~0.1.0"
   }
 }

docs/Data/Lens/Fold.md

@@ -86,4 +86,20 @@ hasn't :: forall s t a b r. (BooleanAlgebra r) => Fold (Conj r) s t a b -> s ->
 
 Determines whether a `Fold` does not have a focus.
 
+#### `filtered`
+
+``` purescript
+filtered :: forall p a. (Choice p) => (a -> Boolean) -> OpticP p a a
+```
+
+Filters on a predicate.
+
+#### `replicated`
+
+``` purescript
+replicated :: forall r a b t f. (Applicative f, Contravariant f) => Int -> Optic (Star f) a b a t
+```
+
+Replicates the elements of a fold.
+
 

docs/Data/Lens/Internal/Shop.md

@@ -0,0 +1,20 @@
+## Module Data.Lens.Internal.Shop
+
+This module defines the `Shop` profunctor
+
+#### `Shop`
+
+``` purescript
+data Shop a b s t
+  = Shop (s -> a) (s -> b -> t)
+```
+
+The `Shop` profunctor characterizes a `Lens`.
+
+##### Instances
+``` purescript
+instance profunctorShop :: Profunctor (Shop a b)
+instance strongShop :: Strong (Shop a b)
+```
+
+

docs/Data/Lens/Internal/Void.md

@@ -0,0 +1,23 @@
+## Module Data.Lens.Internal.Void
+
+This module defines the empty `Void` type.
+
+#### `Void`
+
+``` purescript
+data Void
+```
+
+#### `absurd`
+
+``` purescript
+absurd :: forall a. Void -> a
+```
+
+#### `coerce`
+
+``` purescript
+coerce :: forall f a b. (Contravariant f, Functor f) => f a -> f b
+```
+
+

docs/Data/Lens/Lens.md

@@ -16,4 +16,16 @@ lens :: forall s t a b. (s -> a) -> (s -> b -> t) -> Lens s t a b
 
 Create a `Lens` from a getter/setter pair.
 
+#### `withLens`
+
+``` purescript
+withLens :: forall s t a b r. ALens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r
+```
+
+#### `cloneLens`
+
+``` purescript
+cloneLens :: forall s t a b. ALens s t a b -> Lens s t a b
+```
+
 

docs/Data/Lens/Types.md

@@ -56,6 +56,18 @@ A lens.
 type LensP s a = Lens s s a a
 ```
 
+#### `ALens`
+
+``` purescript
+type ALens s t a b = Optic (Shop a b) s t a b
+```
+
+#### `ALensP`
+
+``` purescript
+type ALensP s a = ALens s s a a
+```
+
 #### `Prism`
 
 ``` purescript

src/Data/Lens/Fold.purs

@@ -3,20 +3,29 @@
 module Data.Lens.Fold
   ( (^?), (^..)
   , preview, foldOf, foldMapOf, foldrOf, foldlOf, toListOf, has, hasn't
+  , replicated, filtered
   ) where
 
 import Prelude
 import Data.Const
 import Data.Maybe
 import Data.List
+import Data.Either
+import Data.Monoid
 import Data.Maybe.First
 import Data.Monoid.Endo
 import Data.Monoid.Conj
 import Data.Monoid.Disj
 import Data.Monoid.Dual
+import Data.Functor.Contravariant
+import Data.Foldable
+import Data.Profunctor
 import Data.Profunctor.Star
+import Data.Profunctor.Choice
 import Data.Lens.Types
 import Data.Lens.Internal.Tagged
+import Data.Lens.Internal.Void
+import Control.Apply
 
 infixl 8 ^?
 infixl 8 ^..
@@ -60,3 +69,21 @@ has p = runDisj <<< foldMapOf p (const (Disj top))
 -- | Determines whether a `Fold` does not have a focus.
 hasn't :: forall s t a b r. (BooleanAlgebra r) => Fold (Conj r) s t a b -> s -> r
 hasn't p = runConj <<< foldMapOf p (const (Conj bottom))
+
+-- | Filters on a predicate.
+filtered :: forall p a. (Choice p) => (a -> Boolean) -> OpticP p a a
+filtered f = dimap (\x -> if f x then Right x else Left x) (either id id) <<< right
+
+-- | Replicates the elements of a fold.
+replicated
+  :: forall r a b t f. (Applicative f, Contravariant f)
+  => Int -> Optic (Star f) a b a t
+replicated n p = Star (flip go n <<< runStar p) where
+  go x 0 = coerce (pure unit)
+  go x n = x *> go x (n - 1)
+
+-- | Folds over a `Foldable` container.
+folded
+  :: forall f g a b t r. (Applicative f, Contravariant f, Foldable g)
+  => Optic (Star f) (g a) b a t
+folded p = Star $ foldr (\a r -> runStar p a *> r) (coerce $ pure unit)

src/Data/Lens/Internal/Shop.purs

@@ -0,0 +1,18 @@
+-- | This module defines the `Shop` profunctor
+
+module Data.Lens.Internal.Shop where
+
+import Prelude
+import Data.Tuple
+import Data.Profunctor
+import Data.Profunctor.Strong
+
+-- | The `Shop` profunctor characterizes a `Lens`.
+data Shop a b s t = Shop (s -> a) (s -> b -> t)
+
+instance profunctorShop :: Profunctor (Shop a b) where
+  dimap f g (Shop x y) = Shop (x <<< f) (\s -> g <<< y (f s))
+
+instance strongShop :: Strong (Shop a b) where
+  first (Shop x y) = Shop (\(Tuple a _) -> x a) (\(Tuple s c) b -> Tuple (y s b) c)
+  second (Shop x y) = Shop (\(Tuple _ a) -> x a) (\(Tuple c s) b -> Tuple c (y s b))

src/Data/Lens/Internal/Void.purs

@@ -0,0 +1,15 @@
+-- | This module defines the empty `Void` type.
+
+module Data.Lens.Internal.Void where
+
+import Prelude
+import Data.Functor.Contravariant
+import Unsafe.Coerce
+
+data Void
+
+absurd :: forall a. Void -> a
+absurd = unsafeCoerce
+
+coerce :: forall f a b. (Contravariant f, Functor f) => f a -> f b
+coerce a = absurd <$> (absurd >$< a)

src/Data/Lens/Lens.purs

@@ -3,12 +3,15 @@
 module Data.Lens.Lens
   ( lens
   , lens'
+  , withLens
+  , cloneLens
   ) where
 
 import Prelude
 
 import Data.Tuple
 import Data.Lens.Types
+import Data.Lens.Internal.Shop
 import Data.Profunctor
 import Data.Profunctor.Strong
 
@@ -18,3 +21,9 @@ lens' to pab = dimap to (\(Tuple b f) -> f b) (first pab)
 -- | Create a `Lens` from a getter/setter pair.
 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
+
+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 id \_ b -> b) of Shop x y -> f x y
+
+cloneLens :: forall s t a b. ALens s t a b -> Lens s t a b
+cloneLens l = withLens l \x y p -> lens x y p