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

import Prelude ()
import Darcs.Prelude

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

import Darcs.Util.Path ( fn2fp )
import Darcs.Patch.Format ( FileNameFormat )
import Darcs.Patch.Read ( readFileName )
import Darcs.Patch.ReadMonads
    ( ParserM, takeTillChar, string, int
    , option, choice, anyChar, char, myLex'
    , 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 :: FileNameFormat -> m (Sealed (Prim wX))
readPrim fmt :: FileNameFormat
fmt
     = m ()
forall (m :: * -> *). ParserM m => m ()
skipSpace m () -> m (Sealed (Prim wX)) -> m (Sealed (Prim wX))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [m (Sealed (Prim wX))] -> m (Sealed (Prim wX))
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
       [ m (Prim wX Any) -> m (Sealed (Prim wX))
forall (a :: * -> *) wX. m (a wX) -> m (Sealed a)
return' (m (Prim wX Any) -> m (Sealed (Prim wX)))
-> m (Prim wX Any) -> m (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> m (Prim wX Any)
forall (m :: * -> *) wX wY.
ParserM m =>
FileNameFormat -> m (Prim wX wY)
readHunk FileNameFormat
fmt
       , m (Prim wX Any) -> m (Sealed (Prim wX))
forall (a :: * -> *) wX. m (a wX) -> m (Sealed a)
return' (m (Prim wX Any) -> m (Sealed (Prim wX)))
-> m (Prim wX Any) -> m (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> m (Prim wX Any)
forall (m :: * -> *) wX wY.
ParserM m =>
FileNameFormat -> m (Prim wX wY)
readAddFile FileNameFormat
fmt
       , m (Prim wX Any) -> m (Sealed (Prim wX))
forall (a :: * -> *) wX. m (a wX) -> m (Sealed a)
return' (m (Prim wX Any) -> m (Sealed (Prim wX)))
-> m (Prim wX Any) -> m (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> m (Prim wX Any)
forall (m :: * -> *) wX wY.
ParserM m =>
FileNameFormat -> m (Prim wX wY)
readAddDir FileNameFormat
fmt
       , m (Prim wX Any) -> m (Sealed (Prim wX))
forall (a :: * -> *) wX. m (a wX) -> m (Sealed a)
return' (m (Prim wX Any) -> m (Sealed (Prim wX)))
-> m (Prim wX Any) -> m (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> m (Prim wX Any)
forall (m :: * -> *) wX wY.
ParserM m =>
FileNameFormat -> m (Prim wX wY)
readMove FileNameFormat
fmt
       , m (Prim wX Any) -> m (Sealed (Prim wX))
forall (a :: * -> *) wX. m (a wX) -> m (Sealed a)
return' (m (Prim wX Any) -> m (Sealed (Prim wX)))
-> m (Prim wX Any) -> m (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> m (Prim wX Any)
forall (m :: * -> *) wX wY.
ParserM m =>
FileNameFormat -> m (Prim wX wY)
readRmFile FileNameFormat
fmt
       , m (Prim wX Any) -> m (Sealed (Prim wX))
forall (a :: * -> *) wX. m (a wX) -> m (Sealed a)
return' (m (Prim wX Any) -> m (Sealed (Prim wX)))
-> m (Prim wX Any) -> m (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> m (Prim wX Any)
forall (m :: * -> *) wX wY.
ParserM m =>
FileNameFormat -> m (Prim wX wY)
readRmDir FileNameFormat
fmt
       , m (Prim wX Any) -> m (Sealed (Prim wX))
forall (a :: * -> *) wX. m (a wX) -> m (Sealed a)
return' (m (Prim wX Any) -> m (Sealed (Prim wX)))
-> m (Prim wX Any) -> m (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> m (Prim wX Any)
forall (m :: * -> *) wX wY.
ParserM m =>
FileNameFormat -> m (Prim wX wY)
readTok FileNameFormat
fmt
       , m (Prim wX Any) -> m (Sealed (Prim wX))
forall (a :: * -> *) wX. m (a wX) -> m (Sealed a)
return' (m (Prim wX Any) -> m (Sealed (Prim wX)))
-> m (Prim wX Any) -> m (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> m (Prim wX Any)
forall (m :: * -> *) wX wY.
ParserM m =>
FileNameFormat -> m (Prim wX wY)
readBinary FileNameFormat
fmt
       , m (Prim wX Any) -> m (Sealed (Prim wX))
forall (a :: * -> *) wX. m (a wX) -> m (Sealed a)
return' m (Prim wX Any)
forall (m :: * -> *) wX wY. ParserM m => m (Prim wX wY)
readChangePref
       ]
    where
    return' :: m (a wX) -> m (Sealed a)
return'  = (a wX -> Sealed a) -> m (a wX) -> m (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 "hunk"

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

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

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

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

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

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

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

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

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

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

readTok :: ParserM m => FileNameFormat -> m (Prim wX wY)
readTok :: FileNameFormat -> m (Prim wX wY)
readTok fmt :: FileNameFormat
fmt = do
  ByteString -> m ()
forall (m :: * -> *). ParserM m => ByteString -> m ()
string ByteString
replace
  ByteString
f <- m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
  ByteString
regstr <- m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
  ByteString
o <- m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
  ByteString
n <- m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
  Prim wX wY -> m (Prim wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> m (Prim wX wY)) -> Prim wX wY -> m (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName -> FilePatchType wX wY -> Prim wX wY
forall wX wY. FileName -> FilePatchType wX wY -> Prim wX wY
FP (FileNameFormat -> ByteString -> FileName
readFileName FileNameFormat
fmt ByteString
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 = ByteString -> ByteString
B.init (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.tail


-- * Binary file modification
--
-- | Modify a binary file
--
-- > binary FILENAME
-- > oldhex
-- > *HEXHEXHEX
-- > ...
-- > newhex
-- > *HEXHEXHEX
-- > ...
readBinary :: ParserM m => FileNameFormat -> m (Prim wX wY)
readBinary :: FileNameFormat -> m (Prim wX wY)
readBinary fmt :: FileNameFormat
fmt = do
  ByteString -> m ()
forall (m :: * -> *). ParserM m => ByteString -> m ()
string ByteString
binary'
  ByteString
fi <- m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
  ByteString
_ <- m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
  m ()
forall (m :: * -> *). ParserM m => m ()
skipSpace
  [ByteString]
old <- Char -> m [ByteString]
forall (m :: * -> *). ParserM m => Char -> m [ByteString]
linesStartingWith '*'
  ByteString
_ <- m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
  m ()
forall (m :: * -> *). ParserM m => m ()
skipSpace
  [ByteString]
new <- Char -> m [ByteString]
forall (m :: * -> *). ParserM m => Char -> m [ByteString]
linesStartingWith '*'
  Prim wX wY -> m (Prim wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> m (Prim wX wY)) -> Prim wX wY -> m (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> ByteString -> Prim wX wY
forall (prim :: * -> * -> *) wX wY.
PrimConstruct prim =>
String -> ByteString -> ByteString -> prim wX wY
binary (FileName -> String
fn2fp (FileName -> String) -> FileName -> String
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> ByteString -> FileName
readFileName FileNameFormat
fmt ByteString
fi)
                  (ByteString -> ByteString
fromHex2PS (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ByteString]
old)
                  (ByteString -> ByteString
fromHex2PS (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat [ByteString]
new)

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

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

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

readChangePref :: ParserM m => m (Prim wX wY)
readChangePref :: m (Prim wX wY)
readChangePref = do
  ByteString -> m ()
forall (m :: * -> *). ParserM m => ByteString -> m ()
string ByteString
changepref
  ByteString
p <- m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
  (Char -> Bool) -> m ()
forall (m :: * -> *). ParserM m => (Char -> Bool) -> m ()
skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ')
  Char
_ <- m Char
forall (m :: * -> *). ParserM m => m Char
anyChar -- skip newline
  ByteString
f <- Char -> m ByteString
forall (m :: * -> *). ParserM m => Char -> m ByteString
takeTillChar '\n'
  Char
_ <- m Char
forall (m :: * -> *). ParserM m => m Char
anyChar -- skip newline
  ByteString
t <- Char -> m ByteString
forall (m :: * -> *). ParserM m => Char -> m ByteString
takeTillChar '\n'
  Prim wX wY -> m (Prim wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> m (Prim wX wY)) -> Prim wX wY -> m (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 :: ParserM m => FileNameFormat -> m (Prim wX wY)
readAddDir :: FileNameFormat -> m (Prim wX wY)
readAddDir fmt :: FileNameFormat
fmt = do
  ByteString -> m ()
forall (m :: * -> *). ParserM m => ByteString -> m ()
string ByteString
adddir
  ByteString
f <- m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
  Prim wX wY -> m (Prim wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Prim wX wY -> m (Prim wX wY)) -> Prim wX wY -> m (Prim wX wY)
forall a b. (a -> b) -> a -> b
$ FileName -> DirPatchType wX wY -> Prim wX wY
forall wX wY. FileName -> DirPatchType wX wY -> Prim wX wY
DP (FileNameFormat -> ByteString -> FileName
readFileName FileNameFormat
fmt ByteString
f) DirPatchType wX wY
forall wX wY. DirPatchType wX wY
AddDir

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