{-# 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"