{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Text.ProjectTemplate
(
createTemplate
, unpackTemplate
, FileReceiver
, receiveMem
, receiveFS
, ProjectTemplateException (..)
) where
import Control.Exception (Exception, assert)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Resource (MonadResource, MonadThrow,
throwM)
import Control.Monad.Writer (MonadWriter, tell)
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as L
import Data.Conduit (ConduitM, await,
awaitForever, leftover, yield,
runConduit, (.|))
import qualified Data.Conduit.Binary as CB
import Data.Conduit.List (consume, sinkNull)
import Conduit (concatMapC, chunksOfCE)
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Text as CT
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Typeable (Typeable)
import Data.Void (Void)
import System.Directory (createDirectoryIfMissing)
import System.FilePath (takeDirectory, (</>))
createTemplate
:: Monad m => ConduitM (FilePath, m ByteString) ByteString m ()
createTemplate :: forall (m :: * -> *).
Monad m =>
ConduitM (FilePath, m ByteString) ByteString m ()
createTemplate = ((FilePath, m ByteString)
-> ConduitT (FilePath, m ByteString) ByteString m ())
-> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (((FilePath, m ByteString)
-> ConduitT (FilePath, m ByteString) ByteString m ())
-> ConduitT (FilePath, m ByteString) ByteString m ())
-> ((FilePath, m ByteString)
-> ConduitT (FilePath, m ByteString) ByteString m ())
-> ConduitT (FilePath, m ByteString) ByteString m ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
fp, m ByteString
getBS) -> do
ByteString
bs <- m ByteString
-> ConduitT (FilePath, m ByteString) ByteString m ByteString
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT (FilePath, m ByteString) ByteString m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
getBS
case ConduitT () Void Maybe () -> Maybe ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void Maybe () -> Maybe ())
-> ConduitT () Void Maybe () -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT () ByteString Maybe ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs ConduitT () ByteString Maybe ()
-> ConduitT ByteString Void Maybe () -> ConduitT () Void Maybe ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Codec -> ConduitT ByteString Text Maybe ()
forall (m :: * -> *).
MonadThrow m =>
Codec -> ConduitT ByteString Text m ()
CT.decode Codec
CT.utf8 ConduitT ByteString Text Maybe ()
-> ConduitT Text Void Maybe () -> ConduitT ByteString Void Maybe ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Text Void Maybe ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
sinkNull of
Maybe ()
Nothing -> do
ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
"{-# START_FILE BASE64 "
ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ConduitT (FilePath, m ByteString) ByteString m ())
-> ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
fp
ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
" #-}\n"
ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ByteString
B64.encode ByteString
bs) ConduitT (FilePath, m ByteString) ByteString m ()
-> ConduitT ByteString ByteString m ()
-> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Index ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) seq.
(Monad m, IsSequence seq) =>
Index seq -> ConduitT seq seq m ()
chunksOfCE Int
Index ByteString
76 ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (ByteString -> [ByteString])
-> ConduitT ByteString (Element [ByteString]) m ()
forall (m :: * -> *) mono a.
(Monad m, MonoFoldable mono) =>
(a -> mono) -> ConduitT a (Element mono) m ()
concatMapC (\ByteString
x -> [ByteString
x, ByteString
"\n"])
ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
"\n"
Just ()
_ -> do
ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
"{-# START_FILE "
ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ConduitT (FilePath, m ByteString) ByteString m ())
-> ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
fp
ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
" #-}\n"
ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs
ByteString -> ConduitT (FilePath, m ByteString) ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
"\n"
unpackTemplate
:: MonadThrow m
=> (FilePath -> ConduitM ByteString o m ())
-> (Text -> Text)
-> ConduitM ByteString o m ()
unpackTemplate :: forall (m :: * -> *) o.
MonadThrow m =>
(FilePath -> ConduitM ByteString o m ())
-> (Text -> Text) -> ConduitM ByteString o m ()
unpackTemplate FilePath -> ConduitM ByteString o m ()
perFile Text -> Text
fixLine =
Codec -> ConduitT ByteString Text m ()
forall (m :: * -> *).
MonadThrow m =>
Codec -> ConduitT ByteString Text m ()
CT.decode Codec
CT.utf8 ConduitT ByteString Text m ()
-> ConduitT Text o m () -> ConduitM ByteString o m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Text Text m ()
forall (m :: * -> *). Monad m => ConduitT Text Text m ()
CT.lines ConduitT Text Text m ()
-> ConduitT Text o m () -> ConduitT Text o m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (Text -> Text) -> ConduitT Text Text m ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map Text -> Text
fixLine ConduitT Text Text m ()
-> ConduitT Text o m () -> ConduitT Text o m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Text o m ()
start
where
start :: ConduitT Text o m ()
start =
ConduitT Text o m (Maybe Text)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT Text o m (Maybe Text)
-> (Maybe Text -> ConduitT Text o m ()) -> ConduitT Text o m ()
forall a b.
ConduitT Text o m a
-> (a -> ConduitT Text o m b) -> ConduitT Text o m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT Text o m ()
-> (Text -> ConduitT Text o m ())
-> Maybe Text
-> ConduitT Text o m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT Text o m ()
forall a. a -> ConduitT Text o m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Text -> ConduitT Text o m ()
go
where
go :: Text -> ConduitT Text o m ()
go Text
t =
case Text -> Maybe (Text, Bool)
getFileName Text
t of
Maybe (Text, Bool)
Nothing -> m () -> ConduitT Text o m ()
forall (m :: * -> *) a. Monad m => m a -> ConduitT Text o m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ConduitT Text o m ()) -> m () -> ConduitT Text o m ()
forall a b. (a -> b) -> a -> b
$ ProjectTemplateException -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ProjectTemplateException -> m ())
-> ProjectTemplateException -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> ProjectTemplateException
InvalidInput Text
t
Just (Text
fp', Bool
isBinary) -> do
let src :: ConduitT Text ByteString m ()
src
| Bool
isBinary = ConduitT Text ByteString m ()
binaryLoop ConduitT Text ByteString m ()
-> ConduitT ByteString ByteString m ()
-> ConduitT Text ByteString m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
ConduitM ByteString ByteString m ()
decode64
| Bool
otherwise = Bool -> ConduitT Text ByteString m ()
forall {m :: * -> *}.
Monad m =>
Bool -> ConduitT Text ByteString m ()
textLoop Bool
True
ConduitT Text ByteString m ()
src ConduitT Text ByteString m ()
-> ConduitM ByteString o m () -> ConduitT Text o m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| FilePath -> ConduitM ByteString o m ()
perFile (Text -> FilePath
T.unpack Text
fp')
ConduitT Text o m ()
start
binaryLoop :: ConduitT Text ByteString m ()
binaryLoop = do
ConduitT Text ByteString m (Maybe Text)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT Text ByteString m (Maybe Text)
-> (Maybe Text -> ConduitT Text ByteString m ())
-> ConduitT Text ByteString m ()
forall a b.
ConduitT Text ByteString m a
-> (a -> ConduitT Text ByteString m b)
-> ConduitT Text ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT Text ByteString m ()
-> (Text -> ConduitT Text ByteString m ())
-> Maybe Text
-> ConduitT Text ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT Text ByteString m ()
forall a. a -> ConduitT Text ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Text -> ConduitT Text ByteString m ()
go
where
go :: Text -> ConduitT Text ByteString m ()
go Text
t =
case Text -> Maybe (Text, Bool)
getFileName Text
t of
Just{} -> Text -> ConduitT Text ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Text
t
Maybe (Text, Bool)
Nothing -> do
ByteString -> ConduitT Text ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ConduitT Text ByteString m ())
-> ByteString -> ConduitT Text ByteString m ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t
ConduitT Text ByteString m ()
binaryLoop
textLoop :: Bool -> ConduitT Text ByteString m ()
textLoop Bool
isFirst =
ConduitT Text ByteString m (Maybe Text)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT Text ByteString m (Maybe Text)
-> (Maybe Text -> ConduitT Text ByteString m ())
-> ConduitT Text ByteString m ()
forall a b.
ConduitT Text ByteString m a
-> (a -> ConduitT Text ByteString m b)
-> ConduitT Text ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT Text ByteString m ()
-> (Text -> ConduitT Text ByteString m ())
-> Maybe Text
-> ConduitT Text ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT Text ByteString m ()
forall a. a -> ConduitT Text ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Text -> ConduitT Text ByteString m ()
go
where
go :: Text -> ConduitT Text ByteString m ()
go Text
t =
case Text -> Maybe (Text, Bool)
getFileName Text
t of
Just{} -> Text -> ConduitT Text ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Text
t
Maybe (Text, Bool)
Nothing -> do
Bool
-> ConduitT Text ByteString m () -> ConduitT Text ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isFirst (ConduitT Text ByteString m () -> ConduitT Text ByteString m ())
-> ConduitT Text ByteString m () -> ConduitT Text ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT Text ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
"\n"
ByteString -> ConduitT Text ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ConduitT Text ByteString m ())
-> ByteString -> ConduitT Text ByteString m ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t
Bool -> ConduitT Text ByteString m ()
textLoop Bool
False
getFileName :: Text -> Maybe (Text, Bool)
getFileName Text
t =
case Text -> [Text]
T.words Text
t of
[Text
"{-#", Text
"START_FILE", Text
fn, Text
"#-}"] -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
fn, Bool
False)
[Text
"{-#", Text
"START_FILE", Text
"BASE64", Text
fn, Text
"#-}"] -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
fn, Bool
True)
[Text]
_ -> Maybe (Text, Bool)
forall a. Maybe a
Nothing
type FileReceiver m = FilePath -> ConduitM ByteString Void m ()
receiveFS :: MonadResource m
=> FilePath
-> FileReceiver m
receiveFS :: forall (m :: * -> *). MonadResource m => FilePath -> FileReceiver m
receiveFS FilePath
root FilePath
rel = do
IO () -> ConduitM ByteString Void m ()
forall a. IO a -> ConduitT ByteString Void m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitM ByteString Void m ())
-> IO () -> ConduitM ByteString Void m ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
fp
FilePath -> ConduitM ByteString Void m ()
forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
CB.sinkFile FilePath
fp
where
fp :: FilePath
fp = FilePath
root FilePath -> FilePath -> FilePath
</> FilePath
rel
receiveMem :: MonadWriter (Map FilePath L.ByteString) m
=> FileReceiver m
receiveMem :: forall (m :: * -> *).
MonadWriter (Map FilePath ByteString) m =>
FileReceiver m
receiveMem FilePath
fp = do
[ByteString]
bss <- ConduitT ByteString Void m [ByteString]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
consume
m () -> ConduitM ByteString Void m ()
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT ByteString Void m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ConduitM ByteString Void m ())
-> m () -> ConduitM ByteString Void m ()
forall a b. (a -> b) -> a -> b
$ Map FilePath ByteString -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Map FilePath ByteString -> m ())
-> Map FilePath ByteString -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> Map FilePath ByteString
forall k a. k -> a -> Map k a
Map.singleton FilePath
fp (ByteString -> Map FilePath ByteString)
-> ByteString -> Map FilePath ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks [ByteString]
bss
data ProjectTemplateException = InvalidInput Text
| BinaryLoopNeedsOneLine
deriving (Int -> ProjectTemplateException -> FilePath -> FilePath
[ProjectTemplateException] -> FilePath -> FilePath
ProjectTemplateException -> FilePath
(Int -> ProjectTemplateException -> FilePath -> FilePath)
-> (ProjectTemplateException -> FilePath)
-> ([ProjectTemplateException] -> FilePath -> FilePath)
-> Show ProjectTemplateException
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> ProjectTemplateException -> FilePath -> FilePath
showsPrec :: Int -> ProjectTemplateException -> FilePath -> FilePath
$cshow :: ProjectTemplateException -> FilePath
show :: ProjectTemplateException -> FilePath
$cshowList :: [ProjectTemplateException] -> FilePath -> FilePath
showList :: [ProjectTemplateException] -> FilePath -> FilePath
Show, Typeable)
instance Exception ProjectTemplateException
decode64 :: Monad m => ConduitM ByteString ByteString m ()
decode64 :: forall (m :: * -> *).
Monad m =>
ConduitM ByteString ByteString m ()
decode64 = Int
-> (ByteString -> ByteString)
-> ConduitM ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
Int
-> (ByteString -> ByteString)
-> ConduitM ByteString ByteString m ()
codeWith Int
4 ByteString -> ByteString
B64.decodeLenient
codeWith :: Monad m => Int -> (ByteString -> ByteString) -> ConduitM ByteString ByteString m ()
codeWith :: forall (m :: * -> *).
Monad m =>
Int
-> (ByteString -> ByteString)
-> ConduitM ByteString ByteString m ()
codeWith Int
size ByteString -> ByteString
f =
ConduitT ByteString ByteString m ()
loop
where
loop :: ConduitT ByteString ByteString m ()
loop = ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> (a -> ConduitT ByteString ByteString m b)
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString ByteString m ()
-> (ByteString -> ConduitT ByteString ByteString m ())
-> Maybe ByteString
-> ConduitT ByteString ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT ByteString ByteString m ()
forall a. a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ByteString -> ConduitT ByteString ByteString m ()
push
loopWith :: ByteString -> ConduitT ByteString ByteString m ()
loopWith ByteString
bs
| ByteString -> Bool
S.null ByteString
bs = ConduitT ByteString ByteString m ()
loop
| Bool
otherwise = ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> (a -> ConduitT ByteString ByteString m b)
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString ByteString m ()
-> (ByteString -> ConduitT ByteString ByteString m ())
-> Maybe ByteString
-> ConduitT ByteString ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ByteString
f ByteString
bs)) (ByteString -> ByteString -> ConduitT ByteString ByteString m ()
pushWith ByteString
bs)
push :: ByteString -> ConduitT ByteString ByteString m ()
push ByteString
bs = do
let (ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
size)) ByteString
bs
Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
S.null ByteString
x) (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ConduitT ByteString ByteString m ())
-> ByteString -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
f ByteString
x
ByteString -> ConduitT ByteString ByteString m ()
loopWith ByteString
y
where
len :: Int
len = ByteString -> Int
S.length ByteString
bs
pushWith :: ByteString -> ByteString -> ConduitT ByteString ByteString m ()
pushWith ByteString
bs1 ByteString
bs2 | ByteString -> Int
S.length ByteString
bs1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
S.length ByteString
bs2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size = ByteString -> ConduitT ByteString ByteString m ()
loopWith (ByteString -> ByteString -> ByteString
S.append ByteString
bs1 ByteString
bs2)
pushWith ByteString
bs1 ByteString
bs2 = ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
assertion1 (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
assertion2 (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ do
ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ConduitT ByteString ByteString m ())
-> ByteString -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
f ByteString
bs1'
ByteString -> ConduitT ByteString ByteString m ()
push ByteString
y
where
m :: Int
m = ByteString -> Int
S.length ByteString
bs1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
size
(ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) ByteString
bs2
bs1' :: ByteString
bs1' = ByteString -> ByteString -> ByteString
S.append ByteString
bs1 ByteString
x
assertion1 :: ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
assertion1 = Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
size
assertion2 :: ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
assertion2 = Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
S.length ByteString
bs1' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0