{-# 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 :: 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Prim wX wX -> Parser ByteString (Prim wX wX)
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 (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 = ByteString -> Name
decodeWhiteName (ByteString -> Name)
-> Parser ByteString ByteString -> Parser ByteString Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
lexWord
      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 (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' :: Parser (Sealed (Prim wX))
readPatch' = FileNameFormat -> Parser (Sealed (Prim wX))
forall (prim :: * -> * -> *) wX.
PrimRead prim =>
FileNameFormat -> Parser (Sealed (prim wX))
readPrim FileNameFormat
forall a. HasCallStack => a
undefined