@@ -57,7 +57,18 @@ module Control.Lens.SemiIso (
5757 exact,
5858
5959 -- * Folds.
60− bifoldr
60+ foldlM1,
61+ foldrM1,
62+ unfoldlM,
63+ unfoldlM1,
64+ unfoldrM,
65+ unfoldrM1,
66+
67+ -- * Bidirectional folds.
68+ bifoldr,
69+ bifoldr1,
70+ bifoldl,
71+ bifoldl1
6172 ) where
6273
6374import Control.Lens.Internal.SemiIso
@@ -141,22 +152,99 @@ exact x = semiIso f g
141152 g y | x == y = Right ()
142153 | otherwise = Left "exact: not equal"
143154
155+-- | Monadic counterpart of 'foldl1' (or non-empty list counterpart of 'foldlM').
156+foldlM1 :: Monad m => (a -> a -> m a) -> [a] -> m a
157+foldlM1 f (x:xs) = foldlM f x xs
158+foldlM1 _ [] = fail "foldlM1: empty list"
159+
160+-- | Monadic counterpart of 'foldr1' (or non-empty list counterpart of 'foldrM').
161+foldrM1 :: Monad m => (a -> a -> m a) -> [a] -> m a
162+foldrM1 _ [x] = return x
163+foldrM1 f (x:xs) = foldrM1 f xs >>= f x
164+foldrM1 _ [] = fail "foldrM1: empty list"
165+
166+-- | Monadic counterpart of 'unfoldr'.
167+unfoldrM :: Monad m => (a -> m (Maybe (b, a))) -> a -> m (a, [b])
168+unfoldrM f a = do
169+ r <- f a
170+ case r of
171+ Just (b, new_a) -> do
172+ (final_a, bs) <- unfoldrM f new_a
173+ return (final_a, b : bs)
174+ Nothing -> return (a, [])
175+
176+-- | A variant of 'unfoldrM' that always produces a non-empty list.
177+unfoldrM1 :: Monad m => (a -> m (Maybe (a, a))) -> a -> m [a]
178+unfoldrM1 f a = do
179+ r <- f a
180+ case r of
181+ Just (b, new_a) -> do
182+ bs <- unfoldrM1 f new_a
183+ return (b : bs)
184+ Nothing -> return [a]
185+
186+-- | Monadic counterpart of 'unfoldl'.
187+unfoldlM :: Monad m => (a -> m (Maybe (a, b))) -> a -> m (a, [b])
188+unfoldlM f a0 = go a0 []
189+ where
190+ go a bs = do
191+ r <- f a
192+ case r of
193+ Just (new_a, b) -> go new_a (b : bs)
194+ Nothing -> return (a, bs)
195+
196+-- | A variant of 'unfoldlM' that always produces a non-empty list.
197+unfoldlM1 :: Monad m => (a -> m (Maybe (a, a))) -> a -> m [a]
198+unfoldlM1 f a0 = go a0 []
199+ where
200+ go a bs = do
201+ r <- f a
202+ case r of
203+ Just (new_a, b) -> go new_a (b : bs)
204+ Nothing -> return (a : bs)
205+
144206-- | Constructs a bidirectional fold.
145207--
146−-- \-> Right folds using the (->) part of the given semi-iso.
208+-- \-> Right unfolds using the (->) part of the given semi-iso.
147209--
148−-- \<- Right unfolds using the (<-) part of the given semi-iso.
149−bifoldr :: ASemiIso (b, a) (Maybe (b, a)) a a -> SemiIso' (a, [b]) a
150−bifoldr ai = semiIso (f ai) (g ai)
210+-- \<- Right folds using the (<-) part of the given semi-iso.
211+bifoldr :: ASemiIso a a (Maybe (b, a)) (b, a) -> SemiIso' a (a, [b])
212+bifoldr ai = semiIso (uf ai) (f ai)
151213 where
152− f = uncurry . foldrM . curry . apply
153− g = unfoldrM . unapply
214+ f = uncurry . foldrM . curry . unapply
215+ uf = unfoldrM . apply
154216
155− unfoldrM :: Monad m => (a -> m (Maybe (b, a))) -> a -> m (a, [b])
156− unfoldrM f a = do
157− r <- f a
158− case r of
159− Just (b, new_a) -> do
160− (final_a, bs) <- unfoldrM f new_a
161− return (final_a, b : bs)
162− Nothing -> return (a, [])
217+-- | Constructs a bidirectional fold.
218+--
219+-- \-> Right unfolds using the (->) part of the given semi-iso. It should
220+-- produce an non-empty list.
221+--
222+-- \<- Right folds a non-empty list using the (<-) part of the given semi-iso.
223+bifoldr1 :: ASemiIso a a (Maybe (a, a)) (a, a) -> SemiIso' a [a]
224+bifoldr1 ai = semiIso (uf ai) (f ai)
225+ where
226+ f = foldrM1 . curry . unapply
227+ uf = unfoldrM1 . apply
228+
229+-- | Constructs a bidirectional fold.
230+--
231+-- \-> Left unfolds using the (->) part of the given semi-iso.
232+--
233+-- \<- Left folds using the (<-) part of the given semi-iso.
234+bifoldl :: ASemiIso a a (Maybe (a, b)) (a, b) -> SemiIso' a (a, [b])
235+bifoldl ai = semiIso (uf ai) (f ai)
236+ where
237+ f = uncurry . foldlM . curry . unapply
238+ uf = unfoldlM . apply
239+
240+-- | Constructs a bidirectional fold.
241+--
242+-- \-> Left unfolds using the (->) part of the given semi-iso. It should
243+-- produce an non-empty list.
244+--
245+-- \<- Left folds a non-empty list using the (<-) part of the given semi-iso.
246+bifoldl1 :: ASemiIso a a (Maybe (a, a)) (a, a) -> SemiIso' a [a]
247+bifoldl1 ai = semiIso (uf ai) (f ai)
248+ where
249+ f = foldlM1 . curry . unapply
250+ uf = unfoldlM1 . apply