{-# LANGUAGE CPP, ViewPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Darcs.Patch.Prim.FileUUID.Read () where

import Prelude ()
import Darcs.Prelude

import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.ReadMonads
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 ( unsafeMakeName )

import Control.Monad ( liftM, liftM2 )
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.Char ( chr )

instance PrimRead Prim where
  readPrim :: FileNameFormat -> m (Sealed (Prim wX))
readPrim _ = do
    m ()
forall (m :: * -> *). ParserM m => m ()
skipSpace
    [m (Sealed (Prim wX))] -> m (Sealed (Prim wX))
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice ([m (Sealed (Prim wX))] -> m (Sealed (Prim wX)))
-> [m (Sealed (Prim wX))] -> m (Sealed (Prim wX))
forall a b. (a -> b) -> a -> b
$ (m (Prim wX wX) -> m (Sealed (Prim wX)))
-> [m (Prim wX wX)] -> [m (Sealed (Prim wX))]
forall a b. (a -> b) -> [a] -> [b]
map ((Prim wX wX -> Sealed (Prim wX))
-> m (Prim wX wX) -> m (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)
      [ m (Prim wX wX)
forall wX. m (Prim wX wX)
identity
      , ByteString -> (UUID -> Hunk wX wX -> Prim wX wX) -> m (Prim wX wX)
forall wX wY b. ByteString -> (UUID -> Hunk wX wY -> b) -> m b
hunk "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) -> m (Prim wX wX)
forall r. ByteString -> (UUID -> Location -> r) -> m r
manifest "manifest" UUID -> Location -> Prim wX wX
forall wX wY. UUID -> Location -> Prim wX wY
Manifest
      , ByteString -> (UUID -> Location -> Prim wX wX) -> m (Prim wX wX)
forall r. ByteString -> (UUID -> Location -> r) -> m r
manifest "demanifest" UUID -> Location -> Prim wX wX
forall wX wY. UUID -> Location -> Prim wX wY
Demanifest
      ]
    where
      manifest :: ByteString -> (UUID -> Location -> r) -> m r
manifest kind :: ByteString
kind ctor :: UUID -> Location -> r
ctor = (UUID -> Location -> r) -> m UUID -> m Location -> m r
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 UUID -> Location -> r
ctor (ByteString -> m UUID
patch ByteString
kind) m Location
location
      identity :: m (Prim wX wX)
identity = ByteString -> m ()
forall (m :: * -> *). ParserM m => ByteString -> m ()
lexString "identity" m () -> m (Prim wX wX) -> m (Prim wX wX)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Prim wX wX -> m (Prim wX wX)
forall (m :: * -> *) a. Monad m => a -> m a
return Prim wX wX
forall wX. Prim wX wX
Identity
      patch :: ByteString -> m UUID
patch x :: ByteString
x = ByteString -> m ()
forall (m :: * -> *). ParserM m => ByteString -> m ()
string ByteString
x m () -> m UUID -> m UUID
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m UUID
uuid
      uuid :: m UUID
uuid = ByteString -> UUID
UUID (ByteString -> UUID) -> m ByteString -> m UUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
      filename :: m Name
filename = ByteString -> Name
unsafeMakeName (ByteString -> Name)
-> (ByteString -> ByteString) -> ByteString -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
decodeWhite (ByteString -> Name) -> m ByteString -> m Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
      content :: m ByteString
content = do
        ByteString -> m ()
forall (m :: * -> *). ParserM m => ByteString -> m ()
lexString "content"
        Int
len <- m Int
forall (m :: * -> *). ParserM m => m Int
int
        ()
_ <- Char -> m ()
forall (m :: * -> *). ParserM m => Char -> m ()
char '\n'
        Int -> m ByteString
forall (m :: * -> *). ParserM m => Int -> m ByteString
Darcs.Patch.ReadMonads.take Int
len
      location :: m Location
location = (UUID -> Name -> Location) -> m UUID -> m Name -> m Location
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 UUID -> Name -> Location
L m UUID
uuid m Name
filename
      hunk :: ByteString -> (UUID -> Hunk wX wY -> b) -> m b
hunk kind :: ByteString
kind ctor :: UUID -> Hunk wX wY -> b
ctor = do
        UUID
uid <- ByteString -> m UUID
patch ByteString
kind
        Int
offset <- m Int
forall (m :: * -> *). ParserM m => m Int
int
        ByteString
old <- m ByteString
content
        ByteString
new <- m ByteString
content
        b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m 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' :: m (Sealed (Prim wX))
readPatch' = FileNameFormat -> m (Sealed (Prim wX))
forall (prim :: * -> * -> *) (m :: * -> *) wX.
(PrimRead prim, ParserM m) =>
FileNameFormat -> m (Sealed (prim wX))
readPrim FileNameFormat
forall a. HasCallStack => a
undefined

-- XXX a bytestring version of decodeWhite from Darcs.FileName
decodeWhite :: B.ByteString -> B.ByteString
decodeWhite :: ByteString -> ByteString
decodeWhite (ByteString -> Maybe (Char, ByteString)
BC.uncons -> Just ('\\', cs :: ByteString
cs)) =
    case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BC.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='\\') ByteString
cs of
    (theord :: ByteString
theord, ByteString -> Maybe (Char, ByteString)
BC.uncons -> Just ('\\', rest :: ByteString
rest)) ->
        Int -> Char
chr (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BC.unpack ByteString
theord) Char -> ByteString -> ByteString
`BC.cons` ByteString -> ByteString
decodeWhite ByteString
rest
    _ -> String -> ByteString
forall a. HasCallStack => String -> a
error "malformed filename"
decodeWhite (ByteString -> Maybe (Char, ByteString)
BC.uncons -> Just (c :: Char
c, cs :: ByteString
cs)) = Char
c Char -> ByteString -> ByteString
`BC.cons` ByteString -> ByteString
decodeWhite ByteString
cs
decodeWhite (ByteString -> Maybe (Char, ByteString)
BC.uncons -> Maybe (Char, ByteString)
Nothing) = ByteString
BC.empty
#if !MIN_VERSION_base(4,14,0)
decodeWhite _ = ByteString
forall a. a
impossible
#endif