@@ -53,13 +53,18 @@ module Control.Lens.SemiIso (
5353 swapped,
5454 associated,
5555 constant,
56− exact
56+ exact,
57+
58+ -- * Folds.
59+ bifoldr
5760 ) where
5861
5962import Control.Lens.Internal.SemiIso
6063import Control.Lens.Iso
64+import Control.Monad
6165import Data.Functor.Identity
6266import Data.Traversable
67+import Data.Foldable
6368
6469-- | A semi-isomorphism is a partial isomorphism with weakened laws.
6570--
@@ -134,3 +139,23 @@ exact x = semiIso f g
134139 f _ = Right x
135140 g y | x == y = Right ()
136141 | otherwise = Left "exact: not equal"
142+
143+-- | Constructs a bidirectional fold.
144+--
145+-- \-> Right folds using the (->) part of the given semi-iso.
146+--
147+-- \<- Right unfolds using the (<-) part of the given semi-iso.
148+bifoldr :: ASemiIso (b, a) (Maybe (b, a)) a a -> SemiIso' (a, [b]) a
149+bifoldr ai = semiIso (f ai) (g ai)
150+ where
151+ f = uncurry . foldrM . curry . apply
152+ g = unfoldrM . unapply
153+
154+ unfoldrM :: Monad m => (a -> m (Maybe (b, a))) -> a -> m (a, [b])
155+ unfoldrM f a = do
156+ r <- f a
157+ case r of
158+ Just (b, new_a) -> do
159+ (final_a, bs) <- unfoldrM f new_a
160+ return (final_a, b : bs)
161+ Nothing -> return (a, [])