{-# 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' :: forall wX. Parser (Sealed (RepoPatchV1 prim wX))
readPatch'
   = [Parser ByteString (Sealed (RepoPatchV1 prim wX))]
-> Parser ByteString (Sealed (RepoPatchV1 prim wX))
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ (RepoPatchV1 prim wX (ZonkAny 1) -> Sealed (RepoPatchV1 prim wX))
-> Parser ByteString (RepoPatchV1 prim wX (ZonkAny 1))
-> Parser ByteString (Sealed (RepoPatchV1 prim wX))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM RepoPatchV1 prim wX (ZonkAny 1) -> Sealed (RepoPatchV1 prim wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Parser ByteString (RepoPatchV1 prim wX (ZonkAny 1))
 -> Parser ByteString (Sealed (RepoPatchV1 prim wX)))
-> Parser ByteString (RepoPatchV1 prim wX (ZonkAny 1))
-> Parser ByteString (Sealed (RepoPatchV1 prim wX))
forall a b. (a -> b) -> a -> b
$ Parser ()
skipSpace Parser ()
-> Parser ByteString (RepoPatchV1 prim wX (ZonkAny 1))
-> Parser ByteString (RepoPatchV1 prim wX (ZonkAny 1))
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 ByteString (RepoPatchV1 prim wX (ZonkAny 1))
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
Bool -> Parser (RepoPatchV1 prim wX wY)
readMerger Bool
True
            , (RepoPatchV1 prim wX (ZonkAny 2) -> Sealed (RepoPatchV1 prim wX))
-> Parser ByteString (RepoPatchV1 prim wX (ZonkAny 2))
-> Parser ByteString (Sealed (RepoPatchV1 prim wX))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM RepoPatchV1 prim wX (ZonkAny 2) -> Sealed (RepoPatchV1 prim wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (Parser ByteString (RepoPatchV1 prim wX (ZonkAny 2))
 -> Parser ByteString (Sealed (RepoPatchV1 prim wX)))
-> Parser ByteString (RepoPatchV1 prim wX (ZonkAny 2))
-> Parser ByteString (Sealed (RepoPatchV1 prim wX))
forall a b. (a -> b) -> a -> b
$ Parser ()
skipSpace Parser ()
-> Parser ByteString (RepoPatchV1 prim wX (ZonkAny 2))
-> Parser ByteString (RepoPatchV1 prim wX (ZonkAny 2))
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 ByteString (RepoPatchV1 prim wX (ZonkAny 2))
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 ByteString (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 prim wX wX -> RepoPatchV1 prim wX wX
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 wX. Parser (Sealed (prim wX))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
            ]
readMerger :: (PrimPatch prim) => Bool -> Parser (RepoPatchV1 prim wX wY)
readMerger :: forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
Bool -> Parser (RepoPatchV1 prim wX wY)
readMerger Bool
b = do ByteString -> Parser ()
string ByteString
s
                  g <- Parser ByteString
lexWord
                  lexChar '('
                  Sealed p1 <- readPatch'
                  Sealed p2 <- readPatch'
                  lexChar ')'
                  Sealed m <- return $ merger (BC.unpack g) p1 p2
                  return $ if b then unsafeCoerceP m else unsafeCoerceP (invert 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"