{-# LANGUAGE ViewPatterns, OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Darcs.Patch.Prim.FileUUID.Read () where import Darcs.Prelude hiding ( take ) import Control.Monad ( liftM, liftM2 ) import Darcs.Patch.Read ( ReadPatch(..) ) import Darcs.Patch.Prim.Class( PrimRead(..) ) import Darcs.Patch.Prim.FileUUID.Core( Prim(..), Hunk(..) ) import Darcs.Patch.Prim.FileUUID.ObjectMap import Darcs.Patch.Witnesses.Sealed( seal ) import Darcs.Util.Path ( decodeWhiteName ) import Darcs.Util.Parser instance PrimRead Prim where readPrim :: forall wX. FileNameFormat -> Parser (Sealed (Prim wX)) readPrim FileNameFormat _ = do Parser () skipSpace [Parser (Sealed (Prim wX))] -> Parser (Sealed (Prim wX)) forall (f :: * -> *) a. Alternative f => [f a] -> f a choice ([Parser (Sealed (Prim wX))] -> Parser (Sealed (Prim wX))) -> [Parser (Sealed (Prim wX))] -> Parser (Sealed (Prim wX)) forall a b. (a -> b) -> a -> b $ (Parser ByteString (Prim wX wX) -> Parser (Sealed (Prim wX))) -> [Parser ByteString (Prim wX wX)] -> [Parser (Sealed (Prim wX))] forall a b. (a -> b) -> [a] -> [b] map ((Prim wX wX -> Sealed (Prim wX)) -> Parser ByteString (Prim wX wX) -> Parser (Sealed (Prim wX)) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM Prim wX wX -> Sealed (Prim wX) forall (a :: * -> *) wX. a wX -> Sealed a seal) [ Parser ByteString (Prim wX wX) forall {wX}. Parser ByteString (Prim wX wX) identity , ByteString -> (UUID -> Hunk wX wX -> Prim wX wX) -> Parser ByteString (Prim wX wX) forall {wX} {wY} {b}. ByteString -> (UUID -> Hunk wX wY -> b) -> Parser ByteString b hunk ByteString "hunk" UUID -> Hunk wX wX -> Prim wX wX forall wX wY. UUID -> Hunk wX wY -> Prim wX wY Hunk , ByteString -> (UUID -> Location -> Prim wX wX) -> Parser ByteString (Prim wX wX) forall {r}. ByteString -> (UUID -> Location -> r) -> Parser ByteString r manifest ByteString "manifest" UUID -> Location -> Prim wX wX forall wX wY. UUID -> Location -> Prim wX wY Manifest , ByteString -> (UUID -> Location -> Prim wX wX) -> Parser ByteString (Prim wX wX) forall {r}. ByteString -> (UUID -> Location -> r) -> Parser ByteString r manifest ByteString "demanifest" UUID -> Location -> Prim wX wX forall wX wY. UUID -> Location -> Prim wX wY Demanifest ] where manifest :: ByteString -> (UUID -> Location -> r) -> Parser ByteString r manifest ByteString kind UUID -> Location -> r ctor = (UUID -> Location -> r) -> Parser ByteString UUID -> Parser ByteString Location -> Parser ByteString r forall (m :: * -> *) a1 a2 r. Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r liftM2 UUID -> Location -> r ctor (ByteString -> Parser ByteString UUID patch ByteString kind) Parser ByteString Location location identity :: Parser ByteString (Prim wX wX) identity = ByteString -> Parser () lexString ByteString "identity" Parser () -> Parser ByteString (Prim wX wX) -> Parser ByteString (Prim wX 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 >> Prim wX wX -> Parser ByteString (Prim wX wX) forall a. a -> Parser ByteString a forall (m :: * -> *) a. Monad m => a -> m a return Prim wX wX forall wX. Prim wX wX Identity patch :: ByteString -> Parser ByteString UUID patch ByteString x = ByteString -> Parser () string ByteString x Parser () -> Parser ByteString UUID -> Parser ByteString UUID 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 UUID uuid uuid :: Parser ByteString UUID uuid = ByteString -> UUID UUID (ByteString -> UUID) -> Parser ByteString ByteString -> Parser ByteString UUID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser ByteString ByteString lexWord filename :: Parser ByteString Name filename = do ByteString word <- Parser ByteString ByteString lexWord (String -> Parser ByteString Name) -> (Name -> Parser ByteString Name) -> Either String Name -> Parser ByteString Name forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either String -> Parser ByteString Name forall a. String -> Parser ByteString a forall (m :: * -> *) a. MonadFail m => String -> m a fail Name -> Parser ByteString Name forall a. a -> Parser ByteString a forall (m :: * -> *) a. Monad m => a -> m a return (Either String Name -> Parser ByteString Name) -> Either String Name -> Parser ByteString Name forall a b. (a -> b) -> a -> b $ ByteString -> Either String Name decodeWhiteName ByteString word content :: Parser ByteString ByteString content = do ByteString -> Parser () lexString ByteString "content" Int len <- Parser Int int () _ <- Char -> Parser () char Char '\n' Int -> Parser ByteString ByteString take Int len location :: Parser ByteString Location location = (UUID -> Name -> Location) -> Parser ByteString UUID -> Parser ByteString Name -> Parser ByteString Location forall (m :: * -> *) a1 a2 r. Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r liftM2 UUID -> Name -> Location L Parser ByteString UUID uuid Parser ByteString Name filename hunk :: ByteString -> (UUID -> Hunk wX wY -> b) -> Parser ByteString b hunk ByteString kind UUID -> Hunk wX wY -> b ctor = do UUID uid <- ByteString -> Parser ByteString UUID patch ByteString kind Int offset <- Parser Int int ByteString old <- Parser ByteString ByteString content ByteString new <- Parser ByteString ByteString content b -> Parser ByteString b forall a. a -> Parser ByteString a forall (m :: * -> *) a. Monad m => a -> m a return (b -> Parser ByteString b) -> b -> Parser ByteString b forall a b. (a -> b) -> a -> b $ UUID -> Hunk wX wY -> b ctor UUID uid (Int -> ByteString -> ByteString -> Hunk wX wY forall wX wY. Int -> ByteString -> ByteString -> Hunk wX wY H Int offset ByteString old ByteString new) instance ReadPatch Prim where readPatch' :: forall wX. Parser (Sealed (Prim wX)) readPatch' = FileNameFormat -> Parser (Sealed (Prim wX)) forall wX. FileNameFormat -> Parser (Sealed (Prim wX)) forall (prim :: * -> * -> *) wX. PrimRead prim => FileNameFormat -> Parser (Sealed (prim wX)) readPrim FileNameFormat forall a. HasCallStack => a undefined