09a717c · streamly · git.iko.soy

git.iko.soy/streamly

Add take and drop operations

commit09a717ced92cc0c3aa8a6032b508c6efc7c8942d authorHarendra Kumar <harendra.kumar@gmail.com> dateMon 4 Sep 2017, 06:05 (9 years ago) parent9ddfeae

3 files changed+53

compare with master

unifiedsplit

src/Asyncly.hs+5 src/Asyncly/AsyncT.hs+23 test/Main.hs+25

src/Asyncly.hs+5

@@ -133,6 +133,10 @@ module Asyncly

133133 , parLeft

134134 , (<|)

135135

136+ -- * Transformation

137+ , take

138+ , drop

139+

136140 -- * Utilities

137141 , foldWith

138142 , foldMapWith

@@ -154,3 +158,4 @@ import Control.Applicative (Alternative(..))

154158import Control.Monad (MonadPlus(..))

155159import Control.Monad.IO.Class (liftIO)

156160import Control.Monad.Trans.Class (lift)

161+import Prelude hiding (take, drop)

src/Asyncly/AsyncT.hs+23

@@ -21,6 +21,8 @@ module Asyncly.AsyncT

2121 , MonadAsync

2222 , runAsyncly

2323 , toList

24+ , take

25+ , drop

2426 , interleave

2527 , (<=>)

2628 , parAhead

@@ -62,6 +64,7 @@ import Data.Maybe (isNothing)

6264import Data.Monoid ((<>))

6365import Data.Set (Set)

6466import qualified Data.Set as S

67+import Prelude hiding (take, drop)

6568

6669import Control.Monad.Trans.Recorder (MonadRecorder(..))

6770

@@ -590,6 +593,26 @@ toList m = run Nothing m

590593 {-# INLINE run #-}

591594 run ctx mx = (runAsyncT mx) ctx stop yield

592595

596+------------------------------------------------------------------------------

597+-- Transformation

598+------------------------------------------------------------------------------

599+

600+take :: MonadAsync m => Int -> AsyncT m a -> AsyncT m a

601+take n m = AsyncT $ \ctx stp yld -> do

602+ let yield a c Nothing = yld a c Nothing

603+ yield a c (Just x) = yld a c (Just (take (n - 1) x))

604+ if (n <= 0)

605+ then stp

606+ else (runAsyncT m) ctx stp yield

607+

608+drop :: MonadAsync m => Int -> AsyncT m a -> AsyncT m a

609+drop n m = AsyncT $ \ctx stp yld -> do

610+ let yield _ _ Nothing = stp

611+ yield _ c (Just x) = (runAsyncT $ drop (n - 1) x) c stp yld

612+ if (n <= 0)

613+ then (runAsyncT m) ctx stp yld

614+ else (runAsyncT m) ctx stp yield

615+

593616------------------------------------------------------------------------------

594617-- Utilities

595618------------------------------------------------------------------------------

test/Main.hs+25

@@ -7,6 +7,7 @@ import Control.Monad.IO.Class (liftIO)

77-- import Data.List (nub)

88import Data.List (sort)

99import Data.Monoid ((<>))

10+import Prelude hiding (take, drop)

1011import Test.Hspec

1112

1213import Asyncly

@@ -42,6 +43,8 @@ main = hspec $ do

4243 describe "Left Biased parallel loops (<|)" $ loops (<|) sort sort

4344 describe "Fair parallel loops (<|>)" $ loops (<|>) sort sort

4445

46+ describe "Transformation" $ transformOps (<>)

47+

4548bind :: Spec

4649bind = do

4750 it "Simple runAsyncly and 'then' with IO" $

@@ -122,6 +125,28 @@ loops f tsrt hsrt = do

122125 liftIO $ putStrLn "LoopTail..."

123126 return x `f` (if x < 3 then loopTail (x + 1) else empty)

124127

128+transformOps :: (AsyncT IO Int -> AsyncT IO Int -> AsyncT IO Int) -> Spec

129+transformOps f = do

130+ it "take all" $

131+ (toList $ take 10 $ foldMapWith f return [1..10])

132+ `shouldReturn` [1..10]

133+ it "take none" $

134+ (toList $ take 0 $ foldMapWith f return [1..10])

135+ `shouldReturn` []

136+ it "take 5" $

137+ (toList $ take 5 $ foldMapWith f return [1..10])

138+ `shouldReturn` [1..5]

139+

140+ it "drop all" $

141+ (toList $ drop 10 $ foldMapWith f return [1..10])

142+ `shouldReturn` []

143+ it "drop none" $

144+ (toList $ drop 0 $ foldMapWith f return [1..10])

145+ `shouldReturn` [1..10]

146+ it "drop 5" $

147+ (toList $ drop 5 $ foldMapWith f return [1..10])

148+ `shouldReturn` [6..10]

149+

125150 {-

126151 it "Alternative composition of async and sync tasks" $

127152 ((wait (threads 0 ((async (return 0) <|> return 1)))) >>= return . sort)