{-# 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 _ = do
    skipSpace
    choice $ map (liftM seal)
      [ identity
      , hunk "hunk" Hunk
      , manifest "manifest" Manifest
      , manifest "demanifest" Demanifest
      ]
    where
      manifest kind ctor = liftM2 ctor (patch kind) location
      identity = lexString "identity" >> return Identity
      patch x = string x >> uuid
      uuid = UUID <$> myLex'
      filename = unsafeMakeName . decodeWhite <$> myLex'
      content = do
        lexString "content"
        len <- int
        _ <- char '\n'
        Darcs.Patch.ReadMonads.take len
      location = liftM2 L uuid filename
      hunk kind ctor = do
        uid <- patch kind
        offset <- int
        old <- content
        new <- content
        return $ ctor uid (H offset old new)

instance ReadPatch Prim where
 readPatch' = readPrim undefined

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