Gen.hs

module BytePatch.Linear.Gen (gen, Error(..)) where

import           BytePatch.Core
import           BytePatch.Linear.Core

import qualified Data.ByteString        as BS
import           Control.Monad.State
import qualified Data.List              as List

type Bytes = BS.ByteString

-- | Error encountered during linear patchscript generation.
data Error a
  = ErrorOverlap (Patch a) (Patch a)
  -- ^ Two edits wrote to the same offset.
    deriving (Eq, Show)

-- | Process an offset patchscript into a linear patchscript.
--
-- Errors are reported, but do not interrupt patch generation. The user could
-- discard patchscripts that errored, or perhaps attempt to recover them. This
-- is what we do for errors:
--
--   * overlapping edit: later edit is skipped & overlapping edits reported
gen :: [Patch Bytes] -> (Patchscript Bytes, [Error Bytes])
gen pList =
    let pList'                 = List.sortBy comparePatchOffsets pList
        (_, script, errors, _) = execState (go pList') (0, [], [], undefined)
        -- I believe the undefined is inaccessible providing the first patch has
        -- a non-negative offset (negative offsets are forbidden)
     in (reverse script, reverse errors)
  where
    comparePatchOffsets (Patch _ o1 _) (Patch _ o2 _) = compare o1 o2
    go :: (MonadState (Int, Patchscript Bytes, [Error Bytes], Patch Bytes) m) => [Patch Bytes] -> m ()
    go [] = return ()
    go (p@(Patch bs offset meta):ps) = do
        (cursor, script, errors, prevPatch) <- get
        case trySkipTo offset cursor of
          -- next offset is behind current cursor: overlapping patches
          -- record error, recover via dropping patch
          Left _ -> do
            let e = ErrorOverlap p prevPatch
            let errors' = e : errors
            put (cursor, script, errors', p)
            go ps
          Right skip -> do
            let cursor' = cursor + skip + BS.length bs
                o       = Overwrite bs meta
            put (cursor', (skip, o):script, errors, p)
            go ps
    trySkipTo to from =
        let diff = to - from in if diff >= 0 then Right diff else Left (-diff)