{-# 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 (ZonkAny 0))
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX (ZonkAny 0))
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX (ZonkAny 0))
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX (ZonkAny 0))
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readHunk FileNameFormat
fmt
       , Parser ByteString (Prim wX (ZonkAny 1))
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX (ZonkAny 1))
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX (ZonkAny 1))
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX (ZonkAny 1))
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readAddFile FileNameFormat
fmt
       , Parser ByteString (Prim wX (ZonkAny 2))
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX (ZonkAny 2))
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX (ZonkAny 2))
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX (ZonkAny 2))
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readAddDir FileNameFormat
fmt
       , Parser ByteString (Prim wX (ZonkAny 3))
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX (ZonkAny 3))
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX (ZonkAny 3))
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX (ZonkAny 3))
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readMove FileNameFormat
fmt
       , Parser ByteString (Prim wX (ZonkAny 4))
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX (ZonkAny 4))
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX (ZonkAny 4))
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX (ZonkAny 4))
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readRmFile FileNameFormat
fmt
       , Parser ByteString (Prim wX (ZonkAny 5))
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX (ZonkAny 5))
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX (ZonkAny 5))
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX (ZonkAny 5))
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readRmDir FileNameFormat
fmt
       , Parser ByteString (Prim wX (ZonkAny 6))
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX (ZonkAny 6))
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX (ZonkAny 6))
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX (ZonkAny 6))
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readTok FileNameFormat
fmt
       , Parser ByteString (Prim wX (ZonkAny 7))
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' (Parser ByteString (Prim wX (ZonkAny 7))
 -> Parser ByteString (Sealed (Prim wX)))
-> Parser ByteString (Prim wX (ZonkAny 7))
-> Parser ByteString (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ FileNameFormat -> Parser ByteString (Prim wX (ZonkAny 7))
forall wX wY. FileNameFormat -> Parser (Prim wX wY)
readBinary FileNameFormat
fmt
       , Parser ByteString (Prim wX (ZonkAny 8))
-> Parser ByteString (Sealed (Prim wX))
forall {a :: * -> *} {wX}.
Parser ByteString (a wX) -> Parser ByteString (Sealed a)
return' Parser ByteString (Prim wX (ZonkAny 8))
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'
  fi <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  l <- int
  have_nl <- skipNewline
  if have_nl
    then do
      _ <- linesStartingWith ' ' -- skipping context
      old <- linesStartingWith '-'
      new <- linesStartingWith '+'
      _ <- linesStartingWith ' ' -- skipping context
      return $ hunk fi l old new
    else return $ hunk fi 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
  f <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  regstr <- lexWord
  o <- lexWord
  n <- lexWord
  return $ FP f $ TokReplace (BC.unpack (drop_brackets regstr))
                             (BC.unpack o) (BC.unpack 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'
  fi <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  _ <- lexWord
  skipSpace
  old <- linesStartingWith '*'
  r_old <- either fail return $ fromHex2PS $ B.concat old
  _ <- lexWord
  skipSpace
  new <- linesStartingWith '*'
  r_new <- either fail return $ fromHex2PS $ B.concat new
  return $ binary fi r_old 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
  f <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  return $ FP f 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
  f <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  return $ FP f 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
  d <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  d' <- readFileName fmt
  return $ Move d d'

readChangePref :: Parser (Prim wX wY)
readChangePref :: forall wX wY. Parser (Prim wX wY)
readChangePref = do
  ByteString -> Parser ()
string ByteString
changepref
  p <- Parser ByteString
lexWord
  skipWhile (== ' ')
  _ <- anyChar -- skip newline
  f <- takeTillChar '\n'
  _ <- anyChar -- skip newline
  t <- takeTillChar '\n'
  return $ ChangePref (BC.unpack p) (BC.unpack f) (BC.unpack 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
  f <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  return $ DP f 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
  f <- HasCallStack => FileNameFormat -> Parser AnchoredPath
FileNameFormat -> Parser AnchoredPath
readFileName FileNameFormat
fmt
  return $ DP f RmDir