Some new folds and traversals.

zrho · zrho · commit 7f47130e2c28 · 2015-09-17T18:01:12.000+02:00
diff --git a/docs/Data/Lens/Fold.md b/docs/Data/Lens/Fold.md
@@ -52,6 +52,127 @@ foldlOf :: forall s t a b r. Fold (Dual (Endo r)) s t a b -> (r -> a -> r) -> r
 
 Left fold over a `Fold`.
 
+#### `allOf`
+
+``` purescript
+allOf :: forall s t a b r. (BooleanAlgebra r) => Fold (Conj r) s t a b -> (a -> r) -> s -> r
+```
+
+Whether all foci of a `Fold` satisfy a predicate.
+
+#### `anyOf`
+
+``` purescript
+anyOf :: forall s t a b r. (BooleanAlgebra r) => Fold (Disj r) s t a b -> (a -> r) -> s -> r
+```
+
+Whether any focus of a `Fold` satisfies a predicate.
+
+#### `andOf`
+
+``` purescript
+andOf :: forall s t a b. (BooleanAlgebra a) => Fold (Conj a) s t a b -> s -> a
+```
+
+The conjunction of all foci of a `Fold`.
+
+#### `orOf`
+
+``` purescript
+orOf :: forall s t a b. (BooleanAlgebra a) => Fold (Disj a) s t a b -> s -> a
+```
+
+The disjunction of all foci of a `Fold`.
+
+#### `elemOf`
+
+``` purescript
+elemOf :: forall s t a b. (Eq a) => Fold (Disj Boolean) s t a b -> a -> s -> Boolean
+```
+
+Whether a `Fold` contains a given element.
+
+#### `notElemOf`
+
+``` purescript
+notElemOf :: forall s t a b. (Eq a) => Fold (Conj Boolean) s t a b -> a -> s -> Boolean
+```
+
+Whether a `Fold` not contains a given element.
+
+#### `sumOf`
+
+``` purescript
+sumOf :: forall s t a b. (Semiring a) => Fold (Additive a) s t a b -> s -> a
+```
+
+The sum of all foci of a `Fold`.
+
+#### `productOf`
+
+``` purescript
+productOf :: forall s t a b. (Semiring a) => Fold (Multiplicative a) s t a b -> s -> a
+```
+
+The product of all foci of a `Fold`.
+
+#### `lengthOf`
+
+``` purescript
+lengthOf :: forall s t a b. Fold (Additive Int) s t a b -> s -> Int
+```
+
+The number of foci of a `Fold`.
+
+#### `firstOf`
+
+``` purescript
+firstOf :: forall s t a b. Fold (First a) s t a b -> s -> Maybe a
+```
+
+The first focus of a `Fold`, if there is any. Synonym for `preview`.
+
+#### `lastOf`
+
+``` purescript
+lastOf :: forall s t a b. Fold (Last a) s t a b -> s -> Maybe a
+```
+
+The last focus of a `Fold`, if there is any.
+
+#### `maximumOf`
+
+``` purescript
+maximumOf :: forall s t a b. (Ord a) => Fold (Endo (Maybe a)) s t a b -> s -> Maybe a
+```
+
+The maximum of all foci of a `Fold`, if there is any.
+
+#### `minimumOf`
+
+``` purescript
+minimumOf :: forall s t a b. (Ord a) => Fold (Endo (Maybe a)) s t a b -> s -> Maybe a
+```
+
+The minimum of all foci of a `Fold`, if there is any.
+
+#### `findOf`
+
+``` purescript
+findOf :: forall s t a b. Fold (Endo (Maybe a)) s t a b -> (a -> Boolean) -> s -> Maybe a
+```
+
+Find the first focus of a `Fold` that satisfies a predicate, if there is any.
+
+#### `sequenceOf_`
+
+``` purescript
+sequenceOf_ :: forall f s t a b. (Applicative f) => Fold (Endo (f Unit)) s t (f a) b -> s -> f Unit
+```
+
+Sequence the foci of a `Fold`, pulling out an `Applicative`, and ignore
+the result. If you need the result, see `sequenceOf` for `Traversal`s.
+
 #### `toListOf`
 
 ``` purescript
diff --git a/docs/Data/Lens/Internal/Wander.md b/docs/Data/Lens/Internal/Wander.md
@@ -5,10 +5,12 @@ This module defines the `Wander` type class, which is used to define `Traversal`
 #### `Wander`
 
 ``` purescript
-class (Strong p, Choice p) <= Wander p where
-  wander :: forall t a b. (Traversable t) => p a b -> p (t a) (t b)
+class (Strong p) <= Wander p where
+  wander :: forall f s t a b. (forall f. (Applicative f) => (a -> f b) -> s -> f t) -> p a b -> p s t
 ```
 
+Class for profunctors that support polymorphic traversals.
+
 ##### Instances
 ``` purescript
 instance wanderFunction :: Wander Function
diff --git a/docs/Data/Lens/Traversal.md b/docs/Data/Lens/Traversal.md
@@ -2,20 +2,38 @@
 
 This module defines functions for working with traversals.
 
-#### `traverse`
+#### `traversed`
 
 ``` purescript
-traverse :: forall t a b. (Traversable t) => Traversal (t a) (t b) a b
+traversed :: forall t a b. (Traversable t) => Traversal (t a) (t b) a b
 ```
 
 Create a `Traversal` which traverses the elements of a `Traversable` functor.
 
 #### `traverseOf`
 
 ``` purescript
-traverseOf :: forall f s t a b. (Applicative f) => Traversal s t a b -> (a -> f b) -> s -> f t
+traverseOf :: forall f s t a b. (Applicative f) => Optic (Star f) s t a b -> (a -> f b) -> s -> f t
 ```
 
 Turn a pure profunctor `Traversal` into a `lens`-like `Traversal`.
 
+#### `sequenceOf`
+
+``` purescript
+sequenceOf :: forall f s t a. (Applicative f) => Optic (Star f) s t (f a) a -> s -> f t
+```
+
+Sequence the foci of a `Traversal`, pulling out an `Applicative` effect.
+If you do not need the result, see `sequenceOf_` for `Fold`s.
+
+#### `failover`
+
+``` purescript
+failover :: forall f s t a b. (Alternative f) => Optic (Star (Tuple (Disj Boolean))) s t a b -> (a -> b) -> s -> f t
+```
+
+Tries to map over a `Traversal`; returns `empty`, if the traversal did
+not have any new focus.
+
 
diff --git a/src/Data/Lens/Fold.purs b/src/Data/Lens/Fold.purs
@@ -2,21 +2,26 @@
 
 module Data.Lens.Fold
   ( (^?), (^..)
-  , preview, foldOf, foldMapOf, foldrOf, foldlOf, toListOf, has, hasn't
-  , replicated, filtered
+  , preview, foldOf, foldMapOf, foldrOf, foldlOf, toListOf, firstOf, lastOf
+  , maximumOf, minimumOf, allOf, anyOf, andOf, orOf, elemOf, notElemOf, sumOf
+  , productOf, lengthOf, findOf, sequenceOf_, has, hasn't, replicated, filtered
   ) where
 
 import Prelude
 import Data.Const
 import Data.Maybe
 import Data.List
 import Data.Either
+import Data.Tuple
 import Data.Monoid
 import Data.Maybe.First
+import Data.Maybe.Last
 import Data.Monoid.Endo
 import Data.Monoid.Conj
 import Data.Monoid.Disj
 import Data.Monoid.Dual
+import Data.Monoid.Additive
+import Data.Monoid.Multiplicative
 import Data.Functor.Contravariant
 import Data.Foldable
 import Data.Profunctor
@@ -54,6 +59,69 @@ foldrOf p f r = flip runEndo r <<< foldMapOf p (Endo <<< f)
 foldlOf :: forall s t a b r. Fold (Dual (Endo r)) s t a b -> (r -> a -> r) -> r -> s -> r
 foldlOf p f r = flip runEndo r <<< runDual <<< foldMapOf p (Dual <<< Endo <<< flip f)
 
+-- | Whether all foci of a `Fold` satisfy a predicate.
+allOf :: forall s t a b r. (BooleanAlgebra r) => Fold (Conj r) s t a b -> (a -> r) -> s -> r
+allOf p f = runConj <<< foldMapOf p (Conj <<< f)
+
+-- | Whether any focus of a `Fold` satisfies a predicate.
+anyOf :: forall s t a b r. (BooleanAlgebra r) => Fold (Disj r) s t a b -> (a -> r) -> s -> r
+anyOf p f = runDisj <<< foldMapOf p (Disj <<< f)
+
+-- | The conjunction of all foci of a `Fold`.
+andOf :: forall s t a b. (BooleanAlgebra a) => Fold (Conj a) s t a b -> s -> a
+andOf p = allOf p id
+
+-- | The disjunction of all foci of a `Fold`.
+orOf :: forall s t a b. (BooleanAlgebra a) => Fold (Disj a) s t a b -> s -> a
+orOf p = anyOf p id
+
+-- | Whether a `Fold` contains a given element.
+elemOf :: forall s t a b. (Eq a) => Fold (Disj Boolean) s t a b -> a -> s -> Boolean
+elemOf p a = anyOf p (== a)
+
+-- | Whether a `Fold` not contains a given element.
+notElemOf :: forall s t a b. (Eq a) => Fold (Conj Boolean) s t a b -> a -> s -> Boolean
+notElemOf p a = allOf p (/= a)
+
+-- | The sum of all foci of a `Fold`.
+sumOf :: forall s t a b. (Semiring a) => Fold (Additive a) s t a b -> s -> a
+sumOf p = runAdditive <<< foldMapOf p Additive
+
+-- | The product of all foci of a `Fold`.
+productOf :: forall s t a b. (Semiring a) => Fold (Multiplicative a) s t a b -> s -> a
+productOf p = runMultiplicative <<< foldMapOf p Multiplicative
+
+-- | The number of foci of a `Fold`.
+lengthOf :: forall s t a b. Fold (Additive Int) s t a b -> s -> Int
+lengthOf p = runAdditive <<< foldMapOf p (const $ Additive 1)
+
+-- | The first focus of a `Fold`, if there is any. Synonym for `preview`.
+firstOf :: forall s t a b. Fold (First a) s t a b -> s -> Maybe a
+firstOf p = runFirst <<< foldMapOf p (First <<< Just)
+
+-- | The last focus of a `Fold`, if there is any.
+lastOf :: forall s t a b. Fold (Last a) s t a b -> s -> Maybe a
+lastOf p = runLast <<< foldMapOf p (Last <<< Just)
+
+-- | The maximum of all foci of a `Fold`, if there is any.
+maximumOf :: forall s t a b. (Ord a) => Fold (Endo (Maybe a)) s t a b -> s -> Maybe a
+maximumOf p = foldrOf p (\a -> Just <<< maybe a (max a)) Nothing where
+  max a b = if a > b then a else b
+
+-- | The minimum of all foci of a `Fold`, if there is any.
+minimumOf :: forall s t a b. (Ord a) => Fold (Endo (Maybe a)) s t a b -> s -> Maybe a
+minimumOf p = foldrOf p (\a -> Just <<< maybe a (min a)) Nothing where
+  min a b = if a > b then a else b
+
+-- | Find the first focus of a `Fold` that satisfies a predicate, if there is any.
+findOf :: forall s t a b. Fold (Endo (Maybe a)) s t a b -> (a -> Boolean) -> s -> Maybe a
+findOf p f = foldrOf p (\a -> maybe (if f a then Just a else Nothing) Just) Nothing
+
+-- | Sequence the foci of a `Fold`, pulling out an `Applicative`, and ignore
+-- | the result. If you need the result, see `sequenceOf` for `Traversal`s.
+sequenceOf_ :: forall f s t a b. (Applicative f) => Fold (Endo (f Unit)) s t (f a) b -> s -> f Unit
+sequenceOf_ p = flip runEndo (pure unit) <<< foldMapOf p \f -> Endo (f *>)
+
 -- | Collects the foci of a `Fold` into a list.
 toListOf :: forall s t a b. Fold (Endo (List a)) s t a b -> s -> List a
 toListOf p = foldrOf p (:) Nil
@@ -87,3 +155,10 @@ 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)
+
+-- | Builds a `Fold` using an unfold.
+unfolded
+  :: forall f s t a b. (Applicative f, Contravariant f)
+  => (s -> Maybe (Tuple a s)) -> Optic (Star f) s t a b
+unfolded f p = Star go where
+  go = maybe (coerce $ pure unit) (\(Tuple a s) -> runStar p a *> go s) <<< f
diff --git a/src/Data/Lens/Internal/Wander.purs b/src/Data/Lens/Internal/Wander.purs
@@ -1,19 +1,21 @@
 -- | This module defines the `Wander` type class, which is used to define `Traversal`s.
 
 module Data.Lens.Internal.Wander where
-    
+
 import Prelude
 
-import Data.Traversable (Traversable, traverse)
 import Data.Profunctor.Strong (Strong)
-import Data.Profunctor.Choice (Choice)
-import Data.Profunctor.Star (Star(..))
+import Data.Profunctor.Star (Star(..), runStar)
+import Data.Identity (Identity (..), runIdentity)
+
+-- | Class for profunctors that support polymorphic traversals.
+class (Strong p) <= Wander p where
+  wander
+    :: forall f s t a b. (forall f. (Applicative f) => (a -> f b) -> s -> f t)
+    -> p a b -> p s t
 
-class (Strong p, Choice p) <= Wander p where
-  wander :: forall t a b. (Traversable t) => p a b -> p (t a) (t b)
-  
 instance wanderFunction :: Wander Function where
-  wander = map
+  wander t f s = runIdentity $ t (Identity <<< f) s
 
 instance wanderStar :: (Applicative f) => Wander (Star f) where
-  wander (Star f) = Star (traverse f)
+  wander t = Star <<< t <<< runStar
diff --git a/src/Data/Lens/Traversal.purs b/src/Data/Lens/Traversal.purs
@@ -1,23 +1,47 @@
 -- | This module defines functions for working with traversals.
 
 module Data.Lens.Traversal
-  ( traverse
+  ( traversed
   , traverseOf
+  , sequenceOf
+  , failover
   ) where
 
 import Prelude
 
 import Data.Const
 import Data.Monoid
+import Data.Monoid.Disj
+import Data.Tuple
 import Data.Lens.Types
 import Data.Profunctor.Star
-import Data.Traversable (Traversable)
+import Control.Alternative
+import Control.Plus
+import Data.Traversable (Traversable, traverse)
 import Data.Lens.Internal.Wander (wander)
 
 -- | Create a `Traversal` which traverses the elements of a `Traversable` functor.
-traverse :: forall t a b. (Traversable t) => Traversal (t a) (t b) a b
-traverse = wander
+traversed :: forall t a b. (Traversable t) => Traversal (t a) (t b) a b
+traversed = wander traverse
 
 -- | Turn a pure profunctor `Traversal` into a `lens`-like `Traversal`.
-traverseOf :: forall f s t a b. (Applicative f) => Traversal s t a b -> (a -> f b) -> s -> f t
+traverseOf
+  :: forall f s t a b. (Applicative f)
+  => Optic (Star f) s t a b -> (a -> f b) -> s -> f t
 traverseOf t f = runStar (t (Star f))
+
+-- | Sequence the foci of a `Traversal`, pulling out an `Applicative` effect.
+-- | If you do not need the result, see `sequenceOf_` for `Fold`s.
+sequenceOf
+  :: forall f s t a. (Applicative f)
+  => Optic (Star f) s t (f a) a -> s -> f t
+sequenceOf t = runStar $ wander id $ t (Star id)
+
+-- | Tries to map over a `Traversal`; returns `empty`, if the traversal did
+-- | not have any new focus.
+failover
+  :: forall f s t a b. (Alternative f)
+  => Optic (Star (Tuple (Disj Boolean))) s t a b -> (a -> b) -> s -> f t
+failover t f s = case runStar (wander id $ t $ Star $ Tuple (Disj true) <<< f) s of
+  Tuple (Disj true) x  -> pure x
+  Tuple (Disj false) _ -> empty
