0 | module Control.Lens.Fold
2 | import Data.Bicontravariant
3 | import Data.Profunctor
4 | import Data.Profunctor.Costrong
5 | import Data.Profunctor.Traversing
6 | import Control.Applicative.Backwards
7 | import Control.Lens.Optic
8 | import Control.Lens.Indexed
9 | import Control.Lens.OptionalFold
10 | import Control.Lens.Traversal
23 | record IsFold p where
24 | constructor MkIsFold
25 | runIsFold : (Traversing p, Bicontravariant p)
28 | foldToOptFold : IsFold p => IsOptFold p
29 | foldToOptFold @{MkIsFold _} = MkIsOptFold %search
32 | foldToTraversal : IsFold p => IsTraversal p
33 | foldToTraversal @{MkIsFold _} = MkIsTraversal %search
41 | 0 Fold : (s,a : Type) -> Type
42 | Fold = Simple (Optic IsFold)
46 | 0 IndexedFold : (i,s,a : Type) -> Type
47 | IndexedFold = Simple . IndexedOptic IsFold
57 | folded : Foldable f => Fold (f a) a
58 | folded @{_} @{MkIsFold _} = rphantom . wander traverse_
64 | public export covering
65 | unfolded : (s -> Maybe (a, s)) -> Fold s a
66 | unfolded coalg @{MkIsFold _} = rphantom . wander loop
68 | loop : Applicative f => (a -> f a) -> s -> f ()
69 | loop f = maybe (pure ()) (uncurry $
\x,y => f x *> loop f y) . coalg
73 | folding : Foldable f => (s -> f a) -> Fold s a
74 | folding @{_} f @{MkIsFold _} = rphantom . contramapFst f . wander traverse_
78 | ifolding : Foldable f => (s -> f (i, a)) -> IndexedFold i s a
79 | ifolding @{_} f @{MkIsFold _} @{ind} =
80 | rphantom . contramapFst f . wander traverse_ . indexed @{ind}
85 | backwards : Fold s a -> Fold s a
86 | backwards l @{MkIsFold _} = rphantom . wander func
88 | traversing : Applicative f => Traversing (Forget (f ()))
90 | let _ = MkMonoid @{MkSemigroup (*>)} (pure ())
93 | func : Applicative f => (a -> f a) -> s -> f ()
94 | func fn = let _ = traversing in
95 | forwards . runForget (l $
MkForget (MkBackwards {f} . ignore . fn))
99 | replicated : Nat -> Fold a a
100 | replicated n @{MkIsFold _} = rphantom . wander (\f,x => rep n (f x))
102 | rep : Applicative f => Nat -> f a -> f ()
104 | rep (S Z) x = ignore x
105 | rep (S n@(S _)) x = x *> rep n x
110 | foldMapOf : Monoid m => Fold s a -> (a -> m) -> s -> m
111 | foldMapOf l = runForget . l . MkForget
116 | ifoldMapOf : Monoid m => IndexedFold i s a -> (i -> a -> m) -> s -> m
117 | ifoldMapOf l = runForget . l @{%search} @{Idxed} . MkForget . uncurry
122 | foldrOf : Fold s a -> (a -> acc -> acc) -> acc -> s -> acc
123 | foldrOf l = flip . foldMapOf @{MkMonoid @{MkSemigroup (.)} id} l
128 | ifoldrOf : IndexedFold i s a -> (i -> a -> acc -> acc) -> acc -> s -> acc
129 | ifoldrOf l = flip . ifoldMapOf @{MkMonoid @{MkSemigroup (.)} id} l
134 | foldlOf : Fold s a -> (acc -> a -> acc) -> acc -> s -> acc
135 | foldlOf l = flip . foldMapOf @{MkMonoid @{MkSemigroup $
flip (.)} id} l . flip
140 | ifoldlOf : IndexedFold i s a -> (i -> acc -> a -> acc) -> acc -> s -> acc
141 | ifoldlOf l = flip . ifoldMapOf @{MkMonoid @{MkSemigroup $
flip (.)} id} l . (flip .)
145 | concatOf : Monoid m => Fold s m -> s -> m
146 | concatOf l = foldMapOf l id
150 | choiceOf : Alternative f => Fold s (Lazy (f a)) -> s -> f a
151 | choiceOf = force .: concatOf @{MonoidAlternative}
155 | sequenceOf_ : Applicative f => Fold s (f a) -> s -> f ()
157 | let _ = MkMonoid @{MkSemigroup (*>)} (pure ())
158 | in foldMapOf l ignore
163 | traverseOf_ : Applicative f => Fold s a -> (a -> f b) -> s -> f ()
165 | let _ = MkMonoid @{MkSemigroup (*>)} (pure ())
166 | in foldMapOf l (ignore . f)
171 | itraverseOf_ : Applicative f => IndexedFold i s a -> (i -> a -> f b) -> s -> f ()
173 | let _ = MkMonoid @{MkSemigroup (*>)} (pure ())
174 | in ifoldMapOf l (ignore .: f)
178 | forOf_ : Applicative f => Fold s a -> s -> (a -> f b) -> f ()
179 | forOf_ = flip . traverseOf_
183 | iforOf_ : Applicative f => IndexedFold i s a -> s -> (i -> a -> f b) -> f ()
184 | iforOf_ = flip . itraverseOf_
188 | andOf : Fold s (Lazy Bool) -> s -> Bool
189 | andOf = force .: concatOf @{All}
193 | orOf : Fold s (Lazy Bool) -> s -> Bool
194 | orOf = force .: concatOf @{Any}
198 | allOf : Fold s a -> (a -> Bool) -> s -> Bool
199 | allOf = foldMapOf @{All}
203 | iallOf : IndexedFold i s a -> (i -> a -> Bool) -> s -> Bool
204 | iallOf = ifoldMapOf @{All}
208 | anyOf : Fold s a -> (a -> Bool) -> s -> Bool
209 | anyOf = foldMapOf @{Any}
213 | ianyOf : IndexedFold i s a -> (i -> a -> Bool) -> s -> Bool
214 | ianyOf = ifoldMapOf @{Any}
219 | elemOf : Eq a => Fold s a -> a -> s -> Bool
220 | elemOf l = anyOf l . (==)
224 | lengthOf : Fold s a -> s -> Nat
225 | lengthOf l = foldMapOf @{Additive} l (const 1)
232 | firstOf : Fold s a -> s -> Maybe a
233 | firstOf l = foldMapOf l Just
240 | ifirstOf : IndexedFold i s a -> s -> Maybe (i, a)
241 | ifirstOf l = runForget $
l @{%search} @{Idxed} $
MkForget Just
246 | lastOf : Fold s a -> s -> Maybe a
247 | lastOf l = foldMapOf @{MkMonoid @{MkSemigroup $
flip (<+>)} neutral} l Just
252 | ilastOf : IndexedFold i s a -> s -> Maybe (i, a)
254 | let _ = MkMonoid @{MkSemigroup $
flip (<+>)} neutral
255 | in runForget $
l @{%search} @{Idxed} $
MkForget Just
266 | has : Fold s a -> s -> Bool
267 | has l = anyOf l (const True)
271 | hasn't : Fold s a -> s -> Bool
272 | hasn't l = allOf l (const False)
278 | previews : Fold s a -> (a -> r) -> s -> Maybe r
279 | previews l f = foldMapOf l (Just . f)
286 | preview : Fold s a -> s -> Maybe a
289 | export infixl 8 ^?
, ^@?
, ^.
, ^@.
296 | (^?) : s -> Fold s a -> Maybe a
297 | (^?) x l = preview l x
305 | ipreview : IndexedFold i s a -> s -> Maybe (i, a)
306 | ipreview = ifirstOf
313 | (^@?) : s -> IndexedFold i s a -> Maybe (i, a)
314 | (^@?) x l = ipreview l x
321 | pre : Fold s a -> OptionalFold s a
322 | pre = folding . preview
329 | ipre : IndexedFold i s a -> IndexedOptionalFold i s a
330 | ipre = ifolding . ipreview
335 | toListOf : Fold s a -> s -> List a
336 | toListOf l = foldrOf l (::) []
342 | (^..) : s -> Fold s a -> List a
343 | (^..) s l = toListOf l s
348 | itoListOf : IndexedFold i s a -> s -> List (i, a)
349 | itoListOf l = ifoldrOf l ((::) .: (,)) []
355 | (^@..) : s -> IndexedFold i s a -> List (i, a)
356 | (^@..) x l = itoListOf l x