@@ -8,34 +8,36 @@ module Data.Lens.Fold
8
8
, folded , unfolded
9
9
, ifoldMapOf , ifoldrOf , ifoldlOf , iallOf , ianyOf , itoListOf , itraverseOf_
10
10
, module ExportTypes
11
- ) where
11
+ )
12
+ where
12
13
13
14
import Prelude
14
15
15
16
import Data.Either (Either (..), either )
16
17
import Data.Foldable (class Foldable , foldMap )
17
18
import Data.HeytingAlgebra (tt , ff )
18
- import Data.Lens.Internal.Forget (Forget (..), runForget )
19
- import Data.Lens.Types (Fold , FoldP ) as ExportTypes
20
- import Data.Lens.Types (IndexedFold , Fold , OpticP , Indexed (..))
19
+ import Data.Lens.Internal.Forget (Forget (..))
20
+ import Data.Lens.Types (Fold , Fold' ) as ExportTypes
21
+ import Data.Lens.Types (IndexedFold , Fold , Optic' , Indexed (..))
21
22
import Data.List (List (..), (:))
22
23
import Data.Maybe (Maybe (..), maybe )
23
- import Data.Maybe.First (First (..), runFirst )
24
- import Data.Maybe.Last (Last (..), runLast )
24
+ import Data.Maybe.First (First (..))
25
+ import Data.Maybe.Last (Last (..))
25
26
import Data.Monoid (class Monoid , mempty )
26
- import Data.Monoid.Additive (Additive (..), runAdditive )
27
- import Data.Monoid.Conj (Conj (..), runConj )
28
- import Data.Monoid.Disj (Disj (..), runDisj )
29
- import Data.Monoid.Dual (Dual (..), runDual )
30
- import Data.Monoid.Endo (Endo (..), runEndo )
31
- import Data.Monoid.Multiplicative (Multiplicative (..), runMultiplicative )
27
+ import Data.Monoid.Additive (Additive (..))
28
+ import Data.Monoid.Conj (Conj (..))
29
+ import Data.Monoid.Disj (Disj (..))
30
+ import Data.Monoid.Dual (Dual (..))
31
+ import Data.Monoid.Endo (Endo (..))
32
+ import Data.Monoid.Multiplicative (Multiplicative (..))
33
+ import Data.Newtype (unwrap , under )
32
34
import Data.Profunctor (dimap )
33
35
import Data.Profunctor.Choice (class Choice , right )
34
36
import Data.Tuple (Tuple (..), uncurry )
35
37
36
38
-- | Previews the first value of a fold, if there is any.
37
39
preview :: forall s t a b . Fold (First a ) s t a b -> s -> Maybe a
38
- preview p = runFirst <<< foldMapOf p (First <<< Just )
40
+ preview p = unwrap <<< foldMapOf p (First <<< Just )
39
41
40
42
-- | Synonym for `preview`, flipped.
41
43
previewOn :: forall s t a b . s -> Fold (First a ) s t a b -> Maybe a
@@ -45,71 +47,71 @@ infixl 8 previewOn as ^?
45
47
46
48
-- | Folds all foci of a `Fold` to one. Note that this is the same as `view`.
47
49
foldOf :: forall s t a b . Fold a s t a b -> s -> a
48
- foldOf p = runForget (p ( Forget id))
50
+ foldOf p = foldMapOf p id
49
51
50
52
-- | Maps and then folds all foci of a `Fold`.
51
53
foldMapOf :: forall s t a b r . Fold r s t a b -> (a -> r ) -> s -> r
52
- foldMapOf p f = runForget (p ( Forget f))
54
+ foldMapOf = under Forget
53
55
54
56
-- | Right fold over a `Fold`.
55
57
foldrOf :: forall s t a b r . Fold (Endo r ) s t a b -> (a -> r -> r ) -> r -> s -> r
56
- foldrOf p f r = flip runEndo r <<< foldMapOf p (Endo <<< f)
58
+ foldrOf p f r = flip unwrap r <<< foldMapOf p (Endo <<< f)
57
59
58
60
-- | Left fold over a `Fold`.
59
61
foldlOf :: forall s t a b r . Fold (Dual (Endo r )) s t a b -> (r -> a -> r ) -> r -> s -> r
60
- foldlOf p f r = flip runEndo r <<< runDual <<< foldMapOf p (Dual <<< Endo <<< flip f)
62
+ foldlOf p f r = flip unwrap r <<< unwrap <<< foldMapOf p (Dual <<< Endo <<< flip f)
61
63
62
64
-- | Whether all foci of a `Fold` satisfy a predicate.
63
- allOf :: forall s t a b r . ( BooleanAlgebra r ) => Fold (Conj r ) s t a b -> (a -> r ) -> s -> r
64
- allOf p f = runConj <<< foldMapOf p (Conj <<< f)
65
+ allOf :: forall s t a b r . HeytingAlgebra r => Fold (Conj r ) s t a b -> (a -> r ) -> s -> r
66
+ allOf p f = unwrap <<< foldMapOf p (Conj <<< f)
65
67
66
68
-- | Whether any focus of a `Fold` satisfies a predicate.
67
- anyOf :: forall s t a b r . ( BooleanAlgebra r ) => Fold (Disj r ) s t a b -> (a -> r ) -> s -> r
68
- anyOf p f = runDisj <<< foldMapOf p (Disj <<< f)
69
+ anyOf :: forall s t a b r . HeytingAlgebra r => Fold (Disj r ) s t a b -> (a -> r ) -> s -> r
70
+ anyOf p f = unwrap <<< foldMapOf p (Disj <<< f)
69
71
70
72
-- | The conjunction of all foci of a `Fold`.
71
- andOf :: forall s t a b . ( BooleanAlgebra a ) => Fold (Conj a ) s t a b -> s -> a
73
+ andOf :: forall s t a b . HeytingAlgebra a => Fold (Conj a ) s t a b -> s -> a
72
74
andOf p = allOf p id
73
75
74
76
-- | The disjunction of all foci of a `Fold`.
75
- orOf :: forall s t a b . ( BooleanAlgebra a ) => Fold (Disj a ) s t a b -> s -> a
77
+ orOf :: forall s t a b . HeytingAlgebra a => Fold (Disj a ) s t a b -> s -> a
76
78
orOf p = anyOf p id
77
79
78
80
-- | Whether a `Fold` contains a given element.
79
- elemOf :: forall s t a b . ( Eq a ) => Fold (Disj Boolean ) s t a b -> a -> s -> Boolean
81
+ elemOf :: forall s t a b . Eq a => Fold (Disj Boolean ) s t a b -> a -> s -> Boolean
80
82
elemOf p a = anyOf p (_ == a)
81
83
82
84
-- | Whether a `Fold` not contains a given element.
83
- notElemOf :: forall s t a b . ( Eq a ) => Fold (Conj Boolean ) s t a b -> a -> s -> Boolean
85
+ notElemOf :: forall s t a b . Eq a => Fold (Conj Boolean ) s t a b -> a -> s -> Boolean
84
86
notElemOf p a = allOf p (_ /= a)
85
87
86
88
-- | The sum of all foci of a `Fold`.
87
- sumOf :: forall s t a b . ( Semiring a ) => Fold (Additive a ) s t a b -> s -> a
88
- sumOf p = runAdditive <<< foldMapOf p Additive
89
+ sumOf :: forall s t a b . Semiring a => Fold (Additive a ) s t a b -> s -> a
90
+ sumOf p = unwrap <<< foldMapOf p Additive
89
91
90
92
-- | The product of all foci of a `Fold`.
91
- productOf :: forall s t a b . ( Semiring a ) => Fold (Multiplicative a ) s t a b -> s -> a
92
- productOf p = runMultiplicative <<< foldMapOf p Multiplicative
93
+ productOf :: forall s t a b . Semiring a => Fold (Multiplicative a ) s t a b -> s -> a
94
+ productOf p = unwrap <<< foldMapOf p Multiplicative
93
95
94
96
-- | The number of foci of a `Fold`.
95
97
lengthOf :: forall s t a b . Fold (Additive Int ) s t a b -> s -> Int
96
- lengthOf p = runAdditive <<< foldMapOf p (const $ Additive 1 )
98
+ lengthOf p = unwrap <<< foldMapOf p (const $ Additive 1 )
97
99
98
100
-- | The first focus of a `Fold`, if there is any. Synonym for `preview`.
99
101
firstOf :: forall s t a b . Fold (First a ) s t a b -> s -> Maybe a
100
- firstOf p = runFirst <<< foldMapOf p (First <<< Just )
102
+ firstOf p = unwrap <<< foldMapOf p (First <<< Just )
101
103
102
104
-- | The last focus of a `Fold`, if there is any.
103
105
lastOf :: forall s t a b . Fold (Last a ) s t a b -> s -> Maybe a
104
- lastOf p = runLast <<< foldMapOf p (Last <<< Just )
106
+ lastOf p = unwrap <<< foldMapOf p (Last <<< Just )
105
107
106
108
-- | The maximum of all foci of a `Fold`, if there is any.
107
- maximumOf :: forall s t a b . ( Ord a ) => Fold (Endo (Maybe a )) s t a b -> s -> Maybe a
109
+ maximumOf :: forall s t a b . Ord a => Fold (Endo (Maybe a )) s t a b -> s -> Maybe a
108
110
maximumOf p = foldrOf p (\a -> Just <<< maybe a (max a)) Nothing where
109
111
max a b = if a > b then a else b
110
112
111
113
-- | The minimum of all foci of a `Fold`, if there is any.
112
- minimumOf :: forall s t a b . ( Ord a ) => Fold (Endo (Maybe a )) s t a b -> s -> Maybe a
114
+ minimumOf :: forall s t a b . Ord a => Fold (Endo (Maybe a )) s t a b -> s -> Maybe a
113
115
minimumOf p = foldrOf p (\a -> Just <<< maybe a (min a)) Nothing where
114
116
min a b = if a < b then a else b
115
117
@@ -125,7 +127,7 @@ sequenceOf_
125
127
=> Fold (Endo (f Unit )) s t (f a ) b
126
128
-> s
127
129
-> f Unit
128
- sequenceOf_ p = flip runEndo (pure unit) <<< foldMapOf p \f -> Endo (f *> _)
130
+ sequenceOf_ p = flip unwrap (pure unit) <<< foldMapOf p \f -> Endo (f *> _)
129
131
130
132
-- | Traverse the foci of a `Fold`, discarding the results.
131
133
traverseOf_
@@ -149,29 +151,30 @@ infixl 8 toListOfOn as ^..
149
151
150
152
-- | Determines whether a `Fold` has at least one focus.
151
153
has :: forall s t a b r . HeytingAlgebra r => Fold (Disj r ) s t a b -> s -> r
152
- has p = runDisj <<< foldMapOf p (const (Disj tt))
154
+ has p = unwrap <<< foldMapOf p (const (Disj tt))
153
155
154
156
-- | Determines whether a `Fold` does not have a focus.
155
157
hasn't :: forall s t a b r . HeytingAlgebra r => Fold (Conj r ) s t a b -> s -> r
156
- hasn't p = runConj <<< foldMapOf p (const (Conj ff))
158
+ hasn't p = unwrap <<< foldMapOf p (const (Conj ff))
157
159
158
160
-- | Filters on a predicate.
159
- filtered :: forall p a . ( Choice p ) => (a -> Boolean ) -> OpticP p a a
161
+ filtered :: forall p a . Choice p => (a -> Boolean ) -> Optic' p a a
160
162
filtered f =
161
163
right >>>
162
164
dimap
163
165
(\x -> if f x then Right x else Left x)
164
166
(either id id)
165
167
166
168
-- | Replicates the elements of a fold.
167
- replicated :: forall a b t r . (Monoid r ) => Int -> Fold r a b a t
168
- replicated n = Forget <<< go n <<< runForget where
169
+ replicated :: forall a b t r . Monoid r => Int -> Fold r a b a t
170
+ replicated i (Forget a) = Forget (go i a)
171
+ where
169
172
go 0 x = mempty
170
173
go n x = x <> go (n - 1 ) x
171
174
172
175
-- | Folds over a `Foldable` container.
173
176
folded :: forall g a b t r . (Monoid r , Foldable g ) => Fold r (g a ) b a t
174
- folded = Forget <<< foldMap <<< runForget
177
+ folded ( Forget a) = Forget ( foldMap a)
175
178
176
179
-- | Builds a `Fold` using an unfold.
177
180
unfolded
@@ -181,7 +184,7 @@ unfolded
181
184
-> Fold r s t a b
182
185
unfolded f p = Forget go
183
186
where
184
- go = maybe mempty (\(Tuple a sn) -> runForget p a <> go sn) <<< f
187
+ go = maybe mempty (\(Tuple a sn) -> unwrap p a <> go sn) <<< f
185
188
186
189
-- | Fold map over an `IndexedFold`.
187
190
ifoldMapOf
@@ -190,7 +193,7 @@ ifoldMapOf
190
193
-> (i -> a -> r )
191
194
-> s
192
195
-> r
193
- ifoldMapOf p f = runForget $ p $ Indexed $ Forget (uncurry f)
196
+ ifoldMapOf p f = unwrap $ p $ Indexed $ Forget (uncurry f)
194
197
195
198
-- | Right fold over an `IndexedFold`.
196
199
ifoldrOf
@@ -200,7 +203,7 @@ ifoldrOf
200
203
-> r
201
204
-> s
202
205
-> r
203
- ifoldrOf p f r = flip runEndo r <<< ifoldMapOf p (\i -> Endo <<< f i)
206
+ ifoldrOf p f r = flip unwrap r <<< ifoldMapOf p (\i -> Endo <<< f i)
204
207
205
208
-- | Left fold over an `IndexedFold`.
206
209
ifoldlOf
@@ -211,8 +214,8 @@ ifoldlOf
211
214
-> s
212
215
-> r
213
216
ifoldlOf p f r =
214
- flip runEndo r
215
- <<< runDual
217
+ flip unwrap r
218
+ <<< unwrap
216
219
<<< ifoldMapOf p (\i -> Dual <<< Endo <<< flip (f i))
217
220
218
221
-- | Whether all foci of an `IndexedFold` satisfy a predicate.
@@ -223,7 +226,7 @@ iallOf
223
226
-> (i -> a -> r )
224
227
-> s
225
228
-> r
226
- iallOf p f = runConj <<< ifoldMapOf p (\i -> Conj <<< f i)
229
+ iallOf p f = unwrap <<< ifoldMapOf p (\i -> Conj <<< f i)
227
230
228
231
-- | Whether any focus of an `IndexedFold` satisfies a predicate.
229
232
ianyOf
@@ -233,7 +236,7 @@ ianyOf
233
236
-> (i -> a -> r )
234
237
-> s
235
238
-> r
236
- ianyOf p f = runDisj <<< ifoldMapOf p (\i -> Disj <<< f i)
239
+ ianyOf p f = unwrap <<< ifoldMapOf p (\i -> Disj <<< f i)
237
240
238
241
-- | Find the first focus of an `IndexedFold` that satisfies a predicate, if
239
242
-- | there is any.
0 commit comments