{-# OPTIONS_GHC -fno-warn-orphans #-}
module Darcs.Patch.Prim.V1.Apply () where

import Prelude ()
import Darcs.Prelude

import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Repair ( RepairToFL(..) )

import Darcs.Patch.Prim.Class ( PrimApply(..) )
import Darcs.Patch.Prim.V1.Core
    ( Prim(..),
      DirPatchType(..), FilePatchType(..) )
import Darcs.Patch.Prim.V1.Show ( showHunk )

import Darcs.Util.Path ( FileName, fn2fp )
import Darcs.Patch.Format ( FileNameFormat(UserFormat) )
import Darcs.Patch.TokenReplace ( tryTokReplace )

import Darcs.Patch.ApplyMonad ( ApplyMonadTree(..) )
import Darcs.Util.Tree( Tree )

import Darcs.Patch.Witnesses.Ordered ( FL(..), mapFL_FL, spanFL, (:>)(..) )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoercePStart )

import Darcs.Util.ByteString ( unlinesPS )
import Darcs.Util.Printer( renderString )

import Control.Exception ( throw )

import qualified Data.ByteString            as B
import qualified Data.ByteString.Internal   as BI
import qualified Data.ByteString.Char8 as BC (pack, unpack, unlines)

type FileContents = B.ByteString

instance Apply Prim where
    type ApplyState Prim = Tree
    apply :: Prim wX wY -> m ()
apply (FP f :: FileName
f RmFile) = FileName -> m ()
forall (m :: * -> *). ApplyMonadTree m => FileName -> m ()
mRemoveFile FileName
f
    apply (FP f :: FileName
f AddFile) = FileName -> m ()
forall (m :: * -> *). ApplyMonadTree m => FileName -> m ()
mCreateFile FileName
f
    apply (FP f :: FileName
f (Hunk l :: Int
l o :: [ByteString]
o n :: [ByteString]
n)) = FileName -> (ByteString -> m ByteString) -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
FileName -> (ByteString -> m ByteString) -> m ()
mModifyFilePS FileName
f ((ByteString -> m ByteString) -> m ())
-> (ByteString -> m ByteString) -> m ()
forall a b. (a -> b) -> a -> b
$ FileName
-> (Int, [ByteString], [ByteString]) -> ByteString -> m ByteString
forall (m :: * -> *).
Monad m =>
FileName
-> (Int, [ByteString], [ByteString]) -> ByteString -> m ByteString
applyHunk FileName
f (Int
l, [ByteString]
o, [ByteString]
n)
    apply (FP f :: FileName
f (TokReplace t :: String
t o :: String
o n :: String
n)) = FileName -> (ByteString -> m ByteString) -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
FileName -> (ByteString -> m ByteString) -> m ()
mModifyFilePS FileName
f ByteString -> m ByteString
forall (m :: * -> *). Monad m => ByteString -> m ByteString
doreplace
        where doreplace :: ByteString -> m ByteString
doreplace fc :: ByteString
fc =
                  case String
-> ByteString -> ByteString -> ByteString -> Maybe ByteString
tryTokReplace String
t (String -> ByteString
BC.pack String
o) (String -> ByteString
BC.pack String
n) ByteString
fc of
                  Nothing -> IOError -> m ByteString
forall a e. Exception e => e -> a
throw (IOError -> m ByteString) -> IOError -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ "replace patch to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FileName -> String
fn2fp FileName
f
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ " couldn't apply."
                  Just fc' :: ByteString
fc' -> ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
fc'
    apply (FP f :: FileName
f (Binary o :: ByteString
o n :: ByteString
n)) = FileName -> (ByteString -> m ByteString) -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
FileName -> (ByteString -> m ByteString) -> m ()
mModifyFilePS FileName
f ByteString -> m ByteString
forall (m :: * -> *). Monad m => ByteString -> m ByteString
doapply
        where doapply :: ByteString -> m ByteString
doapply oldf :: ByteString
oldf = if ByteString
o ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
oldf
                             then ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
n
                             else IOError -> m ByteString
forall a e. Exception e => e -> a
throw (IOError -> m ByteString) -> IOError -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ "binary patch to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FileName -> String
fn2fp FileName
f
                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ " couldn't apply."
    apply (DP d :: FileName
d AddDir) = FileName -> m ()
forall (m :: * -> *). ApplyMonadTree m => FileName -> m ()
mCreateDirectory FileName
d
    apply (DP d :: FileName
d RmDir) = FileName -> m ()
forall (m :: * -> *). ApplyMonadTree m => FileName -> m ()
mRemoveDirectory FileName
d
    apply (Move f :: FileName
f f' :: FileName
f') = FileName -> FileName -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
FileName -> FileName -> m ()
mRename FileName
f FileName
f'
    apply (ChangePref p :: String
p f :: String
f t :: String
t) = String -> String -> String -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
String -> String -> String -> m ()
mChangePref String
p String
f String
t

instance RepairToFL Prim where
    applyAndTryToFixFL :: Prim wX wY -> m (Maybe (String, FL Prim wX wY))
applyAndTryToFixFL (FP f :: FileName
f RmFile) =
        do ByteString
x <- FileName -> m ByteString
forall (m :: * -> *). ApplyMonadTree m => FileName -> m ByteString
mReadFilePS FileName
f
           FileName -> m ()
forall (m :: * -> *). ApplyMonadTree m => FileName -> m ()
mRemoveFile FileName
f
           Maybe (String, FL Prim wX wY) -> m (Maybe (String, FL Prim wX wY))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, FL Prim wX wY)
 -> m (Maybe (String, FL Prim wX wY)))
-> Maybe (String, FL Prim wX wY)
-> m (Maybe (String, FL Prim wX wY))
forall a b. (a -> b) -> a -> b
$ if ByteString -> Bool
B.null ByteString
x
                        then Maybe (String, FL Prim wX wY)
forall a. Maybe a
Nothing
                        else (String, FL Prim wX wY) -> Maybe (String, FL Prim wX wY)
forall a. a -> Maybe a
Just ("WARNING: Fixing removal of non-empty file "String -> String -> String
forall a. [a] -> [a] -> [a]
++FileName -> String
fn2fp FileName
f,
                                   -- No need to coerce because the content
                                   -- removal patch has freely decided contexts
                                   FileName -> FilePatchType wX Any -> Prim wX Any
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP FileName
f (ByteString -> ByteString -> FilePatchType wX Any
forall wX wY. ByteString -> ByteString -> FilePatchType wX wY
Binary ByteString
x ByteString
B.empty) Prim wX Any -> FL Prim Any wY -> FL Prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FileName -> FilePatchType Any wY -> Prim Any wY
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP FileName
f FilePatchType Any wY
forall wX wY. FilePatchType wX wY
RmFile Prim Any wY -> FL Prim wY wY -> FL Prim Any wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL Prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL )
    applyAndTryToFixFL (FP f :: FileName
f AddFile) =
        do Bool
exists <- FileName -> m Bool
forall (m :: * -> *). ApplyMonadTree m => FileName -> m Bool
mDoesFileExist FileName
f
           if Bool
exists
             then Maybe (String, FL Prim wX wY) -> m (Maybe (String, FL Prim wX wY))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, FL Prim wX wY)
 -> m (Maybe (String, FL Prim wX wY)))
-> Maybe (String, FL Prim wX wY)
-> m (Maybe (String, FL Prim wX wY))
forall a b. (a -> b) -> a -> b
$
                     (String, FL Prim wX wY) -> Maybe (String, FL Prim wX wY)
forall a. a -> Maybe a
Just ("WARNING: Dropping add of existing file "String -> String -> String
forall a. [a] -> [a] -> [a]
++FileName -> String
fn2fp FileName
f,
                           -- the old context was wrong, so we have to coerce
                           FL Prim wY wY -> FL Prim wX wY
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart FL Prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
                          )
             else do FileName -> m ()
forall (m :: * -> *). ApplyMonadTree m => FileName -> m ()
mCreateFile FileName
f
                     Maybe (String, FL Prim wX wY) -> m (Maybe (String, FL Prim wX wY))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, FL Prim wX wY)
forall a. Maybe a
Nothing
    applyAndTryToFixFL (DP f :: FileName
f AddDir) =
        do Bool
exists <- FileName -> m Bool
forall (m :: * -> *). ApplyMonadTree m => FileName -> m Bool
mDoesDirectoryExist FileName
f
           if Bool
exists
             then Maybe (String, FL Prim wX wY) -> m (Maybe (String, FL Prim wX wY))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, FL Prim wX wY)
 -> m (Maybe (String, FL Prim wX wY)))
-> Maybe (String, FL Prim wX wY)
-> m (Maybe (String, FL Prim wX wY))
forall a b. (a -> b) -> a -> b
$
                     (String, FL Prim wX wY) -> Maybe (String, FL Prim wX wY)
forall a. a -> Maybe a
Just ("WARNING: Dropping add of existing directory "String -> String -> String
forall a. [a] -> [a] -> [a]
++FileName -> String
fn2fp FileName
f,
                           -- the old context was wrong, so we have to coerce
                           FL Prim wY wY -> FL Prim wX wY
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart FL Prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
                          )
             else do FileName -> m ()
forall (m :: * -> *). ApplyMonadTree m => FileName -> m ()
mCreateDirectory FileName
f
                     Maybe (String, FL Prim wX wY) -> m (Maybe (String, FL Prim wX wY))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, FL Prim wX wY)
forall a. Maybe a
Nothing
    applyAndTryToFixFL p :: Prim wX wY
p = do Prim wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply Prim wX wY
p; Maybe (String, FL Prim wX wY) -> m (Maybe (String, FL Prim wX wY))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (String, FL Prim wX wY)
forall a. Maybe a
Nothing

instance PrimApply Prim where
    applyPrimFL :: FL Prim wX wY -> m ()
applyPrimFL NilFL = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    applyPrimFL (FP f :: FileName
f h :: FilePatchType wX wY
h@(Hunk{}):>:the_ps :: FL Prim wY wY
the_ps)
     = case (forall wW wY. Prim wW wY -> Bool)
-> FL Prim wY wY -> (:>) (FL Prim) (FL Prim) wY wY
forall (a :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> Bool)
-> FL a wX wZ -> (:>) (FL a) (FL a) wX wZ
spanFL forall wW wY. Prim wW wY -> Bool
f_hunk FL Prim wY wY
the_ps of
           (xs :: FL Prim wY wZ
xs :> ps' :: FL Prim wZ wY
ps') ->
               do let foo :: FL FilePatchType wX wZ
foo = FilePatchType wX wY
h FilePatchType wX wY
-> FL FilePatchType wY wZ -> FL FilePatchType wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: (forall wW wY. Prim wW wY -> FilePatchType wW wY)
-> FL Prim wY wZ -> FL FilePatchType wY wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (\(FP _ h') -> FilePatchType wW wY
h') FL Prim wY wZ
xs
                  FileName -> (ByteString -> m ByteString) -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
FileName -> (ByteString -> m ByteString) -> m ()
mModifyFilePS FileName
f ((ByteString -> m ByteString) -> m ())
-> (ByteString -> m ByteString) -> m ()
forall a b. (a -> b) -> a -> b
$ FL FilePatchType wX wZ -> ByteString -> m ByteString
forall (m :: * -> *) wX wY.
Monad m =>
FL FilePatchType wX wY -> ByteString -> m ByteString
hunkmod FL FilePatchType wX wZ
foo
                  FL Prim wZ wY -> m ()
forall (prim :: * -> * -> *) (m :: * -> *) wX wY.
(PrimApply prim, ApplyMonad (ApplyState prim) m) =>
FL prim wX wY -> m ()
applyPrimFL FL Prim wZ wY
ps'
        where f_hunk :: Prim wX wY -> Bool
f_hunk (FP f' :: FileName
f' (Hunk{})) = FileName
f FileName -> FileName -> Bool
forall a. Eq a => a -> a -> Bool
== FileName
f'
              f_hunk _ = Bool
False
              -- TODO there should be a HOF that abstracts
              -- over this recursion scheme
              hunkmod :: Monad m => FL FilePatchType wX wY
                      -> B.ByteString -> m B.ByteString
              hunkmod :: FL FilePatchType wX wY -> ByteString -> m ByteString
hunkmod NilFL content :: ByteString
content = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
content
              hunkmod (Hunk line :: Int
line old :: [ByteString]
old new :: [ByteString]
new:>:hs :: FL FilePatchType wY wY
hs) content :: ByteString
content =
                  FileName
-> (Int, [ByteString], [ByteString]) -> ByteString -> m ByteString
forall (m :: * -> *).
Monad m =>
FileName
-> (Int, [ByteString], [ByteString]) -> ByteString -> m ByteString
applyHunk FileName
f (Int
line, [ByteString]
old, [ByteString]
new) ByteString
content m ByteString -> (ByteString -> m ByteString) -> m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FL FilePatchType wY wY -> ByteString -> m ByteString
forall (m :: * -> *) wX wY.
Monad m =>
FL FilePatchType wX wY -> ByteString -> m ByteString
hunkmod FL FilePatchType wY wY
hs
              hunkmod _ _ = m ByteString
forall a. a
impossible
    applyPrimFL (p :: Prim wX wY
p:>:ps :: FL Prim wY wY
ps) = Prim wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply Prim wX wY
p m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FL Prim wY wY -> m ()
forall (prim :: * -> * -> *) (m :: * -> *) wX wY.
(PrimApply prim, ApplyMonad (ApplyState prim) m) =>
FL prim wX wY -> m ()
applyPrimFL FL Prim wY wY
ps

applyHunk :: Monad m
          => FileName
          -> (Int, [B.ByteString], [B.ByteString])
          -> FileContents
          -> m FileContents
applyHunk :: FileName
-> (Int, [ByteString], [ByteString]) -> ByteString -> m ByteString
applyHunk f :: FileName
f h :: (Int, [ByteString], [ByteString])
h fc :: ByteString
fc =
  case (Int, [ByteString], [ByteString])
-> ByteString -> Either String ByteString
applyHunkLines (Int, [ByteString], [ByteString])
h ByteString
fc of
    Right fc' :: ByteString
fc' -> ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
fc'
    Left msg :: String
msg ->
      IOError -> m ByteString
forall a e. Exception e => e -> a
throw (IOError -> m ByteString) -> IOError -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
      "### Error applying:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, [ByteString], [ByteString]) -> String
renderHunk (Int, [ByteString], [ByteString])
h String -> String -> String
forall a. [a] -> [a] -> [a]
++
      "\n### to file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FileName -> String
fn2fp FileName
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BC.unpack ByteString
fc String -> String -> String
forall a. [a] -> [a] -> [a]
++
      "### Reason: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
  where
    renderHunk :: (Int, [ByteString], [ByteString]) -> String
renderHunk (l :: Int
l, o :: [ByteString]
o, n :: [ByteString]
n) = Doc -> String
renderString (FileNameFormat
-> FileName -> Int -> [ByteString] -> [ByteString] -> Doc
showHunk FileNameFormat
UserFormat FileName
f Int
l [ByteString]
o [ByteString]
n)

{- The way darcs handles newlines is not easy to understand.

Everything seems pretty logical and conventional as long as files end in a
newline. In this case, the lines in a hunk can be regarded as newline
terminated, too. However, this view breaks down if we consider files that
are not newline terminated.

Here is a different view that covers the general case and explains,
conceptually, the algorithm below.

* Ever line (in a hunk or file) is regarded as being /preceded/ by a newline
  character.

* Every file starts out containing a single newline character, that is, a
  single empty line. A first empty line at the start of a file (if present)
  is /invisible/.

* When lines are appended to a file by a hunk, they are inserted /before/ a
  final empty line, if there is one. This results in a file that remains
  being terminated by a newline.

* In particular, when we start with an empty file and add a line, we push
  the invisible newline back, making it visible, and the newline that
  initiates our new content becomes invisible instead. This results in a
  newline terminated file, as above.

* However, if there is a newline at the end of a file (remember that this
  includes the case of an empty file), a hunk can /remove/ it by removing an
  empty line before adding anything. This results in a file that is /not/
  newline terminated.

The invisible newline character at the front is, of course, not present
anywhere in the representation of files, it is just a conceptual tool.

The algorithm below is highly optimized to minimize allocation of
intermediate ByteStrings. -}

applyHunkLines :: (Int, [B.ByteString], [B.ByteString])
               -> FileContents
               -> Either String FileContents
applyHunkLines :: (Int, [ByteString], [ByteString])
-> ByteString -> Either String ByteString
applyHunkLines (line :: Int
line, old :: [ByteString]
old, new :: [ByteString]
new) content :: ByteString
content
  | Int
line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 =
      {- This case is subtle because here we have to deal with any invisible
      newline at the front of a file without it actually being present. We
      first try to drop everything up to the (length old)'th newline. 

      If this fails, we know that the content was not newline terminated. So
      we replace everything with the new content, interspersing but not
      terminating the lines with newline characters.

      If it succeeds, we insert the new content, interspersing /and/
      terminating the lines with newline characters before appending the
      rest of the content. -}
      case Int -> ByteString -> Maybe (ByteString, ByteString)
breakAfterNthNewline ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
old) ByteString
content of
        Nothing
          -- old content is not newline terminated
          | ByteString
content ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== [ByteString] -> ByteString
unlinesPS [ByteString]
old -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
unlinesPS [ByteString]
new
          | Bool
otherwise -> String -> Either String ByteString
forall a b. a -> Either a b
Left "Hunk wants to remove content that isn't there"
        Just (should_be_old :: ByteString
should_be_old, suffix :: ByteString
suffix)
          -- old content is newline terminated
          | ByteString
should_be_old ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== [ByteString] -> ByteString
BC.unlines [ByteString]
old ->
              ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
unlinesPS ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
new [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
suffix]
          | Bool
otherwise ->
              String -> Either String ByteString
forall a b. a -> Either a b
Left "Hunk wants to remove content that isn't there"
  | Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2 = do
      {- This is the simpler case. We can be sure that we have at least one
      newline character at the point where we modify the file. This means we
      can apply the conceptual view literally, i.e. replace old content with
      new content /before/ this newline, where the lines in the old and new
      content are /preceded/ by newline characters. -}
      (pre :: ByteString
pre, start :: ByteString
start) <- Int -> ByteString -> Either String (ByteString, ByteString)
breakBeforeNthNewline (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
-2) ByteString
content
      let hunkContent :: [ByteString] -> ByteString
hunkContent ls :: [ByteString]
ls = [ByteString] -> ByteString
unlinesPS (ByteString
B.emptyByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
ls)
      ByteString
post <- ByteString -> ByteString -> Either String ByteString
dropPrefix ([ByteString] -> ByteString
hunkContent [ByteString]
old) ByteString
start
      ByteString -> Either String ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ByteString
pre, [ByteString] -> ByteString
hunkContent [ByteString]
new, ByteString
post]
  | Bool
otherwise = String -> Either String ByteString
forall a b. a -> Either a b
Left "Hunk has zero or negative line number"
  where
    dropPrefix :: ByteString -> ByteString -> Either String ByteString
dropPrefix x :: ByteString
x y :: ByteString
y
      | ByteString
x ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
y = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
x) ByteString
y
      | Bool
otherwise =
        String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ "Hunk wants to remove content that isn't there"

breakAfterNthNewline :: Int -> B.ByteString -> Maybe (B.ByteString, B.ByteString)
breakAfterNthNewline :: Int -> ByteString -> Maybe (ByteString, ByteString)
breakAfterNthNewline 0 the_ps :: ByteString
the_ps = (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (ByteString
B.empty, ByteString
the_ps)
breakAfterNthNewline n :: Int
n _ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> Maybe (ByteString, ByteString)
forall a. HasCallStack => String -> a
error "precondition of breakAfterNthNewline"
breakAfterNthNewline n :: Int
n the_ps :: ByteString
the_ps = Int -> [Int] -> Maybe (ByteString, ByteString)
forall t.
(Eq t, Num t) =>
t -> [Int] -> Maybe (ByteString, ByteString)
go Int
n (Word8 -> ByteString -> [Int]
B.elemIndices (Char -> Word8
BI.c2w '\n') ByteString
the_ps)
  where
    go :: t -> [Int] -> Maybe (ByteString, ByteString)
go _ [] = Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing -- we have fewer than n newlines
    go 1 (i :: Int
i:_) = (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just ((ByteString, ByteString) -> Maybe (ByteString, ByteString))
-> (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
B.splitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) ByteString
the_ps
    go !t
m (_:is :: [Int]
is) = t -> [Int] -> Maybe (ByteString, ByteString)
go (t
m t -> t -> t
forall a. Num a => a -> a -> a
- 1) [Int]
is

breakBeforeNthNewline :: Int -> B.ByteString -> Either String (B.ByteString, B.ByteString)
breakBeforeNthNewline :: Int -> ByteString -> Either String (ByteString, ByteString)
breakBeforeNthNewline n :: Int
n _ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> Either String (ByteString, ByteString)
forall a. HasCallStack => String -> a
error "precondition of breakBeforeNthNewline"
breakBeforeNthNewline n :: Int
n the_ps :: ByteString
the_ps = Int -> [Int] -> Either String (ByteString, ByteString)
forall t.
(Eq t, Num t) =>
t -> [Int] -> Either String (ByteString, ByteString)
go Int
n (Word8 -> ByteString -> [Int]
B.elemIndices (Char -> Word8
BI.c2w '\n') ByteString
the_ps)
  where
    go :: t -> [Int] -> Either String (ByteString, ByteString)
go 0 [] = (ByteString, ByteString) -> Either String (ByteString, ByteString)
forall a b. b -> Either a b
Right (ByteString
the_ps, ByteString
B.empty)
    go 0 (i :: Int
i:_) = (ByteString, ByteString) -> Either String (ByteString, ByteString)
forall a b. b -> Either a b
Right ((ByteString, ByteString)
 -> Either String (ByteString, ByteString))
-> (ByteString, ByteString)
-> Either String (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
i ByteString
the_ps
    go !t
m (_:is :: [Int]
is) = t -> [Int] -> Either String (ByteString, ByteString)
go (t
m t -> t -> t
forall a. Num a => a -> a -> a
- 1) [Int]
is
    go _ [] = String -> Either String (ByteString, ByteString)
forall a b. a -> Either a b
Left "Line number does not exist"