09a717c · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add take and drop operations

09a717cHarendra Kumar9 years ago

src/Asyncly.hs+5

compare with master

unifiedsplit

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

133 , parLeft

134 , (<|)

135

136+ -- * Transformation

137+ , take

138+ , drop

139+

136 -- * Utilities

140 -- * Utilities

137 , foldWith

141 , foldWith

138 , foldMapWith

142 , foldMapWith

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

154import Control.Monad (MonadPlus(..))

158import Control.Monad (MonadPlus(..))

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

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

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

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

161+import Prelude hiding (take, drop)

src/Asyncly/AsyncT.hs+23

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

21 , MonadAsync

22 , runAsyncly

23 , toList

24+ , take

25+ , drop

24 , interleave

26 , interleave

25 , (<=>)

27 , (<=>)

26 , parAhead

28 , parAhead

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

62import Data.Monoid ((<>))

64import Data.Monoid ((<>))

63import Data.Set (Set)

65import Data.Set (Set)

64import qualified Data.Set as S

66import qualified Data.Set as S

67+import Prelude hiding (take, drop)

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

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

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

590 {-# INLINE run #-}

593 {-# INLINE run #-}

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

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

592

595

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+

593------------------------------------------------------------------------------

616------------------------------------------------------------------------------

594-- Utilities

617-- Utilities

595------------------------------------------------------------------------------

618------------------------------------------------------------------------------

test/Main.hs+25

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

7-- import Data.List (nub)

8import Data.List (sort)

9import Data.Monoid ((<>))

10+import Prelude hiding (take, drop)

10import Test.Hspec

11import Test.Hspec

12import Asyncly

13import Asyncly

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

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

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

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

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

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

47+

45bind :: Spec

48bind :: Spec

46bind = do

49bind = do

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

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

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

122 liftIO $ putStrLn "LoopTail..."

125 liftIO $ putStrLn "LoopTail..."

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

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

124

127

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+

125 {-

150 {-

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

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

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

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