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 (Error a -> Error a -> Bool
(Error a -> Error a -> Bool)
-> (Error a -> Error a -> Bool) -> Eq (Error a)
forall a. Eq a => Error a -> Error a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error a -> Error a -> Bool
$c/= :: forall a. Eq a => Error a -> Error a -> Bool
== :: Error a -> Error a -> Bool
$c== :: forall a. Eq a => Error a -> Error a -> Bool
Eq, Int -> Error a -> ShowS
[Error a] -> ShowS
Error a -> String
(Int -> Error a -> ShowS)
-> (Error a -> String) -> ([Error a] -> ShowS) -> Show (Error a)
forall a. Show a => Int -> Error a -> ShowS
forall a. Show a => [Error a] -> ShowS
forall a. Show a => Error a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error a] -> ShowS
$cshowList :: forall a. Show a => [Error a] -> ShowS
show :: Error a -> String
$cshow :: forall a. Show a => Error a -> String
showsPrec :: Int -> Error a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Error a -> ShowS
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 :: [Patch Bytes] -> (Patchscript Bytes, [Error Bytes])
gen [Patch Bytes]
pList =
    let pList' :: [Patch Bytes]
pList'                 = (Patch Bytes -> Patch Bytes -> Ordering)
-> [Patch Bytes] -> [Patch Bytes]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy Patch Bytes -> Patch Bytes -> Ordering
forall a a. Patch a -> Patch a -> Ordering
comparePatchOffsets [Patch Bytes]
pList
        (Int
_, Patchscript Bytes
script, [Error Bytes]
errors, Patch Bytes
_) = State (Int, Patchscript Bytes, [Error Bytes], Patch Bytes) ()
-> (Int, Patchscript Bytes, [Error Bytes], Patch Bytes)
-> (Int, Patchscript Bytes, [Error Bytes], Patch Bytes)
forall s a. State s a -> s -> s
execState ([Patch Bytes]
-> State (Int, Patchscript Bytes, [Error Bytes], Patch Bytes) ()
forall (m :: * -> *).
MonadState
  (Int, Patchscript Bytes, [Error Bytes], Patch Bytes) m =>
[Patch Bytes] -> m ()
go [Patch Bytes]
pList') (Int
0, [], [], Patch Bytes
forall a. HasCallStack => a
undefined)
        -- I believe the undefined is inaccessible providing the first patch has
        -- a non-negative offset (negative offsets are forbidden)
     in (Patchscript Bytes -> Patchscript Bytes
forall a. [a] -> [a]
reverse Patchscript Bytes
script, [Error Bytes] -> [Error Bytes]
forall a. [a] -> [a]
reverse [Error Bytes]
errors)
  where
    comparePatchOffsets :: Patch a -> Patch a -> Ordering
comparePatchOffsets (Patch a
_ Int
o1 OverwriteMeta a
_) (Patch a
_ Int
o2 OverwriteMeta a
_) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
o1 Int
o2
    go :: (MonadState (Int, Patchscript Bytes, [Error Bytes], Patch Bytes) m) => [Patch Bytes] -> m ()
    go :: [Patch Bytes] -> m ()
go [] = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (p :: Patch Bytes
p@(Patch Bytes
bs Int
offset OverwriteMeta Bytes
meta):[Patch Bytes]
ps) = do
        (Int
cursor, Patchscript Bytes
script, [Error Bytes]
errors, Patch Bytes
prevPatch) <- m (Int, Patchscript Bytes, [Error Bytes], Patch Bytes)
forall s (m :: * -> *). MonadState s m => m s
get
        case Int -> Int -> Either Int Int
forall a. (Ord a, Num a) => a -> a -> Either a a
trySkipTo Int
offset Int
cursor of
          -- next offset is behind current cursor: overlapping patches
          -- record error, recover via dropping patch
          Left Int
_ -> do
            let e :: Error Bytes
e = Patch Bytes -> Patch Bytes -> Error Bytes
forall a. Patch a -> Patch a -> Error a
ErrorOverlap Patch Bytes
p Patch Bytes
prevPatch
            let errors' :: [Error Bytes]
errors' = Error Bytes
e Error Bytes -> [Error Bytes] -> [Error Bytes]
forall a. a -> [a] -> [a]
: [Error Bytes]
errors
            (Int, Patchscript Bytes, [Error Bytes], Patch Bytes) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
cursor, Patchscript Bytes
script, [Error Bytes]
errors', Patch Bytes
p)
            [Patch Bytes] -> m ()
forall (m :: * -> *).
MonadState
  (Int, Patchscript Bytes, [Error Bytes], Patch Bytes) m =>
[Patch Bytes] -> m ()
go [Patch Bytes]
ps
          Right Int
skip -> do
            let cursor' :: Int
cursor' = Int
cursor Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
skip Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bytes -> Int
BS.length Bytes
bs
                o :: Overwrite Bytes
o       = Bytes -> OverwriteMeta Bytes -> Overwrite Bytes
forall a. a -> OverwriteMeta a -> Overwrite a
Overwrite Bytes
bs OverwriteMeta Bytes
meta
            (Int, Patchscript Bytes, [Error Bytes], Patch Bytes) -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
cursor', (Int
skip, Overwrite Bytes
o)(Int, Overwrite Bytes) -> Patchscript Bytes -> Patchscript Bytes
forall a. a -> [a] -> [a]
:Patchscript Bytes
script, [Error Bytes]
errors, Patch Bytes
p)
            [Patch Bytes] -> m ()
forall (m :: * -> *).
MonadState
  (Int, Patchscript Bytes, [Error Bytes], Patch Bytes) m =>
[Patch Bytes] -> m ()
go [Patch Bytes]
ps
    trySkipTo :: a -> a -> Either a a
trySkipTo a
to a
from =
        let diff :: a
diff = a
to a -> a -> a
forall a. Num a => a -> a -> a
- a
from in if a
diff a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 then a -> Either a a
forall a b. b -> Either a b
Right a
diff else a -> Either a a
forall a b. a -> Either a b
Left (-a
diff)