Apply.hs

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           Util

-- TODO how to clean up, use Either monad inside m? (lift didn't work)
applyBinFwd
    :: forall a m. (MonadFwdStream m, Chunk m ~ BS.ByteString, BinRep a)
    => Bin.Cfg
    -> [Patch 'FwdSeek '[Bin.MetaStream] a]
    -> m (Either (Bin.Error a) ())
applyBinFwd cfg = traverseM_ $ \(Patch a s (FunctorRec (Flap m :& RNil))) -> do
    case Bin.toBinRep' a of
      Left err -> return $ Left err
      Right bs -> do
        advance s
        bsStream <- readahead $ fromIntegral $ BS.length bs
        case Bin.check cfg bsStream m of
          Left err -> return $ Left err
          Right () -> do
            overwrite bs
            return $ Right ()

runPureFwdBin
    :: BinRep a
    => Bin.Cfg
    -> [Patch 'FwdSeek '[Bin.MetaStream] a]
    -> BS.ByteString
    -> Either (Bin.Error a) BL.ByteString
runPureFwdBin cfg ps bs =
    let (mErr, (bsRemaining, bbPatched)) = runState (applyBinFwd cfg ps) (bs, mempty)
        bbPatched' = bbPatched <> BB.byteString bsRemaining
     in case mErr of
          Left err -> Left err
          Right () -> Right $ BB.toLazyByteString bbPatched'

applySimpleFwd
    :: (MonadFwdStream m, Chunk m ~ a)
    => [Patch 'FwdSeek '[] a]
    -> m ()
applySimpleFwd =
    mapM_ $ \(Patch a s (FunctorRec RNil)) -> advance s >> overwrite a

-- stupid because no monotraversable :<
runPureSimpleFwdList
    :: [Patch 'FwdSeek '[] [a]]
    -> [a]
    -> [a]
runPureSimpleFwdList ps start =
    let ((), (remaining, patched)) = runState (applySimpleFwd ps) (start, mempty)
     in patched <> remaining