@@ -30,6 +30,7 @@ import qualified Data.IORef as I
3030import Data.Typeable (Typeable)
3131import Control.Monad (liftM)
3232import Control.Applicative (Applicative (..))
33+import Data.Monoid (Monoid (mempty, mappend, mconcat))
3334
3435data Stream a = EOF | Chunks [a]
3536 deriving Show
@@ -48,6 +49,31 @@ data SourceInside m a = SourceInside
4849 , sourcePush :: [a] -> ResourceT m ()
4950 }
5051newtype 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
5177
5278type SinkInsideData a m b = Stream a -> ResourceT m (SinkResult a b)
5379data SinkInside a m b =