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

import Darcs.Prelude

import Darcs.Patch.Prim.Class ( PrimRead(..), hunk, binary )
import Darcs.Patch.Prim.V1.Core
    ( Prim(..)
    , DirPatchType(..)
    , FilePatchType(..)
    )
import Darcs.Patch.Prim.V1.Apply ()

import Darcs.Util.Path (  )
import Darcs.Patch.Format ( FileNameFormat )
import Darcs.Patch.Read ( readFileName )
import Darcs.Util.Parser
    ( Parser, takeTillChar, string, int
    , option, choice, anyChar, char, lexWord
    , skipSpace, skipWhile, linesStartingWith
    )

import Darcs.Patch.Witnesses.Sealed ( seal )

import Darcs.Util.ByteString ( fromHex2PS )

import Control.Monad ( liftM )
import qualified Data.ByteString       as B  ( ByteString, init, tail, concat )
import qualified Data.ByteString.Char8 as BC ( unpack, pack )


instance PrimRead Prim where
  readPrim :: forall wX. FileNameFormat -> Parser (Sealed (Prim wX))
readPrim FileNameFormat
fmt
     = Parser ()
skipSpace Parser ()
-> Parser ByteString (Sealed (Prim wX))
-> Parser ByteString (Sealed (Prim wX))
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Parser ByteString (Sealed (Prim wX))]
-> Parser ByteString (Sealed (Prim wX))
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
       [ Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX Any)
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX Any)
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readHunk FileNameFormat
fmt
       , Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX Any)
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX Any)
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readAddFile FileNameFormat
fmt
       , Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX Any)
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX Any)
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readAddDir FileNameFormat
fmt
       , Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX Any)
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX Any)
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readMove FileNameFormat
fmt
       , Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX Any)
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX Any)
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readRmFile FileNameFormat
fmt
       , Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX Any)
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX Any)
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readRmDir FileNameFormat
fmt
       , Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX Any)
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX Any)
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readTok FileNameFormat
fmt
       , Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX Any)
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX Any)
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readBinary FileNameFormat
fmt
       , Parser ByteString (Prim wX Any)
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' Parser ByteString (Prim wX Any)
forall wX wY. Parser (Prim wX wY)
readChangePref
       ]
    where
    return' :: Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return'  = (a wX -> Sealed a)
-> Parser ByteString (a wX) -> Parser ByteString (Sealed a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a wX -> Sealed a
forall (a :: * -> *) wX. a wX -> Sealed a
seal

hunk' :: B.ByteString
hunk' :: ByteString
hunk' = String -> ByteString
BC.pack String
"hunk"

replace :: B.ByteString
replace :: ByteString
replace = String -> ByteString
BC.pack String
"replace"

binary' :: B.ByteString
binary' :: ByteString
binary' = String -> ByteString
BC.pack String
"binary"

addfile :: B.ByteString
addfile :: ByteString
addfile = String -> ByteString
BC.pack String
"addfile"

adddir :: B.ByteString
adddir :: ByteString
adddir = String -> ByteString
BC.pack String
"adddir"

rmfile :: B.ByteString
rmfile :: ByteString
rmfile = String -> ByteString
BC.pack String
"rmfile"

rmdir :: B.ByteString
rmdir :: ByteString
rmdir = String -> ByteString
BC.pack String
"rmdir"

move :: B.ByteString
move :: ByteString
move = String -> ByteString
BC.pack String
"move"

changepref :: B.ByteString
changepref :: ByteString
changepref = String -> ByteString
BC.pack String
"changepref"

readHunk :: FileNameFormat -> Parser (Prim wX wY)
readHunk :: forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readHunk FileNameFormat
fmt = do
  ByteString -> Parser ()
string ByteString
hunk'
  AnchoredPath
fi <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  Int
l <- Parser Int
int
  Bool
have_nl <- Parser Bool
skipNewline
  if Bool
have_nl
    then do
      [ByteString]
_ <- Char -> Parser [ByteString]
linesStartingWith Char
' ' -- skipping context
      [ByteString]
old <- Char -> Parser [ByteString]
linesStartingWith Char
'-'
      [ByteString]
new <- Char -> Parser [ByteString]
linesStartingWith Char
'+'
      [ByteString]
_ <- Char -> Parser [ByteString]
linesStartingWith Char
' ' -- skipping context
      Prim wX wY -> Parser (Prim wX wY)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> Parser (Prim wX wY))
-> Prim wX wY -> Parser (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> Int -> [ByteString] -> [ByteString] -> Prim wX wY
forall wX wY.
AnchoredPath -> Int -> [ByteString] -> [ByteString] -> Prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> Int -> [ByteString] -> [ByteString] -> prim wX wY
hunk AnchoredPath
fi Int
l [ByteString]
old [ByteString]
new
    else Prim wX wY -> Parser (Prim wX wY)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> Parser (Prim wX wY))
-> Prim wX wY -> Parser (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> Int -> [ByteString] -> [ByteString] -> Prim wX wY
forall wX wY.
AnchoredPath -> Int -> [ByteString] -> [ByteString] -> Prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> Int -> [ByteString] -> [ByteString] -> prim wX wY
hunk AnchoredPath
fi Int
l [] []

skipNewline :: Parser Bool
skipNewline :: Parser Bool
skipNewline = Bool -> Parser Bool -> Parser Bool
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option Bool
False (Char -> Parser ()
char Char
'\n' Parser () -> Parser Bool -> Parser Bool
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)

readTok :: FileNameFormat -> Parser (Prim wX wY)
readTok :: forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readTok FileNameFormat
fmt = do
  ByteString -> Parser ()
string ByteString
replace
  AnchoredPath
f <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  ByteString
regstr <- Parser ByteString
lexWord
  ByteString
o <- Parser ByteString
lexWord
  ByteString
n <- Parser ByteString
lexWord
  Prim wX wY -> Parser (Prim wX wY)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> Parser (Prim wX wY))
-> Prim wX wY -> Parser (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> FilePatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (FilePatchType wX wY -> Prim wX wY)
-> FilePatchType wX wY -> Prim wX wY
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> FilePatchType wX wY
forall wX wY. String -> String -> String -> FilePatchType wX wY
TokReplace (ByteString -> String
BC.unpack (ByteString -> ByteString
drop_brackets ByteString
regstr))
                             (ByteString -> String
BC.unpack ByteString
o) (ByteString -> String
BC.unpack ByteString
n)
    where drop_brackets :: ByteString -> ByteString
drop_brackets = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.init (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail


-- * Binary file modification
--
-- | Modify a binary file
--
-- > binary FILENAME
-- > oldhex
-- > *HEXHEXHEX
-- > ...
-- > newhex
-- > *HEXHEXHEX
-- > ...
readBinary :: FileNameFormat -> Parser (Prim wX wY)
readBinary :: forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readBinary FileNameFormat
fmt = do
  ByteString -> Parser ()
string ByteString
binary'
  AnchoredPath
fi <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  ByteString
_ <- Parser ByteString
lexWord
  Parser ()
skipSpace
  [ByteString]
old <- Char -> Parser [ByteString]
linesStartingWith Char
'*'
  ByteString
r_old <- (String -> Parser ByteString)
-> (ByteString -> Parser ByteString)
-> Either String ByteString
-> Parser ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ByteString -> Parser ByteString)
-> Either String ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
fromHex2PS (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ByteString]
old
  ByteString
_ <- Parser ByteString
lexWord
  Parser ()
skipSpace
  [ByteString]
new <- Char -> Parser [ByteString]
linesStartingWith Char
'*'
  ByteString
r_new <- (String -> Parser ByteString)
-> (ByteString -> Parser ByteString)
-> Either String ByteString
-> Parser ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ByteString
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ByteString -> Parser ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ByteString -> Parser ByteString)
-> Either String ByteString -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
fromHex2PS (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ByteString]
new
  Prim wX wY -> Parser (Prim wX wY)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> Parser (Prim wX wY))
-> Prim wX wY -> Parser (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> ByteString -> ByteString -> Prim wX wY
forall wX wY.
AnchoredPath -> ByteString -> ByteString -> Prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
AnchoredPath -> ByteString -> ByteString -> prim wX wY
binary AnchoredPath
fi ByteString
r_old ByteString
r_new

readAddFile :: FileNameFormat -> Parser (Prim wX wY)
readAddFile :: forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readAddFile FileNameFormat
fmt = do
  ByteString -> Parser ()
string ByteString
addfile
  AnchoredPath
f <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  Prim wX wY -> Parser (Prim wX wY)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> Parser (Prim wX wY))
-> Prim wX wY -> Parser (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> FilePatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f FilePatchType wX wY
forall wX wY. FilePatchType wX wY
AddFile

readRmFile :: FileNameFormat -> Parser (Prim wX wY)
readRmFile :: forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readRmFile FileNameFormat
fmt = do
  ByteString -> Parser ()
string ByteString
rmfile
  AnchoredPath
f <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  Prim wX wY -> Parser (Prim wX wY)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> Parser (Prim wX wY))
-> Prim wX wY -> Parser (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> FilePatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f FilePatchType wX wY
forall wX wY. FilePatchType wX wY
RmFile

readMove :: FileNameFormat -> Parser (Prim wX wY)
readMove :: forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readMove FileNameFormat
fmt = do
  ByteString -> Parser ()
string ByteString
move
  AnchoredPath
d <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  AnchoredPath
d' <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  Prim wX wY -> Parser (Prim wX wY)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> Parser (Prim wX wY))
-> Prim wX wY -> Parser (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> AnchoredPath -> Prim wX wY
forall wX wY. AnchoredPath -> AnchoredPath -> Prim wX wY
Move AnchoredPath
d AnchoredPath
d'

readChangePref :: Parser (Prim wX wY)
readChangePref :: forall wX wY. Parser (Prim wX wY)
readChangePref = do
  ByteString -> Parser ()
string ByteString
changepref
  ByteString
p <- Parser ByteString
lexWord
  (Char -> Bool) -> Parser ()
skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
  Char
_ <- Parser Char
anyChar -- skip newline
  ByteString
f <- Char -> Parser ByteString
takeTillChar Char
'\n'
  Char
_ <- Parser Char
anyChar -- skip newline
  ByteString
t <- Char -> Parser ByteString
takeTillChar Char
'\n'
  Prim wX wY -> Parser (Prim wX wY)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> Parser (Prim wX wY))
-> Prim wX wY -> Parser (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> Prim wX wY
forall wX wY. String -> String -> String -> Prim wX wY
ChangePref (ByteString -> String
BC.unpack ByteString
p) (ByteString -> String
BC.unpack ByteString
f) (ByteString -> String
BC.unpack ByteString
t)

readAddDir :: FileNameFormat -> Parser (Prim wX wY)
readAddDir :: forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readAddDir FileNameFormat
fmt = do
  ByteString -> Parser ()
string ByteString
adddir
  AnchoredPath
f <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  Prim wX wY -> Parser (Prim wX wY)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> Parser (Prim wX wY))
-> Prim wX wY -> Parser (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> DirPatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
f DirPatchType wX wY
forall wX wY. DirPatchType wX wY
AddDir

readRmDir :: FileNameFormat -> Parser (Prim wX wY)
readRmDir :: forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readRmDir FileNameFormat
fmt = do
  ByteString -> Parser ()
string ByteString
rmdir
  AnchoredPath
f <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  Prim wX wY -> Parser (Prim wX wY)
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> Parser (Prim wX wY))
-> Prim wX wY -> Parser (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> DirPatchType wX wY -> Prim wX wY
forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
f DirPatchType wX wY
forall wX wY. DirPatchType wX wY
RmDir