9fca294 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add concatMapTreeWith combinator

9fca294Harendra Kumar7 years ago

examples/ListDir.hs+12−12

compare with master

unifiedsplit

@@ -1,8 +1,11 @@

1+module Main (main) where

1import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))

3import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))

2−import Streamly (aheadly, ahead, AheadT)

4+import Streamly (async)

3import Data.Function ((&))

5import Data.Function ((&))

5import qualified Streamly.Prelude as S

7import qualified Streamly.Prelude as S

8+import qualified Streamly.Internal.Prelude as S

6import qualified Streamly.Internal.FileSystem.Dir as Dir

9import qualified Streamly.Internal.FileSystem.Dir as Dir

8-- | List the current directory recursively using concurrent processing

11-- | List the current directory recursively using concurrent processing

@@ -10,21 +13,18 @@ import qualified Streamly.Internal.FileSystem.Dir as Dir

10main :: IO ()

13main :: IO ()

11main = do

14main = do

12 hSetBuffering stdout LineBuffering

15 hSetBuffering stdout LineBuffering

13− S.mapM_ print $ aheadly $ recursePath (Left ".")

14−

15− where

16−

17 -- XXX Fix bug in enqueueAhead when mixing serial with ahead:

16 -- XXX Fix bug in enqueueAhead when mixing serial with ahead:

18 -- (\x -> S.yield dir <> S.concatMapWith ahead recursePath x)

17 -- (\x -> S.yield dir <> S.concatMapWith ahead recursePath x)

19 -- :: SerialT IO String

18 -- :: SerialT IO String

20 -- or S.cons dir . S.concatMapWith ahead recursePath

19 -- or S.cons dir . S.concatMapWith ahead recursePath

21− recursePath :: Either String String -> AheadT IO String

20+ S.mapM_ print $ S.concatMapTreeWith async listDir

22− recursePath (Left dir) =

21+ (S.yieldM $ return (Left "."))

22+

23+ where

24+

25+ listDir dir =

23− Dir.toEither dir -- SerialT IO (Either String String)

26+ Dir.toEither dir -- SerialT IO (Either String String)

24− & S.map (prefixDir dir) -- SerialT IO (Either String String)

27+ & S.map (prefixDir dir) -- SerialT IO (Either String String)

25− & S.consM (return dir)

26− . S.concatMapWith ahead recursePath -- SerialT IO String

27− recursePath (Right file) = S.yield file -- SerialT IO String

29 prefixDir :: String -> Either String String -> Either String String

30 prefixDir dir (Right x) = Right $ dir ++ "/" ++ x

src/Streamly/Internal/Prelude.hs+67

@@ -271,6 +271,7 @@ module Streamly.Internal.Prelude

271 , intercalateSuffix

272 , interpose

273 , interposeSuffix

274+ , concatMapTreeWith

274

275

275 -- -- ** Breaking

276 -- -- ** Breaking

276

277

@@ -2614,6 +2615,72 @@ interposeSuffix :: (IsStream t, Monad m)

2614interposeSuffix x unf str =

2615interposeSuffix x unf str =

2615 D.fromStreamD $ D.interposeSuffix (return x) unf (D.toStreamD str)

2616 D.fromStreamD $ D.interposeSuffix (return x) unf (D.toStreamD str)

2616

2617

2618+------------------------------------------------------------------------------

2619+-- Flattening Trees

2620+------------------------------------------------------------------------------

2621+

2622+-- | Traverse a forest with recursive tree structures whose non-leaf nodes are

2623+-- of type @a@ and leaf nodes are of type @b@, flattening all the trees into

2624+-- streams and combining the streams into a single stream consisting of both

2625+-- leaf and non-leaf nodes.

2626+--

2627+-- 'concatMapTreeWith' is a generalization of 'concatMap', using a recursive

2628+-- feedback loop to append the non-leaf nodes back to the input stream enabling

2629+-- recursive traversal. 'concatMap' flattens a single level nesting whereas

2630+-- 'concatMapTreeWith' flattens a recursively nested structure.

2631+--

2632+-- Traversing a directory tree recursively is a canonical use case of

2633+-- 'concatMapTreeWith'.

2634+--

2635+-- /Internal/

2636+--

2637+{-# INLINE concatMapTreeWith #-}

2638+concatMapTreeWith

2639+ :: IsStream t

2640+ => (forall c. t m c -> t m c -> t m c)

2641+ -> (a -> t m (Either a b))

2642+ -> t m (Either a b)

2643+ -> t m (Either a b)

2644+concatMapTreeWith combine f xs = concatMapWith combine go xs

2645+ where

2646+ go (Left tree) = Left tree `K.cons` concatMapWith combine go (f tree)

2647+ go (Right leaf) = yield $ Right leaf

2648+

2649+{-

2650+-- | Like concatMapTreeWith but produces only stream of leaf elements.

2651+--

2652+{-# INLINE concatMapLeavesWith #-}

2653+concatMapLeavesWith :: (IsStream t, MonadAsync m)

2654+ => _ -> (a -> t m (Either a b)) -> t m (Either a b) -> t m b

2655+concatMapLeavesWith combine f xs = undefined

2656+-}

2657+

2658+{-

2659+{-# INLINE concatUnfoldTree #-}

2660+concatUnfoldTree :: (IsStream t, MonadAsync m)

2661+ => Unfold m a (Either a b) -> t m (Either a b) -> t m (Either a b)

2662+concatUnfoldTree unf xs = undefined

2663+

2664+------------------------------------------------------------------------------

2665+-- Feedback loop

2666+------------------------------------------------------------------------------

2667+

2668+-- Flatten a stream with a feedback loop back into the input. For example, if

2669+-- the output stream may generate an exception the exceptions can be fed back

2670+-- to the input to take any corrective action. For example, we may retry the

2671+-- action again or do nothing or log the errors. For the retry case we need a

2672+-- feedback loop.

2673+--

2674+-- We can perhaps even implement the SVar using this. The stream we are mapping

2675+-- on is the work queue. When evaluated it results in either a leaf element to

2676+-- yield or a tail stream to queue back to the work queue.

2677+--

2678+{-# INLINE concatMapLoopWith #-}

2679+concatMapLoopWith :: (IsStream t, MonadAsync m)

2680+ => _ -> (a -> t m (Either b c)) -> (b -> t m a) -> t m a -> t m c

2681+concatMapLoopWith combine f xs = undefined

2682+-}

2683+

2617------------------------------------------------------------------------------

2684------------------------------------------------------------------------------

2618-- Grouping/Splitting

2685-- Grouping/Splitting

2619------------------------------------------------------------------------------

2686------------------------------------------------------------------------------