git.iko.soy/streamly
on master help sign in
Implement some undefined functions in Fold module
878d734Ranjeet Kumar Ranjan
benchmark/Streamly/Benchmark/Data/Fold.hs+48
compare with master
unifiedsplit
@@ -98,6 +98,14 @@ splitAllAny value =
98 (FL.any (> value))
98 (FL.any (> value))
99 )
99 )
100
100
101+{-# INLINE shortest #-}
102+shortest :: Monad m => SerialT m Int -> m (Either Int Int)
103+shortest = IP.fold (FL.shortest FL.sum FL.length)
104+
105+{-# INLINE longest #-}
106+longest :: Monad m => SerialT m Int -> m (Either Int Int)
107+longest = IP.fold (FL.longest FL.sum FL.length)
108+
101{-
109{-
102{-# INLINE split_ #-}
110{-# INLINE split_ #-}
103split_ :: Monad m
111split_ :: Monad m
@@ -127,6 +135,14 @@ teeAllAny value = IP.fold (FL.teeWith (,) all_ any_)
127 all_ = FL.all (<= value)
135 all_ = FL.all (<= value)
128 any_ = FL.any (> value)
136 any_ = FL.any (> value)
129
137
138+{-# INLINE teeWithFst #-}
139+teeWithFst :: Monad m => SerialT m Int -> m (Int, Int)
140+teeWithFst = IP.fold (FL.teeWithFst (,) FL.sum FL.length)
141+
142+{-# INLINE teeWithMin #-}
143+teeWithMin :: Monad m => SerialT m Int -> m (Int, Int)
144+teeWithMin = IP.fold (FL.teeWithMin (,) FL.sum FL.length)
145+
130{-# INLINE distribute #-}
146{-# INLINE distribute #-}
131distribute :: Monad m => SerialT m Int -> m [Int]
147distribute :: Monad m => SerialT m Int -> m [Int]
132distribute = IP.fold (FL.distribute [FL.sum, FL.length])
148distribute = IP.fold (FL.distribute [FL.sum, FL.length])
@@ -144,6 +160,18 @@ partition =
144 else Right a
160 else Right a
145 in IP.fold $ FL.lmap f (FL.partition FL.sum FL.length)
161 in IP.fold $ FL.lmap f (FL.partition FL.sum FL.length)
146
162
163+{-# INLINE partitionByFstM #-}
164+partitionByFstM :: Monad m => SerialT m Int -> m (Int, Int)
165+partitionByFstM = do
166+ let f x = if odd x then return (Left x) else return (Right x)
167+ IP.fold (FL.partitionByFstM f FL.length FL.length)
168+
169+{-# INLINE partitionByMinM #-}
170+partitionByMinM :: Monad m => SerialT m Int -> m (Int, Int)
171+partitionByMinM = do
172+ let f x = if odd x then return (Left x) else return (Right x)
173+ IP.fold (FL.partitionByMinM f FL.length FL.length)
174+
147{-# INLINE demuxWith #-}
175{-# INLINE demuxWith #-}
148demuxWith ::
176demuxWith ::
149 (Monad m, Ord k)
177 (Monad m, Ord k)
@@ -175,6 +203,18 @@ classifyWith f = S.fold (FL.classifyWith f FL.sum)
175unzip :: Monad m => SerialT m Int -> m (Int, Int)
203unzip :: Monad m => SerialT m Int -> m (Int, Int)
176unzip = IP.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)
204unzip = IP.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)
177
205
206+{-# INLINE unzipWithFstM #-}
207+unzipWithFstM :: Monad m => SerialT m Int -> m (Int, Int)
208+unzipWithFstM = do
209+ let f = \a -> return (a+1, a)
210+ IP.fold (FL.unzipWithFstM f FL.sum FL.length)
211+
212+{-# INLINE unzipWithMinM #-}
213+unzipWithMinM :: Monad m => SerialT m Int -> m (Int, Int)
214+unzipWithMinM = do
215+ let f = \a -> return (a+1, a)
216+ IP.fold (FL.unzipWithMinM f FL.sum FL.length)
217+
178-------------------------------------------------------------------------------
218-------------------------------------------------------------------------------
179-- Benchmarks
219-- Benchmarks
180-------------------------------------------------------------------------------
220-------------------------------------------------------------------------------
@@ -278,10 +318,18 @@ o_1_space_serial_composition value =
278 [ benchIOSink value "serialWith (all, any)" $ splitAllAny value
318 [ benchIOSink value "serialWith (all, any)" $ splitAllAny value
279 , benchIOSink value "tee (all, any)" $ teeAllAny value
319 , benchIOSink value "tee (all, any)" $ teeAllAny value
280 , benchIOSink value "many drain (take 1)" many
320 , benchIOSink value "many drain (take 1)" many
321+ , benchIOSink value "shortest (sum, length)" shortest
322+ , benchIOSink value "longest (sum, length)" longest
281 , benchIOSink value "tee (sum, length)" teeSumLength
323 , benchIOSink value "tee (sum, length)" teeSumLength
324+ , benchIOSink value "teeWithFst (sum, length)" teeWithFst
325+ , benchIOSink value "teeWithMin (sum, length)" teeWithMin
282 , benchIOSink value "distribute [sum, length]" distribute
326 , benchIOSink value "distribute [sum, length]" distribute
283 , benchIOSink value "partition (sum, length)" partition
327 , benchIOSink value "partition (sum, length)" partition
328+ , benchIOSink value "partitionByFstM (length, length)" partitionByFstM
329+ , benchIOSink value "partitionByMinM (length, length)" partitionByMinM
284 , benchIOSink value "unzip (sum, length)" unzip
330 , benchIOSink value "unzip (sum, length)" unzip
331+ , benchIOSink value "unzipWithFstM (sum, length)" unzipWithFstM
332+ , benchIOSink value "unzipWithMinM (sum, length)" unzipWithMinM
285 , benchIOSink value "demuxDefaultWith [sum, length] sum"
333 , benchIOSink value "demuxDefaultWith [sum, length] sum"
286 $ demuxDefaultWith fn mp
334 $ demuxDefaultWith fn mp
287 , benchIOSink value "demuxWith [sum, length]" $ demuxWith fn mp
335 , benchIOSink value "demuxWith [sum, length]" $ demuxWith fn mp
src/Streamly/Data/Fold.hs+6
@@ -241,6 +241,8 @@ module Streamly.Data.Fold
241 -- "Streamly.Internal.Data.Fold.Tee".
241 -- "Streamly.Internal.Data.Fold.Tee".
242
242
243 , teeWith
243 , teeWith
244+ --, teeWithFst
245+ --, teeWithMin
244 , tee
246 , tee
245 , distribute
247 , distribute
246
248
@@ -249,6 +251,10 @@ module Streamly.Data.Fold
249 -- fold selector.
251 -- fold selector.
250
252
251 , partition
253 , partition
254+ --, partitionByM
255+ --, partitionByFstM
256+ --, partitionByMinM
257+ --, partitionBy
252
258
253 -- ** Unzipping
259 -- ** Unzipping
254 , unzip
260 , unzip
src/Streamly/Internal/Data/Fold.hs+190−16
@@ -1225,21 +1225,111 @@ partitionByM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1225
1225
1226-- | Similar to 'partitionByM' but terminates when the first fold terminates.
1226-- | Similar to 'partitionByM' but terminates when the first fold terminates.
1227--
1227--
1228−-- /Unimplemented/
1229--
1228--
1230{-# INLINE partitionByFstM #-}
1229{-# INLINE partitionByFstM #-}
1231−partitionByFstM :: -- Monad m =>
1230+partitionByFstM :: Monad m
1232− (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
1231+ => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
1233−partitionByFstM = undefined
1232+partitionByFstM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1233+ Fold step begin done
1234+
1235+ where
1236+
1237+ begin = do
1238+ resL <- beginL
1239+ resR <- beginR
1240+ case resL of
1241+ Partial sL -> return $
1242+ case resR of
1243+ Partial sR -> Partial $ RunFstBoth sL sR
1244+ Done bR -> Partial $ RunFstLeft sL bR
1245+ Done bL -> do
1246+ case resR of
1247+ Partial sR -> do
1248+ bR <- doneR sR
1249+ return $ Done (bL, bR)
1250+ Done bR -> return $ Done (bL, bR)
1251+
1252+ step (RunFstBoth sL sR) a = do
1253+ r <- f a
1254+ case r of
1255+ Left b -> do
1256+ res <- stepL sL b
1257+ case res of
1258+ Partial sres -> return $ Partial $ RunFstBoth sres sR
1259+ Done bL -> do
1260+ bR <- doneR sR
1261+ return $ Done (bL, bR)
1262+
1263+ Right c -> do
1264+ res <- stepR sR c
1265+ return
1266+ $ Partial
1267+ $ case res of
1268+ Partial sres -> RunFstBoth sL sres
1269+ Done bres -> RunFstLeft sL bres
1270+ step (RunFstLeft sL bR) a = do
1271+ r <- f a
1272+ case r of
1273+ Left b -> do
1274+ res <- stepL sL b
1275+ return
1276+ $ case res of
1277+ Partial sres -> Partial $ RunFstLeft sres bR
1278+ Done bres -> Done (bres, bR)
1279+ Right _ -> return $ Partial $ RunFstLeft sL bR
1280+
1281+ done (RunFstBoth sL sR) = (,) <$> doneL sL <*> doneR sR
1282+
1283+ done (RunFstLeft sL bR) = (,bR) <$> doneL sL
1234
1284
1235-- | Similar to 'partitionByM' but terminates when any fold terminates.
1285-- | Similar to 'partitionByM' but terminates when any fold terminates.
1236--
1286--
1237−-- /Unimplemented/
1238--
1287--
1239{-# INLINE partitionByMinM #-}
1288{-# INLINE partitionByMinM #-}
1240−partitionByMinM :: -- Monad m =>
1289+partitionByMinM :: Monad m =>
1241− (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
1290+ (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
1242−partitionByMinM = undefined
1291+partitionByMinM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1292+ Fold step begin done
1293+
1294+ where
1295+
1296+ begin = do
1297+ resL <- beginL
1298+ resR <- beginR
1299+ case resL of
1300+ Partial sL ->
1301+ case resR of
1302+ Partial sR -> return $ Partial $ Tuple' sL sR
1303+ Done bR -> do
1304+ bL <- doneL sL
1305+ return $ Done (bL, bR)
1306+ Done bL -> do
1307+ case resR of
1308+ Partial sR -> do
1309+ bR <- doneR sR
1310+ return $ Done (bL, bR)
1311+ Done bR -> return $ Done (bL, bR)
1312+
1313+ step (Tuple' sL sR) a = do
1314+ r <- f a
1315+ case r of
1316+ Left b -> do
1317+ res <- stepL sL b
1318+ case res of
1319+ Partial sres -> return $ Partial $ Tuple' sres sR
1320+ Done bL -> do
1321+ bR <- doneR sR
1322+ return $ Done (bL, bR)
1323+
1324+ Right c -> do
1325+ res <- stepR sR c
1326+ case res of
1327+ Partial sres -> return $ Partial $ Tuple' sL sres
1328+ Done bR -> do
1329+ bL <- doneL sL
1330+ return $ Done (bL, bR)
1331+
1332+ done (Tuple' sL sR) = (,) <$> doneL sL <*> doneR sR
1243
1333
1244-- Note: we could use (a -> Bool) instead of (a -> Either b c), but the latter
1334-- Note: we could use (a -> Bool) instead of (a -> Either b c), but the latter
1245-- makes the signature clearer as to which case belongs to which fold.
1335-- makes the signature clearer as to which case belongs to which fold.
@@ -1625,21 +1715,105 @@ unzipWithM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1625
1715
1626-- | Similar to 'unzipWithM' but terminates when the first fold terminates.
1716-- | Similar to 'unzipWithM' but terminates when the first fold terminates.
1627--
1717--
1628−-- /Unimplemented/
1629--
1718--
1630{-# INLINE unzipWithFstM #-}
1719{-# INLINE unzipWithFstM #-}
1631−unzipWithFstM :: -- Monad m =>
1720+unzipWithFstM :: Monad m =>
1632− (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
1721+ (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
1633−unzipWithFstM = undefined
1722+unzipWithFstM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1723+ Fold step begin done
1724+
1725+ where
1726+
1727+ begin = do
1728+ resL <- beginL
1729+ resR <- beginR
1730+ case resL of
1731+ Partial sL -> return $ Partial $
1732+ case resR of
1733+ Partial sR -> RunFstBoth sL sR
1734+ Done bR -> RunFstLeft sL bR
1735+ Done bL -> do
1736+ case resR of
1737+ Partial sR -> do
1738+ bR <- doneR sR
1739+ return $ Done (bL, bR)
1740+ Done bR -> return $ Done (bL, bR)
1741+
1742+ step (RunFstBoth sL sR) a = do
1743+ (b, c) <- f a
1744+ resL <- stepL sL b
1745+ resR <- stepR sR c
1746+ case resL of
1747+ Partial sresL -> return $ Partial $
1748+ case resR of
1749+ Partial sresR -> RunFstBoth sresL sresR
1750+ Done bresR -> RunFstLeft sresL bresR
1751+ Done bL -> do
1752+ case resR of
1753+ Partial sresR -> do
1754+ bR <- doneR sresR
1755+ return $ Done (bL, bR)
1756+ Done bR -> return $ Done (bL, bR)
1757+
1758+ step (RunFstLeft sL bR) a = do
1759+ (b, _) <- f a
1760+ resL <- stepL sL b
1761+ return
1762+ $ case resL of
1763+ Partial sresL -> Partial $ RunFstLeft sresL bR
1764+ Done bresL -> Done (bresL, bR)
1765+
1766+ done (RunFstBoth sL sR) = (,) <$> doneL sL <*> doneR sR
1767+ done (RunFstLeft sL bR) = (,bR) <$> doneL sL
1634
1768
1635-- | Similar to 'unzipWithM' but terminates when any fold terminates.
1769-- | Similar to 'unzipWithM' but terminates when any fold terminates.
1636--
1770--
1637−-- /Unimplemented/
1638--
1771--
1639{-# INLINE unzipWithMinM #-}
1772{-# INLINE unzipWithMinM #-}
1640−unzipWithMinM :: -- Monad m =>
1773+unzipWithMinM :: Monad m =>
1641− (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
1774+ (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
1642−unzipWithMinM = undefined
1775+unzipWithMinM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1776+ Fold step begin done
1777+
1778+ where
1779+
1780+ begin = do
1781+ resL <- beginL
1782+ resR <- beginR
1783+ case resL of
1784+ Partial sL ->
1785+ case resR of
1786+ Partial sR -> return $ Partial $ Tuple' sL sR
1787+ Done bR -> do
1788+ bL <- doneL sL
1789+ return $ Done (bL, bR)
1790+ Done bL -> do
1791+ case resR of
1792+ Partial sR -> do
1793+ bR <- doneR sR
1794+ return $ Done (bL, bR)
1795+ Done bR -> return $ Done (bL, bR)
1796+
1797+ step (Tuple' sL sR) a = do
1798+ (b, c) <- f a
1799+ resL <- stepL sL b
1800+ resR <- stepR sR c
1801+ case resL of
1802+ Partial sresL ->
1803+ case resR of
1804+ Partial sresR -> return $ Partial $ Tuple' sresL sresR
1805+ Done bR -> do
1806+ bL <- doneL sL
1807+ return $ Done (bL, bR)
1808+ Done bL -> do
1809+ case resR of
1810+ Partial sresR -> do
1811+ bR <- doneR sresR
1812+ return $ Done (bL, bR)
1813+ Done bR -> return $ Done (bL, bR)
1814+
1815+ done (Tuple' sL sR) = (,) <$> doneL sL <*> doneR sR
1816+
1643
1817
1644-- | Split elements in the input stream into two parts using a pure splitter
1818-- | Split elements in the input stream into two parts using a pure splitter
1645-- function, direct each part to a different fold and zip the results.
1819-- function, direct each part to a different fold and zip the results.
src/Streamly/Internal/Data/Fold/Type.hs+238−19
@@ -236,6 +236,7 @@ module Streamly.Internal.Data.Fold.Type
236
236
237 -- ** Parallel Distribution
237 -- ** Parallel Distribution
238 , GenericRunner(..)
238 , GenericRunner(..)
239+ , FstRunner(..)
239 , teeWith
240 , teeWith
240 , teeWithFst
241 , teeWithFst
241 , teeWithMin
242 , teeWithMin
@@ -708,12 +709,44 @@ serialWith func (Fold stepL initialL extractL) (Fold stepR initialR extractR) =
708-- | Same as applicative '*>'. Run two folds serially one after the other
709-- | Same as applicative '*>'. Run two folds serially one after the other
709-- discarding the result of the first.
710-- discarding the result of the first.
710--
711--
711−-- /Unimplemented/
712−--
713{-# INLINE serial_ #-}
712{-# INLINE serial_ #-}
714−serial_ :: -- Monad m =>
713+serial_ :: Monad m =>
715 Fold m x a -> Fold m x b -> Fold m x b
714 Fold m x a -> Fold m x b -> Fold m x b
716−serial_ _f1 _f2 = undefined
715+serial_ (Fold stepL initialL _) (Fold stepR initialR extractR) =
716+ Fold step initial extract
717+
718+ where
719+
720+ func _ b = b
721+
722+ initial = do
723+ resL <- initialL
724+ case resL of
725+ Partial sl -> return $ Partial $ SeqFoldL sl
726+ Done bl -> do
727+ resR <- initialR
728+ return $ first (SeqFoldR (func bl)) resR
729+
730+ step (SeqFoldL st) a = do
731+ r <- stepL st a
732+ case r of
733+ Partial s -> return $ Partial (SeqFoldL s)
734+ Done b -> do
735+ res <- initialR
736+ return $ first (SeqFoldR (func b)) res
737+ step (SeqFoldR f st) a = do
738+ r <- stepR st a
739+ return $
740+ case r of
741+ Partial s -> Partial (SeqFoldR f s)
742+ Done b -> Done b
743+
744+ extract (SeqFoldR _ sR) = extractR sR
745+ extract (SeqFoldL _) = do
746+ res <- initialR
747+ case res of
748+ Partial sR -> extractR sR
749+ Done rR -> return rR
717
750
718{-# ANN type GenericRunner Fuse #-}
751{-# ANN type GenericRunner Fuse #-}
719data GenericRunner sL sR bL bR
752data GenericRunner sL sR bL bR
@@ -721,6 +754,11 @@ data GenericRunner sL sR bL bR
721 | RunLeft !sL !bR
754 | RunLeft !sL !bR
722 | RunRight !bL !sR
755 | RunRight !bL !sR
723
756
757+{-# ANN type FstRunner Fuse #-}
758+data FstRunner sL sR b
759+ = RunFstBoth !sL !sR
760+ | RunFstLeft !sL !b
761+
724-- | @teeWith k f1 f2@ distributes its input to both @f1@ and @f2@ until both
762-- | @teeWith k f1 f2@ distributes its input to both @f1@ and @f2@ until both
725-- of them terminate and combines their output using @k@.
763-- of them terminate and combines their output using @k@.
726--
764--
@@ -797,42 +835,223 @@ teeWith f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
797
835
798-- | Like 'teeWith' but terminates as soon as the first fold terminates.
836-- | Like 'teeWith' but terminates as soon as the first fold terminates.
799--
837--
800−-- /Unimplemented/
838+-- /Pre-release/
801--
839--
802{-# INLINE teeWithFst #-}
840{-# INLINE teeWithFst #-}
803−teeWithFst :: (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d
841+teeWithFst :: Monad m => (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d
804−teeWithFst = undefined
842+teeWithFst f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
843+ Fold step begin done
844+
845+ where
846+
847+ begin = do
848+ resL <- beginL
849+ resR <- beginR
850+
851+ case resL of
852+ Partial sl ->
853+ return $ Partial $
854+ case resR of
855+ Partial sr -> RunFstBoth sl sr
856+ Done br -> RunFstLeft sl br
857+ Done bl -> do
858+ case resR of
859+ Partial sr -> do
860+ br <- doneR sr
861+ return $ Done $ f bl br
862+ Done br -> return $ Done $ f bl br
863+
864+ step (RunFstBoth sL sR) a = do
865+ resL <- stepL sL a
866+ resR <- stepR sR a
867+ case resL of
868+ Partial sL1 ->
869+ return
870+ $ Partial
871+ $ case resR of
872+ Partial sR1 -> RunFstBoth sL1 sR1
873+ Done bR -> RunFstLeft sL1 bR
874+ Done bL ->
875+ case resR of
876+ Partial sR1 -> do
877+ br <- doneR sR1
878+ return $ Done $ f bL br
879+ Done bR -> return $ Done $ f bL bR
880+
881+ step (RunFstLeft sL bR) a = do
882+ resL <- stepL sL a
883+ return
884+ $ case resL of
885+ Partial sL1 -> Partial $ RunFstLeft sL1 bR
886+ Done bL -> Done $ f bL bR
887+
888+ done (RunFstBoth sL sR) = do
889+ bL <- doneL sL
890+ bR <- doneR sR
891+ return $ f bL bR
892+ done (RunFstLeft sL bR) = do
893+ bL <- doneL sL
894+ return $ f bL bR
805
895
806-- | Like 'teeWith' but terminates as soon as any one of the two folds
896-- | Like 'teeWith' but terminates as soon as any one of the two folds
807-- terminates.
897-- terminates.
808--
898--
809−-- /Unimplemented/
899+-- /Pre-release/
810--
900--
811{-# INLINE teeWithMin #-}
901{-# INLINE teeWithMin #-}
812−teeWithMin :: (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d
902+teeWithMin :: Monad m => (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d
813−teeWithMin = undefined
903+teeWithMin f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
904+ Fold step begin done
905+
906+ where
907+
908+ begin = do
909+ resL <- beginL
910+ resR <- beginR
911+ case resL of
912+ Partial sL1 -> do
913+ case resR of
914+ Partial sR1 -> return $ Partial $ Tuple' sL1 sR1
915+ Done br -> do
916+ bl <- doneL sL1
917+ return $ Done $ f bl br
918+
919+ Done bl -> do
920+ case resR of
921+ Partial sr -> do
922+ br <- doneR sr
923+ return $ Done $ f bl br
924+ Done br -> return $ Done $ f bl br
925+
926+ step (Tuple' sL sR) a = do
927+ resL <- stepL sL a
928+ resR <- stepR sR a
929+ case resL of
930+ Partial sL1 ->
931+ case resR of
932+ Partial sR1 -> return $ Partial $ Tuple' sL1 sR1
933+ Done bR -> do
934+ bL <- doneL sL1
935+ return $ Done $ f bL bR
936+ Done bL ->
937+ case resR of
938+ Partial sR1 -> do
939+ br <- doneR sR1
940+ return $ Done $ f bL br
941+ Done bR -> return $ Done $ f bL bR
942+
943+ done (Tuple' sL sR) = do
944+ bL <- doneL sL
945+ bR <- doneR sR
946+ return $ f bL bR
814
947
815-- | Shortest alternative. Apply both folds in parallel but choose the result
948-- | Shortest alternative. Apply both folds in parallel but choose the result
816-- from the one which consumed least input i.e. take the shortest succeeding
949-- from the one which consumed least input i.e. take the shortest succeeding
817-- fold.
950-- fold.
818--
951--
819−-- /Unimplemented/
952+-- /Pre-release/
820--
953--
821{-# INLINE shortest #-}
954{-# INLINE shortest #-}
822−shortest :: -- Monad m =>
823− Fold m x a -> Fold m x a -> Fold m x a
955+shortest :: Monad m => Fold m x a -> Fold m x b -> Fold m x (Either a b)
824−shortest _f1 _f2 = undefined
956+shortest (Fold stepL beginL doneL) (Fold stepR beginR _) =
957+ Fold step begin done
958+
959+ where
960+
961+ begin = do
962+ resL <- beginL
963+ resR <- beginR
964+ return $
965+ case resL of
966+ Partial sL ->
967+ case resR of
968+ Partial sR -> Partial $ Tuple' sL sR
969+ Done bR -> Done $ Right bR
970+ Done bL -> Done $ Left bL
971+
972+ step (Tuple' sL sR) a = do
973+ resL <- stepL sL a
974+ resR <- stepR sR a
975+ return $
976+ case resL of
977+ Partial sL1 ->
978+ case resR of
979+ Partial sR1 -> Partial $ Tuple' sL1 sR1
980+ Done bR -> Done $ Right bR
981+ Done bL -> Done $ Left bL
982+
983+ done (Tuple' sL _) = do
984+ x <- doneL sL
985+ return $ Left x
986+
987+{-# ANN type LongestRunner Fuse #-}
988+data LongestRunner sL sR bL bR
989+ = LongestRunBoth !sL !sR
990+ | LongestRunLeft !sL !bR
991+ | LongestRunRight !bL !sR
825
992
826-- | Longest alternative. Apply both folds in parallel but choose the result
993-- | Longest alternative. Apply both folds in parallel but choose the result
827-- from the one which consumed more input i.e. take the longest succeeding
994-- from the one which consumed more input i.e. take the longest succeeding
828-- fold.
995-- fold.
829--
996--
830−-- /Unimplemented/
997+-- /Pre-release/
831--
998--
832−{-# INLINE longest #-}
833−longest :: -- Monad m =>
834− Fold m x a -> Fold m x a -> Fold m x a
999+longest :: Monad m => Fold m x a -> Fold m x b -> Fold m x (Either a b)
835−longest _f1 _f2 = undefined
1000+longest (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1001+ Fold step begin done
1002+
1003+ where
1004+
1005+ begin = do
1006+ resL <- beginL
1007+ resR <- beginR
1008+ return $
1009+ case resL of
1010+ Partial sL ->
1011+ Partial $
1012+ case resR of
1013+ Partial sR -> LongestRunBoth sL sR
1014+ Done bR -> LongestRunLeft sL bR
1015+ Done bL ->
1016+ case resR of
1017+ Partial sR -> Partial $ LongestRunRight bL sR
1018+ Done bR -> Done $ Right bR
1019+
1020+ step (LongestRunBoth sL sR) a = do
1021+ resL <- stepL sL a
1022+ resR <- stepR sR a
1023+ case resL of
1024+ Partial sL1 ->
1025+ return
1026+ $ Partial
1027+ $ case resR of
1028+ Partial sR1 -> LongestRunBoth sL1 sR1
1029+ Done bR -> LongestRunLeft sL1 bR
1030+ Done bL ->
1031+ return
1032+ $ case resR of
1033+ Partial sR1 -> Partial $ LongestRunRight bL sR1
1034+ Done bR -> Done $ Right bR
1035+
1036+ step (LongestRunLeft sL bR) a = do
1037+ resL <- stepL sL a
1038+ return $
1039+ case resL of
1040+ Partial sL1 -> Partial $ LongestRunLeft sL1 bR
1041+ Done bL -> Done $ Left bL
1042+
1043+ step (LongestRunRight bL sR) a = do
1044+ resR <- stepR sR a
1045+ return
1046+ $ case resR of
1047+ Partial sR1 -> Partial $ LongestRunRight bL sR1
1048+ Done bR -> Done $ Right bR
1049+
1050+ done (LongestRunLeft sL _) = Left <$> doneL sL
1051+
1052+ done (LongestRunRight _ sR) = Right <$> doneR sR
1053+
1054+ done (LongestRunBoth sL _) = Left <$> doneL sL
836
1055
837data ConcatMapState m sa a c
1056data ConcatMapState m sa a c
838 = B !sa
1057 = B !sa
test/Streamly/Test/Data/Fold.hs+102−17
@@ -377,6 +377,101 @@ teeWithLength =
377 v3 = Prelude.length ls
377 v3 = Prelude.length ls
378 assert (v1 == (v2, v3))
378 assert (v1 == (v2, v3))
379
379
380+teeWithFstLength :: Property
381+teeWithFstLength =
382+ forAll (listOf1 (chooseInt (intMin, intMax)))
383+ $ \ls0 -> monadicIO $ action ls0
384+
385+ where
386+
387+ action ls = do
388+ v1 <- run $ S.fold (F.teeWithFst (,) (FL.take 5 FL.sum) FL.length) $ S.fromList ls
389+ let v2 = Prelude.sum (Prelude.take 5 ls)
390+ v3 = Prelude.length (Prelude.take 5 ls)
391+ assert (v1 == (v2, v3))
392+
393+partitionByM :: Property
394+partitionByM =
395+ forAll (listOf1 (chooseInt (intMin, intMax)))
396+ $ \ls0 -> monadicIO $ action ls0
397+
398+ where
399+
400+ action ls = do
401+ let f = \x -> if odd x then return (Left x) else return (Right x)
402+ v1 <- run $ S.fold (F.partitionByM f FL.length FL.length) $ S.fromList ls
403+ let v2 = foldl (\b a -> if odd a then b+1 else b) 0 ls
404+ v3 = foldl (\b a -> if even a then b+1 else b) 0 ls
405+ assert (v1 == (v2, v3))
406+
407+partitionByFstM :: Property
408+partitionByFstM =
409+ forAll (listOf1 (chooseInt (intMin, intMax)))
410+ $ \ls0 -> monadicIO $ action ls0
411+
412+ where
413+
414+ action _ = do
415+ let f = \x -> if odd x then return (Left x) else return (Right x)
416+ v1 <- run $ S.fold (F.partitionByFstM f (FL.take 25 FL.length) FL.length) (S.fromList ([1..100]:: [Int]))
417+ let v2 = foldl (\b a -> if odd a then b+1 else b) 0 ([1..49] :: [Int])
418+ v3 = foldl (\b a -> if even a then b+1 else b) 0 ([1..49] :: [Int])
419+ assert (v1 == (v2, v3))
420+
421+partitionByMinM1 :: Property
422+partitionByMinM1 =
423+ forAll (listOf1 (chooseInt (intMin, intMax)))
424+ $ \ls0 -> monadicIO $ action ls0
425+
426+ where
427+
428+ action _ = do
429+ let f = \x -> if odd x then return (Left x) else return (Right x)
430+ v1 <- run $ S.fold (F.partitionByMinM f FL.length (FL.take 25 FL.length)) (S.fromList ([1..100]:: [Int]))
431+ let v2 = foldl (\b a -> if odd a then b+1 else b) 0 ([1..50] :: [Int])
432+ v3 = foldl (\b a -> if even a then b+1 else b) 0 ([1..50] :: [Int])
433+ assert (v1 == (v2, v3))
434+
435+partitionByMinM2 :: Property
436+partitionByMinM2 =
437+ forAll (listOf1 (chooseInt (intMin, intMax)))
438+ $ \ls0 -> monadicIO $ action ls0
439+
440+ where
441+
442+ action _ = do
443+ let f = \x -> if odd x then return (Left x) else return (Right x)
444+ v1 <- run $ S.fold (F.partitionByMinM f (FL.take 25 FL.length) FL.length) (S.fromList ([1..100]:: [Int]))
445+ let v2 = foldl (\b a -> if odd a then b+1 else b) 0 ([1..49] :: [Int])
446+ v3 = foldl (\b a -> if even a then b+1 else b) 0 ([1..49] :: [Int])
447+ assert (v1 == (v2, v3))
448+
449+teeWithMinLength1 :: Property
450+teeWithMinLength1 =
451+ forAll (listOf1 (chooseInt (intMin, intMax)))
452+ $ \ls0 -> monadicIO $ action ls0
453+
454+ where
455+
456+ action ls = do
457+ v1 <- run $ S.fold (F.teeWithMin (,) (FL.take 5 FL.sum) FL.length) $ S.fromList ls
458+ let v2 = Prelude.sum (Prelude.take 5 ls)
459+ v3 = Prelude.length (Prelude.take 5 ls)
460+ assert (v1 == (v2, v3))
461+
462+
463+teeWithMinLength2 :: Property
464+teeWithMinLength2 =
465+ forAll (listOf1 (chooseInt (intMin, intMax)))
466+ $ \ls0 -> monadicIO $ action ls0
467+
468+ where
469+
470+ action ls = do
471+ v1 <- run $ S.fold (F.teeWithMin (,) FL.sum (FL.take 5 FL.length)) $ S.fromList ls
472+ let v2 = Prelude.sum (Prelude.take 5 ls)
473+ v3 = Prelude.length (Prelude.take 5 ls)
474+ assert (v1 == (v2, v3))
380teeWithMax :: Property
475teeWithMax :: Property
381teeWithMax =
476teeWithMax =
382 forAll (listOf1 (chooseInt (intMin, intMax)))
477 forAll (listOf1 (chooseInt (intMin, intMax)))
@@ -451,23 +546,6 @@ headAndRest ls = monadicIO $ do
451 taill [] = []
546 taill [] = []
452 taill (_:xs) = xs
547 taill (_:xs) = xs
453
548
454−partitionByM :: Property
455−partitionByM =
456− forAll (listOf1 (chooseInt (intMin, intMax)))
457− $ \ls0 -> monadicIO $ action ls0
458−
459− where
460−
461− action ls = do
462− let f = \x -> if odd x then return (Left x) else return (Right x)
463− v1 <-
464− run
465− $ S.fold (F.partitionByM f FL.length FL.length)
466− $ S.fromList ls
467− let v2 = Prelude.length $ filter odd ls
468− v3 = Prelude.length $ filter even ls
469− assert (v1 == (v2, v3))
470−
471demux :: Expectation
549demux :: Expectation
472demux =
550demux =
473 let table = Data.Map.fromList [("SUM", FL.sum), ("PRODUCT", FL.product)]
551 let table = Data.Map.fromList [("SUM", FL.sum), ("PRODUCT", FL.product)]
@@ -667,7 +745,14 @@ main = hspec $ do
667 -- Distributing
745 -- Distributing
668 -- tee
746 -- tee
669 prop "teeWithLength" Main.teeWithLength
747 prop "teeWithLength" Main.teeWithLength
748+ prop "teeWithFstLength" Main.teeWithFstLength
749+ prop "teeWithMinLength1" Main.teeWithMinLength1
750+ prop "teeWithMinLength2" Main.teeWithMinLength2
670 prop "teeWithMax" Main.teeWithMax
751 prop "teeWithMax" Main.teeWithMax
752+ prop "partitionByM" Main.partitionByM
753+ prop "partitionByFstM" Main.partitionByFstM
754+ prop "partitionByMinM1" Main.partitionByMinM1
755+ prop "partitionByMinM2" Main.partitionByMinM2
671 prop "distribute" Main.distribute
756 prop "distribute" Main.distribute
672
757
673 -- Partitioning
758 -- Partitioning