{-# 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 forall (f :: * -> *) a. Alternative f => [f a] -> f a choice forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r liftM forall (a :: * -> *) wX. a wX -> Sealed a seal) [ forall {wX}. Parser ByteString (Prim wX wX) identity , forall {wX} {wY} {b}. ByteString -> (UUID -> Hunk wX wY -> b) -> Parser ByteString b hunk ByteString "hunk" forall wX wY. UUID -> Hunk wX wY -> Prim wX wY Hunk , forall {r}. ByteString -> (UUID -> Location -> r) -> Parser ByteString r manifest ByteString "manifest" forall wX wY. UUID -> Location -> Prim wX wY Manifest , forall {r}. ByteString -> (UUID -> Location -> r) -> Parser ByteString r manifest ByteString "demanifest" 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 = 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" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall (m :: * -> *) a. Monad m => a -> m a return forall wX. Prim wX wX Identity patch :: ByteString -> Parser ByteString UUID patch ByteString x = ByteString -> Parser () string ByteString x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Parser ByteString UUID uuid uuid :: Parser ByteString UUID uuid = ByteString -> UUID UUID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser ByteString lexWord filename :: Parser ByteString Name filename = ByteString -> Name decodeWhiteName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser ByteString lexWord content :: Parser ByteString content = do ByteString -> Parser () lexString ByteString "content" Int len <- Parser Int int () _ <- Char -> Parser () char Char '\n' Int -> Parser ByteString take Int len location :: Parser ByteString Location 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 content ByteString new <- Parser ByteString content forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ UUID -> Hunk wX wY -> b ctor UUID uid (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' = forall (prim :: * -> * -> *) wX. PrimRead prim => FileNameFormat -> Parser (Sealed (prim wX)) readPrim forall a. HasCallStack => a undefined