git.iko.soy/typeable/wai
on master help sign in
A Monoid instance for Source
2de759dMichael
conduit/Data/Conduit.hs+26
compare with master
unifiedsplit
@@ -30,6 +30,7 @@ import qualified Data.IORef as I
30import Data.Typeable (Typeable)
30import Data.Typeable (Typeable)
31import Control.Monad (liftM)
31import Control.Monad (liftM)
32import Control.Applicative (Applicative (..))
32import Control.Applicative (Applicative (..))
33+import Data.Monoid (Monoid (mempty, mappend, mconcat))
33
34
34data Stream a = EOF | Chunks [a]
35data Stream a = EOF | Chunks [a]
35 deriving Show
36 deriving Show
@@ -48,6 +49,31 @@ data SourceInside m a = SourceInside
48 , sourcePush :: [a] -> ResourceT m ()
49 , sourcePush :: [a] -> ResourceT m ()
49 }
50 }
50newtype Source m a = Source { unSource :: ResourceT m (SourceInside m a) }
51newtype Source m a = Source { unSource :: ResourceT m (SourceInside m a) }
52+instance MonadBaseControl IO m => Monoid (Source m a) where
53+ mempty = mkSource $ return EOF
54+ mappend a b = mconcat [a, b]
55+ mconcat [] = mempty
56+ mconcat (Source mnext:rest0) = Source $ do
57+ next0 <- mnext
58+ istate <- liftBase $ I.newIORef $ Just (next0, rest0)
59+ unSource $ mkSource $ go istate
60+ where
61+ go istate = do
62+ state <- liftBase $ I.readIORef istate
63+ case state of
64+ Nothing -> return EOF
65+ Just (next, rest) -> do
66+ stream <- sourcePull next
67+ case stream of
68+ EOF ->
69+ case rest of
70+ Source a:as -> do
71+ a' <- a
72+ liftBase $ I.writeIORef istate $ Just (a', as)
73+ go istate
74+ [] -> do
75+ liftBase $ I.writeIORef istate Nothing
76+ return EOF
51
77
52type SinkInsideData a m b = Stream a -> ResourceT m (SinkResult a b)
78type SinkInsideData a m b = Stream a -> ResourceT m (SinkResult a b)
53data SinkInside a m b =
79data SinkInside a m b =
conduit/sum.hs+7−3
@@ -1,12 +1,16 @@
1import Data.Conduit
1import Data.Conduit
2import qualified Data.Conduit.List as CL
2import qualified Data.Conduit.List as CL
3import Control.Monad.Trans.Resource
3import Control.Monad.Trans.Resource
4+import Data.Monoid (mappend)
4
5
5main :: IO ()
6main :: IO ()
6main = do
7main = do
8+ runResourceT (
9+ (CL.fromList [1..5] `mappend` CL.fromList [6..10])
7− runResourceT (CL.fromList [1..10] $= CL.concatMap (replicate 2) $$ do
10+ $= CL.concatMap (replicate 2)
11+ $$ do
8− _ <- CL.take 10
12+ _ <- CL.take 10
9− CL.map (* 2) =$ sum') >>= putStrLn
13+ CL.map (* 2) =$ sum') >>= putStrLn
10
14
11sum' :: Sink Int IO String
15sum' :: Sink Int IO String
12sum' = fmap show $ CL.fold (+) 0
16sum' = fmap show $ CL.fold (+) 0