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

import Prelude ()
import Darcs.Prelude

import Darcs.Patch.Invert ( invert )
import Darcs.Patch.Prim ( PrimPatch )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.ReadMonads ( ParserM, choice, string,
                                lexChar, myLex', 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' :: m (Sealed (RepoPatchV1 prim wX))
readPatch'
   = [m (Sealed (RepoPatchV1 prim wX))]
-> m (Sealed (RepoPatchV1 prim wX))
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [ (RepoPatchV1 prim wX Any -> Sealed (RepoPatchV1 prim wX))
-> m (RepoPatchV1 prim wX Any) -> m (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 (m (RepoPatchV1 prim wX Any) -> m (Sealed (RepoPatchV1 prim wX)))
-> m (RepoPatchV1 prim wX Any) -> m (Sealed (RepoPatchV1 prim wX))
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: * -> *). ParserM m => m ()
skipSpace m () -> m (RepoPatchV1 prim wX Any) -> m (RepoPatchV1 prim wX Any)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m (RepoPatchV1 prim wX Any)
forall (m :: * -> *) (prim :: * -> * -> *) wX wY.
(ParserM m, PrimPatch prim) =>
Bool -> m (RepoPatchV1 prim wX wY)
readMerger Bool
True
            , (RepoPatchV1 prim wX Any -> Sealed (RepoPatchV1 prim wX))
-> m (RepoPatchV1 prim wX Any) -> m (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 (m (RepoPatchV1 prim wX Any) -> m (Sealed (RepoPatchV1 prim wX)))
-> m (RepoPatchV1 prim wX Any) -> m (Sealed (RepoPatchV1 prim wX))
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: * -> *). ParserM m => m ()
skipSpace m () -> m (RepoPatchV1 prim wX Any) -> m (RepoPatchV1 prim wX Any)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m (RepoPatchV1 prim wX Any)
forall (m :: * -> *) (prim :: * -> * -> *) wX wY.
(ParserM m, PrimPatch prim) =>
Bool -> m (RepoPatchV1 prim wX wY)
readMerger Bool
False
            , (Sealed (prim wX) -> Sealed (RepoPatchV1 prim wX))
-> m (Sealed (prim wX)) -> m (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) m (Sealed (prim wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'
            ]
readMerger :: (ParserM m, PrimPatch prim) => Bool -> m (RepoPatchV1 prim wX wY)
readMerger :: Bool -> m (RepoPatchV1 prim wX wY)
readMerger b :: Bool
b = do ByteString -> m ()
forall (m :: * -> *). ParserM m => ByteString -> m ()
string ByteString
s
                  ByteString
g <- m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
                  Char -> m ()
forall (m :: * -> *). ParserM m => Char -> m ()
lexChar '('
                  Sealed p1 :: RepoPatchV1 prim Any wX
p1 <- m (Sealed (RepoPatchV1 prim Any))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'
                  Sealed p2 :: RepoPatchV1 prim Any wX
p2 <- m (Sealed (RepoPatchV1 prim Any))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'
                  Char -> m ()
forall (m :: * -> *). ParserM m => Char -> m ()
lexChar ')'
                  Sealed m :: RepoPatchV1 prim wX wX
m <- Sealed (RepoPatchV1 prim wX) -> m (Sealed (RepoPatchV1 prim wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RepoPatchV1 prim wX) -> m (Sealed (RepoPatchV1 prim wX)))
-> Sealed (RepoPatchV1 prim wX) -> m (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 -> m (RepoPatchV1 prim wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (RepoPatchV1 prim wX wY -> m (RepoPatchV1 prim wX wY))
-> RepoPatchV1 prim wX wY -> m (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 "merger"

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