{-# 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 ' '
[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 ' '
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
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
ByteString
f <- Char -> m ByteString
forall (m :: * -> *). ParserM m => Char -> m ByteString
takeTillChar '\n'
Char
_ <- m Char
forall (m :: * -> *). ParserM m => m Char
anyChar
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