@@ -239,6 +239,7 @@ where
239239
240240import Control.Monad (void)
241241import Data.Bifunctor (first)
242+import Data.Either (isLeft, isRight, fromLeft, fromRight)
242243import Data.Functor.Identity (Identity(..))
243244import Data.Int (Int64)
244245import Data.Map.Strict (Map)
@@ -1162,67 +1163,10 @@ distribute = Prelude.foldr (teeWith (:)) (fromPure [])
11621163{-# INLINE partitionByM #-}
11631164partitionByM :: Monad m
11641165 => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
1165−partitionByM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1166− Fold step begin done
1167−
1168− where
1169−
1170− begin = do
1171− resL <- beginL
1172− resR <- beginR
1173− return
1174− $ case resL of
1175− Partial sL ->
1176− Partial
1177− $ case resR of
1178− Partial sR -> RunBoth sL sR
1179− Done bR -> RunLeft sL bR
1180− Done bL ->
1181− case resR of
1182− Partial sR -> Partial $ RunRight bL sR
1183− Done bR -> Done (bL, bR)
1184−
1185− step (RunBoth sL sR) a = do
1186− r <- f a
1187− case r of
1188− Left b -> do
1189− res <- stepL sL b
1190− return
1191− $ Partial
1192− $ case res of
1193− Partial sres -> RunBoth sres sR
1194− Done bres -> RunRight bres sR
1195− Right c -> do
1196− res <- stepR sR c
1197− return
1198− $ Partial
1199− $ case res of
1200− Partial sres -> RunBoth sL sres
1201− Done bres -> RunLeft sL bres
1202− step (RunLeft sL bR) a = do
1203− r <- f a
1204− case r of
1205− Left b -> do
1206− res <- stepL sL b
1207− return
1208− $ case res of
1209− Partial sres -> Partial $ RunLeft sres bR
1210− Done bres -> Done (bres, bR)
1211− Right _ -> return $ Partial $ RunLeft sL bR
1212− step (RunRight bL sR) a = do
1213− r <- f a
1214− case r of
1215− Left _ -> return $ Partial $ RunRight bL sR
1216− Right c -> do
1217− res <- stepR sR c
1218− return
1219− $ case res of
1220− Partial sres -> Partial $ RunRight bL sres
1221− Done bres -> Done (bL, bres)
1222−
1223− done (RunBoth sL sR) = (,) <$> doneL sL <*> doneR sR
1224− done (RunLeft sL bR) = (,bR) <$> doneL sL
1225− done (RunRight bL sR) = (bL,) <$> doneR sR
1166+partitionByM f fld1 fld2 =
1167+ let l = lmap (fromLeft undefined) fld1 -- :: Fold m (Either b c) x
1168+ r = lmap (fromRight undefined) fld2 -- :: Fold m (Either b c) y
1169+ in lmapM f (teeWith (,) (filter isLeft l) (filter isRight r))
12261170
12271171-- | Similar to 'partitionByM' but terminates when the first fold terminates.
12281172--
@@ -1659,60 +1603,10 @@ classify fld = classifyWith fst (lmap snd fld)
16591603{-# INLINE unzipWithM #-}
16601604unzipWithM :: Monad m
16611605 => (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
1662−unzipWithM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1663− Fold step begin done
1664−
1665− where
1666−
1667− begin = do
1668− resL <- beginL
1669− resR <- beginR
1670− return
1671− $ case resL of
1672− Partial sL ->
1673− Partial
1674− $ case resR of
1675− Partial sR -> RunBoth sL sR
1676− Done bR -> RunLeft sL bR
1677− Done bL ->
1678− case resR of
1679− Partial sR -> Partial $ RunRight bL sR
1680− Done bR -> Done (bL, bR)
1681−
1682− step (RunBoth sL sR) a = do
1683− (b, c) <- f a
1684− resL <- stepL sL b
1685− resR <- stepR sR c
1686− case resL of
1687− Partial sresL ->
1688− return
1689− $ Partial
1690− $ case resR of
1691− Partial sresR -> RunBoth sresL sresR
1692− Done bresR -> RunLeft sresL bresR
1693− Done bresL ->
1694− return
1695− $ case resR of
1696− Partial sresR -> Partial $ RunRight bresL sresR
1697− Done bresR -> Done (bresL, bresR)
1698− step (RunLeft sL bR) a = do
1699− (b, _) <- f a
1700− resL <- stepL sL b
1701− return
1702− $ case resL of
1703− Partial sresL -> Partial $ RunLeft sresL bR
1704− Done bresL -> Done (bresL, bR)
1705− step (RunRight bL sR) a = do
1706− (_, c) <- f a
1707− resR <- stepR sR c
1708− return
1709− $ case resR of
1710− Partial sresR -> Partial $ RunRight bL sresR
1711− Done bresR -> Done (bL, bresR)
1712−
1713− done (RunBoth sL sR) = (,) <$> doneL sL <*> doneR sR
1714− done (RunLeft sL bR) = (,bR) <$> doneL sL
1715− done (RunRight bL sR) = (bL,) <$> doneR sR
1606+unzipWithM f fld1 fld2 =
1607+ let f1 = lmap fst fld1 -- :: Fold m (b, c) b
1608+ f2 = lmap snd fld2 -- :: Fold m (b, c) c
1609+ in lmapM f (teeWith (,) f1 f2)
17161610
17171611-- | Similar to 'unzipWithM' but terminates when the first fold terminates.
17181612--