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_ )

-- TODO how to clean up, use Either monad inside m? (lift didn't work)
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

-- stupid because no monotraversable :<
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