module HaskellWorks.Data.ByteString.Builder
  ( chainInterleaveIO
  ) where

import Data.Function

import qualified Data.ByteString      as BS
import qualified Data.ByteString.Lazy as LBS
import qualified System.IO.Unsafe     as IO

chainInterleaveIO :: [IO LBS.ByteString] -> IO LBS.ByteString
chainInterleaveIO :: [IO ByteString] -> IO ByteString
chainInterleaveIO [IO ByteString]
iobs = [ByteString] -> ByteString
LBS.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([] forall a b. a -> (a -> b) -> b
&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO ([ByteString] -> [ByteString])]
-> IO ([ByteString] -> [ByteString])
go [IO ([ByteString] -> [ByteString])]
diobs
  where diobs :: [IO ([BS.ByteString] -> [BS.ByteString])]
        diobs :: [IO ([ByteString] -> [ByteString])]
diobs = (forall a. [a] -> [a] -> [a]
(++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
LBS.toChunks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO ByteString]
iobs
        go :: [IO ([BS.ByteString] -> [BS.ByteString])] -> IO ([BS.ByteString] -> [BS.ByteString])
        go :: [IO ([ByteString] -> [ByteString])]
-> IO ([ByteString] -> [ByteString])
go (IO ([ByteString] -> [ByteString])
ma:[IO ([ByteString] -> [ByteString])]
mas) = do
          [ByteString] -> [ByteString]
a <- IO ([ByteString] -> [ByteString])
ma
          [ByteString] -> [ByteString]
as <- forall a. IO a -> IO a
IO.unsafeInterleaveIO forall a b. (a -> b) -> a -> b
$ [IO ([ByteString] -> [ByteString])]
-> IO ([ByteString] -> [ByteString])
go [IO ([ByteString] -> [ByteString])]
mas
          forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> [ByteString]
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
as)
        go [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty