module StreamPatch.Apply where
import StreamPatch.Stream
import StreamPatch.Patch
import qualified StreamPatch.Patch.Binary as Bin
import StreamPatch.Patch.Binary ( BinRep )
import Data.Vinyl
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as BL
import Control.Monad.State
import StreamPatch.Util ( traverseM_ )
applyBinFwd
:: forall a m. (MonadFwdInplaceStream m, Chunk m ~ BS.ByteString, BinRep a)
=> Bin.Cfg
-> [Patch 'FwdSeek '[Bin.MetaStream] a]
-> m (Either (Bin.Error a) ())
applyBinFwd :: forall a (m :: * -> *).
(MonadFwdInplaceStream m, Chunk m ~ ByteString, BinRep a) =>
Cfg -> [Patch 'FwdSeek '[MetaStream] a] -> m (Either (Error a) ())
applyBinFwd Cfg
cfg = (Patch 'FwdSeek '[MetaStream] a -> m (Either (Error a) ()))
-> [Patch 'FwdSeek '[MetaStream] a] -> m (Either (Error a) ())
forall (t :: * -> *) (f :: * -> *) (m :: * -> *) v.
(Traversable t, Applicative f, Monad m) =>
(v -> m (f ())) -> t v -> m (f ())
traverseM_ ((Patch 'FwdSeek '[MetaStream] a -> m (Either (Error a) ()))
-> [Patch 'FwdSeek '[MetaStream] a] -> m (Either (Error a) ()))
-> (Patch 'FwdSeek '[MetaStream] a -> m (Either (Error a) ()))
-> [Patch 'FwdSeek '[MetaStream] a]
-> m (Either (Error a) ())
forall a b. (a -> b) -> a -> b
$ \(Patch a
a SeekRep 'FwdSeek
s (FunctorRec (Flap r a
m :& Rec (Flap a) rs
RNil))) -> do
case a -> Either (Error a) ByteString
forall a. BinRep a => a -> Either (Error a) ByteString
Bin.toBinRep' a
a of
Left Error a
err -> Either (Error a) () -> m (Either (Error a) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Error a) () -> m (Either (Error a) ()))
-> Either (Error a) () -> m (Either (Error a) ())
forall a b. (a -> b) -> a -> b
$ Error a -> Either (Error a) ()
forall a b. a -> Either a b
Left Error a
err
Right ByteString
bs -> do
Natural -> m ()
forall (m :: * -> *). MonadFwdInplaceStream m => Natural -> m ()
advance Natural
SeekRep 'FwdSeek
s
ByteString
bsStream <- Natural -> m (Chunk m)
forall (m :: * -> *).
MonadFwdInplaceStream m =>
Natural -> m (Chunk m)
readahead (Natural -> m (Chunk m)) -> Natural -> m (Chunk m)
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs
case Cfg -> ByteString -> MetaStream a -> Either (Error a) ()
forall a.
BinRep a =>
Cfg -> ByteString -> MetaStream a -> Either (Error a) ()
Bin.check Cfg
cfg ByteString
bsStream r a
MetaStream a
m of
Left Error a
err -> Either (Error a) () -> m (Either (Error a) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Error a) () -> m (Either (Error a) ()))
-> Either (Error a) () -> m (Either (Error a) ())
forall a b. (a -> b) -> a -> b
$ Error a -> Either (Error a) ()
forall a b. a -> Either a b
Left Error a
err
Right () -> do
Chunk m -> m ()
forall (m :: * -> *). MonadFwdInplaceStream m => Chunk m -> m ()
overwrite ByteString
Chunk m
bs
Either (Error a) () -> m (Either (Error a) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Error a) () -> m (Either (Error a) ()))
-> Either (Error a) () -> m (Either (Error a) ())
forall a b. (a -> b) -> a -> b
$ () -> Either (Error a) ()
forall a b. b -> Either a b
Right ()
runPureFwdBin
:: BinRep a
=> Bin.Cfg
-> [Patch 'FwdSeek '[Bin.MetaStream] a]
-> BS.ByteString
-> Either (Bin.Error a) BL.ByteString
runPureFwdBin :: forall a.
BinRep a =>
Cfg
-> [Patch 'FwdSeek '[MetaStream] a]
-> ByteString
-> Either (Error a) ByteString
runPureFwdBin Cfg
cfg [Patch 'FwdSeek '[MetaStream] a]
ps ByteString
bs =
let (Either (Error a) ()
mErr, (ByteString
bsRemaining, Builder
bbPatched)) = State (ByteString, Builder) (Either (Error a) ())
-> (ByteString, Builder)
-> (Either (Error a) (), (ByteString, Builder))
forall s a. State s a -> s -> (a, s)
runState (Cfg
-> [Patch 'FwdSeek '[MetaStream] a]
-> State (ByteString, Builder) (Either (Error a) ())
forall a (m :: * -> *).
(MonadFwdInplaceStream m, Chunk m ~ ByteString, BinRep a) =>
Cfg -> [Patch 'FwdSeek '[MetaStream] a] -> m (Either (Error a) ())
applyBinFwd Cfg
cfg [Patch 'FwdSeek '[MetaStream] a]
ps) (ByteString
bs, Builder
forall a. Monoid a => a
mempty)
bbPatched' :: Builder
bbPatched' = Builder
bbPatched Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
bsRemaining
in case Either (Error a) ()
mErr of
Left Error a
err -> Error a -> Either (Error a) ByteString
forall a b. a -> Either a b
Left Error a
err
Right () -> ByteString -> Either (Error a) ByteString
forall a b. b -> Either a b
Right (ByteString -> Either (Error a) ByteString)
-> ByteString -> Either (Error a) ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString Builder
bbPatched'
applySimpleFwd
:: (MonadFwdInplaceStream m, Chunk m ~ a)
=> [Patch 'FwdSeek '[] a]
-> m ()
applySimpleFwd :: forall (m :: * -> *) a.
(MonadFwdInplaceStream m, Chunk m ~ a) =>
[Patch 'FwdSeek '[] a] -> m ()
applySimpleFwd =
(Patch 'FwdSeek '[] a -> m ()) -> [Patch 'FwdSeek '[] a] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Patch 'FwdSeek '[] a -> m ()) -> [Patch 'FwdSeek '[] a] -> m ())
-> (Patch 'FwdSeek '[] a -> m ()) -> [Patch 'FwdSeek '[] a] -> m ()
forall a b. (a -> b) -> a -> b
$ \(Patch a
a SeekRep 'FwdSeek
s (FunctorRec Rec (Flap a) '[]
RNil)) -> Natural -> m ()
forall (m :: * -> *). MonadFwdInplaceStream m => Natural -> m ()
advance Natural
SeekRep 'FwdSeek
s m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Chunk m -> m ()
forall (m :: * -> *). MonadFwdInplaceStream m => Chunk m -> m ()
overwrite a
Chunk m
a
runPureSimpleFwdList
:: [Patch 'FwdSeek '[] [a]]
-> [a]
-> [a]
runPureSimpleFwdList :: forall a. [Patch 'FwdSeek '[] [a]] -> [a] -> [a]
runPureSimpleFwdList [Patch 'FwdSeek '[] [a]]
ps [a]
start =
let ((), ([a]
remaining, [a]
patched)) = State ([a], [a]) () -> ([a], [a]) -> ((), ([a], [a]))
forall s a. State s a -> s -> (a, s)
runState ([Patch 'FwdSeek '[] [a]] -> State ([a], [a]) ()
forall (m :: * -> *) a.
(MonadFwdInplaceStream m, Chunk m ~ a) =>
[Patch 'FwdSeek '[] a] -> m ()
applySimpleFwd [Patch 'FwdSeek '[] [a]]
ps) ([a]
start, [a]
forall a. Monoid a => a
mempty)
in [a]
patched [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
remaining