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

import Darcs.Prelude

import Control.Monad.Catch ( MonadThrow(throwM) )

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 ( AnchoredPath, anchorPath )
import Darcs.Patch.Format ( FileNameFormat(FileNameFormatDisplay) )
import Darcs.Patch.TokenReplace ( tryTokReplace )

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

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

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

import qualified Data.ByteString as B
    ( ByteString
    , drop
    , empty
    , null
    , concat
    , isPrefixOf
    , length
    , splitAt
    )
import qualified Data.ByteString.Char8 as BC (pack, unpack, unlines, elemIndices)

type FileContents = B.ByteString

ap2fp :: AnchoredPath -> FilePath
ap2fp :: AnchoredPath -> String
ap2fp = String -> AnchoredPath -> String
anchorPath String
""

instance Apply Prim where
    type ApplyState Prim = Tree
    apply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState Prim) m =>
Prim wX wY -> m ()
apply (FP AnchoredPath
f FilePatchType wX wY
RmFile) = AnchoredPath -> m ()
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m ()
mRemoveFile AnchoredPath
f
    apply (FP AnchoredPath
f FilePatchType wX wY
AddFile) = AnchoredPath -> m ()
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m ()
mCreateFile AnchoredPath
f
    apply (FP AnchoredPath
f (Hunk Int
l [FileContents]
o [FileContents]
n)) = AnchoredPath -> (FileContents -> m FileContents) -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> (FileContents -> m FileContents) -> m ()
mModifyFilePS AnchoredPath
f ((FileContents -> m FileContents) -> m ())
-> (FileContents -> m FileContents) -> m ()
forall a b. (a -> b) -> a -> b
$ AnchoredPath
-> (Int, [FileContents], [FileContents])
-> FileContents
-> m FileContents
forall (m :: * -> *).
MonadThrow m =>
AnchoredPath
-> (Int, [FileContents], [FileContents])
-> FileContents
-> m FileContents
applyHunk AnchoredPath
f (Int
l, [FileContents]
o, [FileContents]
n)
    apply (FP AnchoredPath
f (TokReplace String
t String
o String
n)) = AnchoredPath -> (FileContents -> m FileContents) -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> (FileContents -> m FileContents) -> m ()
mModifyFilePS AnchoredPath
f FileContents -> m FileContents
forall {m :: * -> *}.
MonadThrow m =>
FileContents -> m FileContents
doreplace
        where doreplace :: FileContents -> m FileContents
doreplace FileContents
fc =
                  case String
-> FileContents
-> FileContents
-> FileContents
-> Maybe FileContents
tryTokReplace String
t (String -> FileContents
BC.pack String
o) (String -> FileContents
BC.pack String
n) FileContents
fc of
                  Maybe FileContents
Nothing -> IOError -> m FileContents
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (IOError -> m FileContents) -> IOError -> m FileContents
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
"replace patch to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
ap2fp AnchoredPath
f
                             String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" couldn't apply."
                  Just FileContents
fc' -> FileContents -> m FileContents
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FileContents
fc'
    apply (FP AnchoredPath
f (Binary FileContents
o FileContents
n)) = AnchoredPath -> (FileContents -> m FileContents) -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> (FileContents -> m FileContents) -> m ()
mModifyFilePS AnchoredPath
f FileContents -> m FileContents
forall {m :: * -> *}.
MonadThrow m =>
FileContents -> m FileContents
doapply
        where doapply :: FileContents -> m FileContents
doapply FileContents
oldf = if FileContents
o FileContents -> FileContents -> Bool
forall a. Eq a => a -> a -> Bool
== FileContents
oldf
                             then FileContents -> m FileContents
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FileContents
n
                             else IOError -> m FileContents
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (IOError -> m FileContents) -> IOError -> m FileContents
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError
                                  (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
"binary patch to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
ap2fp AnchoredPath
f
                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" couldn't apply."
    apply (DP AnchoredPath
d DirPatchType wX wY
AddDir) = AnchoredPath -> m ()
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m ()
mCreateDirectory AnchoredPath
d
    apply (DP AnchoredPath
d DirPatchType wX wY
RmDir) = AnchoredPath -> m ()
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m ()
mRemoveDirectory AnchoredPath
d
    apply (Move AnchoredPath
f AnchoredPath
f') = AnchoredPath -> AnchoredPath -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> AnchoredPath -> m ()
mRename AnchoredPath
f AnchoredPath
f'
    apply (ChangePref String
p String
f 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 :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState Prim) m =>
Prim wX wY -> m (Maybe (String, FL Prim wX wY))
applyAndTryToFixFL (FP AnchoredPath
f FilePatchType wX wY
RmFile) =
        do x <- AnchoredPath -> m FileContents
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> m FileContents
mReadFilePS AnchoredPath
f
           mRemoveFile f
           return $ if B.null x
                        then Nothing
                        else Just ("WARNING: Fixing removal of non-empty file "++ap2fp f,
                                   -- No need to coerce because the content
                                   -- removal patch has freely decided contexts
                                   FP f (Binary x B.empty) :>: FP f RmFile :>: NilFL )
    applyAndTryToFixFL (FP AnchoredPath
f FilePatchType wX wY
AddFile) =
        do exists <- AnchoredPath -> m Bool
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m Bool
mDoesFileExist AnchoredPath
f
           if exists
             then return $
                     Just ("WARNING: Dropping add of existing file "++ap2fp f,
                           -- the old context was wrong, so we have to coerce
                           unsafeCoercePStart NilFL
                          )
             else do mCreateFile f
                     return Nothing
    applyAndTryToFixFL (DP AnchoredPath
f DirPatchType wX wY
AddDir) =
        do exists <- AnchoredPath -> m Bool
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m Bool
mDoesDirectoryExist AnchoredPath
f
           if exists
             then return $
                     Just ("WARNING: Dropping add of existing directory "++ap2fp f,
                           -- the old context was wrong, so we have to coerce
                           unsafeCoercePStart NilFL
                          )
             else do mCreateDirectory f
                     return Nothing
    applyAndTryToFixFL (FP AnchoredPath
f (Binary FileContents
old FileContents
new)) =
        do x <- AnchoredPath -> m FileContents
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> m FileContents
mReadFilePS AnchoredPath
f
           mModifyFilePS f (\FileContents
_ -> FileContents -> m FileContents
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FileContents
new)
           if x /= old
             then return $
                     Just ("WARNING: Fixing binary patch to "++ap2fp f,
                           FP f (Binary x new) :>: NilFL
                          )
             else return Nothing
    applyAndTryToFixFL p :: Prim wX wY
p@(Move AnchoredPath
old AnchoredPath
new) =
        do old_is_file <- AnchoredPath -> m Bool
forall (m :: * -> *). ApplyMonadTree m => AnchoredPath -> m Bool
mDoesFileExist AnchoredPath
old
           old_is_dir <- mDoesDirectoryExist old
           new_is_file <- mDoesFileExist new
           new_is_dir <- mDoesDirectoryExist new
           if | not (old_is_file || old_is_dir) ->
                  return $
                     Just ("WARNING: Dropping move patch with non-existing source "++ap2fp old,
                           unsafeCoercePStart NilFL
                          )
              | new_is_file || new_is_dir ->
                  return $
                     Just ("WARNING: Dropping move patch with existing target "++ap2fp old,
                           unsafeCoercePStart NilFL
                          )
              | otherwise -> apply p >> return Nothing
    applyAndTryToFixFL Prim wX wY
p = Prim wX wY -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState Prim) m =>
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 (Maybe (String, FL Prim wX wY))
-> m (Maybe (String, FL Prim wX wY))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (String, FL Prim wX wY) -> m (Maybe (String, FL Prim wX wY))
forall a. a -> m a
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 :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState Prim) m =>
FL Prim wX wY -> m ()
applyPrimFL FL Prim wX wY
NilFL = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    applyPrimFL (h :: Prim wX wY
h@(FP AnchoredPath
f (Hunk{})):>: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 Prim wW wY -> Bool
forall wW wY. Prim wW wY -> Bool
f_hunk FL Prim wY wY
the_ps of
           (FL Prim wY wZ
xs :> FL Prim wZ wY
ps') ->
               do AnchoredPath -> (FileContents -> m FileContents) -> m ()
forall (m :: * -> *).
ApplyMonadTree m =>
AnchoredPath -> (FileContents -> m FileContents) -> m ()
mModifyFilePS AnchoredPath
f ((FileContents -> m FileContents) -> m ())
-> (FileContents -> m FileContents) -> m ()
forall a b. (a -> b) -> a -> b
$ FL Prim wX wZ -> FileContents -> m FileContents
forall (m :: * -> *) wX wY.
MonadThrow m =>
FL Prim wX wY -> FileContents -> m FileContents
hunkmod (Prim wX wY
h Prim wX wY -> FL Prim wY wZ -> FL Prim wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL Prim wY wZ
xs)
                  FL Prim wZ wY -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState Prim) m =>
FL Prim wX 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 AnchoredPath
f' (Hunk{})) = AnchoredPath
f AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
f'
              f_hunk Prim wX wY
_ = Bool
False
              -- TODO there should be a HOF that abstracts
              -- over this recursion scheme
              hunkmod :: MonadThrow m => FL Prim wX wY
                      -> B.ByteString -> m B.ByteString
              hunkmod :: forall (m :: * -> *) wX wY.
MonadThrow m =>
FL Prim wX wY -> FileContents -> m FileContents
hunkmod FL Prim wX wY
NilFL FileContents
content = FileContents -> m FileContents
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FileContents
content
              hunkmod (FP AnchoredPath
_ (Hunk Int
line [FileContents]
old [FileContents]
new):>:FL Prim wY wY
hs) FileContents
content =
                  AnchoredPath
-> (Int, [FileContents], [FileContents])
-> FileContents
-> m FileContents
forall (m :: * -> *).
MonadThrow m =>
AnchoredPath
-> (Int, [FileContents], [FileContents])
-> FileContents
-> m FileContents
applyHunk AnchoredPath
f (Int
line, [FileContents]
old, [FileContents]
new) FileContents
content m FileContents
-> (FileContents -> m FileContents) -> m FileContents
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FL Prim wY wY -> FileContents -> m FileContents
forall (m :: * -> *) wX wY.
MonadThrow m =>
FL Prim wX wY -> FileContents -> m FileContents
hunkmod FL Prim wY wY
hs
              hunkmod FL Prim wX wY
_ FileContents
_ = String -> m FileContents
forall a. HasCallStack => String -> a
error String
"impossible case"
    applyPrimFL (Prim wX wY
p:>:FL Prim wY wY
ps) = Prim wX wY -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState Prim) m =>
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FL Prim wY wY -> m ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState Prim) m =>
FL Prim wX 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 :: MonadThrow m
          => AnchoredPath
          -> (Int, [B.ByteString], [B.ByteString])
          -> FileContents
          -> m FileContents
applyHunk :: forall (m :: * -> *).
MonadThrow m =>
AnchoredPath
-> (Int, [FileContents], [FileContents])
-> FileContents
-> m FileContents
applyHunk AnchoredPath
f (Int, [FileContents], [FileContents])
h FileContents
fc =
  case (Int, [FileContents], [FileContents])
-> FileContents -> Either String FileContents
applyHunkLines (Int, [FileContents], [FileContents])
h FileContents
fc of
    Right FileContents
fc' -> FileContents -> m FileContents
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FileContents
fc'
    Left String
msg ->
      IOError -> m FileContents
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (IOError -> m FileContents) -> IOError -> m FileContents
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$
      String
"### Error applying:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, [FileContents], [FileContents]) -> String
renderHunk (Int, [FileContents], [FileContents])
h String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"\n### to file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AnchoredPath -> String
ap2fp AnchoredPath
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ FileContents -> String
BC.unpack FileContents
fc String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"### Reason: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
  where
    renderHunk :: (Int, [FileContents], [FileContents]) -> String
renderHunk (Int
l, [FileContents]
o, [FileContents]
n) = Doc -> String
renderString (FileNameFormat
-> AnchoredPath -> Int -> [FileContents] -> [FileContents] -> Doc
showHunk FileNameFormat
FileNameFormatDisplay AnchoredPath
f Int
l [FileContents]
o [FileContents]
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, [FileContents], [FileContents])
-> FileContents -> Either String FileContents
applyHunkLines (Int
line, [FileContents]
old, [FileContents]
new) FileContents
content
  | Int
line Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 -> FileContents -> Maybe (FileContents, FileContents)
breakAfterNthNewline ([FileContents] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FileContents]
old) FileContents
content of
        Maybe (FileContents, FileContents)
Nothing
          -- old content is not newline terminated
          | FileContents
content FileContents -> FileContents -> Bool
forall a. Eq a => a -> a -> Bool
== [FileContents] -> FileContents
unlinesPS [FileContents]
old -> FileContents -> Either String FileContents
forall a b. b -> Either a b
Right (FileContents -> Either String FileContents)
-> FileContents -> Either String FileContents
forall a b. (a -> b) -> a -> b
$ [FileContents] -> FileContents
unlinesPS [FileContents]
new
          | Bool
otherwise -> String -> Either String FileContents
forall a b. a -> Either a b
Left String
"Hunk wants to remove content that isn't there"
        Just (FileContents
should_be_old, FileContents
suffix)
          -- old content is newline terminated
          | FileContents
should_be_old FileContents -> FileContents -> Bool
forall a. Eq a => a -> a -> Bool
== [FileContents] -> FileContents
BC.unlines [FileContents]
old ->
              FileContents -> Either String FileContents
forall a b. b -> Either a b
Right (FileContents -> Either String FileContents)
-> FileContents -> Either String FileContents
forall a b. (a -> b) -> a -> b
$ [FileContents] -> FileContents
unlinesPS ([FileContents] -> FileContents) -> [FileContents] -> FileContents
forall a b. (a -> b) -> a -> b
$ [FileContents]
new [FileContents] -> [FileContents] -> [FileContents]
forall a. [a] -> [a] -> [a]
++ [FileContents
suffix]
          | Bool
otherwise ->
              String -> Either String FileContents
forall a b. a -> Either a b
Left String
"Hunk wants to remove content that isn't there"
  | Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
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, start) <- Int -> FileContents -> Either String (FileContents, FileContents)
breakBeforeNthNewline (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) FileContents
content
      let hunkContent [FileContents]
ls = [FileContents] -> FileContents
unlinesPS (FileContents
B.emptyFileContents -> [FileContents] -> [FileContents]
forall a. a -> [a] -> [a]
:[FileContents]
ls)
      post <- dropPrefix (hunkContent old) start
      return $ B.concat [pre, hunkContent new, post]
  | Bool
otherwise = String -> Either String FileContents
forall a b. a -> Either a b
Left String
"Hunk has zero or negative line number"
  where
    dropPrefix :: FileContents -> FileContents -> Either String FileContents
dropPrefix FileContents
x FileContents
y
      | FileContents
x FileContents -> FileContents -> Bool
`B.isPrefixOf` FileContents
y = FileContents -> Either String FileContents
forall a b. b -> Either a b
Right (FileContents -> Either String FileContents)
-> FileContents -> Either String FileContents
forall a b. (a -> b) -> a -> b
$ Int -> FileContents -> FileContents
B.drop (FileContents -> Int
B.length FileContents
x) FileContents
y
      | Bool
otherwise =
        String -> Either String FileContents
forall a b. a -> Either a b
Left (String -> Either String FileContents)
-> String -> Either String FileContents
forall a b. (a -> b) -> a -> b
$ String
"Hunk wants to remove content that isn't there"

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

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