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

import Darcs.Prelude

import Darcs.Patch.Invert ( invert )
import Darcs.Patch.Prim ( PrimPatch )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Util.Parser ( Parser, choice, string,
                                lexChar, lexWord, skipSpace )

import Darcs.Patch.V1.Core ( RepoPatchV1(..) )
import Darcs.Patch.V1.Commute ( merger )

import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal, mapSeal )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )

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


instance PrimPatch prim => ReadPatch (RepoPatchV1 prim) where
 readPatch' :: Parser (Sealed (RepoPatchV1 prim wX))
readPatch'
   = [Parser (Sealed (RepoPatchV1 prim wX))]
-> Parser (Sealed (RepoPatchV1 prim wX))
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ (RepoPatchV1 prim wX Any -> Sealed (RepoPatchV1 prim wX))
-> Parser ByteString (RepoPatchV1 prim wX Any)
-> Parser (Sealed (RepoPatchV1 prim wX))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM RepoPatchV1 prim wX Any -> Sealed (RepoPatchV1 prim wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Parser ByteString (RepoPatchV1 prim wX Any)
 -> Parser (Sealed (RepoPatchV1 prim wX)))
-> Parser ByteString (RepoPatchV1 prim wX Any)
-> Parser (Sealed (RepoPatchV1 prim wX))
forall a b. (a -> b) -> a -> b
$ Parser ()
skipSpace Parser ()
-> Parser ByteString (RepoPatchV1 prim wX Any)
-> Parser ByteString (RepoPatchV1 prim wX Any)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser ByteString (RepoPatchV1 prim wX Any)
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
Bool -> Parser (RepoPatchV1 prim wX wY)
readMerger Bool
True
            , (RepoPatchV1 prim wX Any -> Sealed (RepoPatchV1 prim wX))
-> Parser ByteString (RepoPatchV1 prim wX Any)
-> Parser (Sealed (RepoPatchV1 prim wX))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM RepoPatchV1 prim wX Any -> Sealed (RepoPatchV1 prim wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Parser ByteString (RepoPatchV1 prim wX Any)
 -> Parser (Sealed (RepoPatchV1 prim wX)))
-> Parser ByteString (RepoPatchV1 prim wX Any)
-> Parser (Sealed (RepoPatchV1 prim wX))
forall a b. (a -> b) -> a -> b
$ Parser ()
skipSpace Parser ()
-> Parser ByteString (RepoPatchV1 prim wX Any)
-> Parser ByteString (RepoPatchV1 prim wX Any)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser ByteString (RepoPatchV1 prim wX Any)
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
Bool -> Parser (RepoPatchV1 prim wX wY)
readMerger Bool
False
            , (Sealed (prim wX) -> Sealed (RepoPatchV1 prim wX))
-> Parser ByteString (Sealed (prim wX))
-> Parser (Sealed (RepoPatchV1 prim wX))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((forall wX. prim wX wX -> RepoPatchV1 prim wX wX)
-> Sealed (prim wX) -> Sealed (RepoPatchV1 prim wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. prim wX wX -> RepoPatchV1 prim wX wX
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV1 prim wX wY
PP) Parser ByteString (Sealed (prim wX))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
            ]
readMerger :: (PrimPatch prim) => Bool -> Parser (RepoPatchV1 prim wX wY)
readMerger :: Bool -> Parser (RepoPatchV1 prim wX wY)
readMerger Bool
b = do ByteString -> Parser ()
string ByteString
s
                  ByteString
g <- Parser ByteString
lexWord
                  Char -> Parser ()
lexChar Char
'('
                  Sealed RepoPatchV1 prim Any wX
p1 <- Parser (Sealed (RepoPatchV1 prim Any))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
                  Sealed RepoPatchV1 prim Any wX
p2 <- Parser (Sealed (RepoPatchV1 prim Any))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
                  Char -> Parser ()
lexChar Char
')'
                  Sealed RepoPatchV1 prim wX wX
m <- Sealed (RepoPatchV1 prim wX)
-> Parser ByteString (Sealed (RepoPatchV1 prim wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RepoPatchV1 prim wX)
 -> Parser ByteString (Sealed (RepoPatchV1 prim wX)))
-> Sealed (RepoPatchV1 prim wX)
-> Parser ByteString (Sealed (RepoPatchV1 prim wX))
forall a b. (a -> b) -> a -> b
$ String
-> RepoPatchV1 prim Any wX
-> RepoPatchV1 prim Any wX
-> Sealed (RepoPatchV1 prim wX)
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> Sealed (RepoPatchV1 prim wY)
merger (ByteString -> String
BC.unpack ByteString
g) RepoPatchV1 prim Any wX
p1 RepoPatchV1 prim Any wX
p2
                  RepoPatchV1 prim wX wY -> Parser (RepoPatchV1 prim wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (RepoPatchV1 prim wX wY -> Parser (RepoPatchV1 prim wX wY))
-> RepoPatchV1 prim wX wY -> Parser (RepoPatchV1 prim wX wY)
forall a b. (a -> b) -> a -> b
$ if Bool
b then RepoPatchV1 prim wX wX -> RepoPatchV1 prim wX wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RepoPatchV1 prim wX wX
m else RepoPatchV1 prim wX wX -> RepoPatchV1 prim wX wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP (RepoPatchV1 prim wX wX -> RepoPatchV1 prim wX wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wX wX
m)
  where
  s :: ByteString
s | Bool
b         = ByteString
merger'
    | Bool
otherwise = ByteString
regrem

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

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