module Darcs.Repository.Inventory.Format
    ( Inventory(..)
    , HeadInventory
    , InventoryEntry
    , ValidHash(..) -- re-export
    , decodeValidHash -- re-export
    , encodeValidHash -- re-export
    , InventoryHash
    , PatchHash
    , PristineHash
    , inventoryPatchNames
    , parseInventory
    , parseHeadInventory -- not used
    , showInventory
    , showInventoryPatches
    , showInventoryEntry
    , emptyInventory
    , pokePristineHash
    , peekPristineHash
    , skipPristineHash
    , pristineName
    -- properties
    , prop_inventoryParseShow
    , prop_peekPokePristineHash
    , prop_skipPokePristineHash
    ) where

import Darcs.Prelude

import Control.Applicative ( optional, many )

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC

import Darcs.Patch.Info ( PatchInfo, showPatchInfo, readPatchInfo )
import Darcs.Util.Parser
    ( Parser, char, parse, string, skipSpace )
import Darcs.Patch.Show ( ShowPatchFor(..) )
import Darcs.Util.Printer
    ( Doc, (<+>), ($$), hcat, text, invisiblePS, packedString, renderPS )
import Darcs.Util.ValidHash
    ( InventoryHash
    , PatchHash
    , PristineHash
    , ValidHash(..)
    , calcValidHash
    , decodeValidHash
    , encodeValidHash
    , parseValidHash
    )

-- * Inventories

-- This type and the parser combinators for it aren't actually used. They are
-- here to serve as documentation for the API we would like to use but won't
-- because of efficiency: we want to be able to access the pristine hash
-- without forcing a complete parse of the head inventory. Thus we retain the
-- lower-level peek/poke/skip API for the pristine hash.
type HeadInventory = (PristineHash, Inventory)

data Inventory = Inventory
  { Inventory -> Maybe InventoryHash
inventoryParent :: Maybe InventoryHash
  , Inventory -> [InventoryEntry]
inventoryPatches :: [InventoryEntry]
  } deriving (Inventory -> Inventory -> Bool
(Inventory -> Inventory -> Bool)
-> (Inventory -> Inventory -> Bool) -> Eq Inventory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Inventory -> Inventory -> Bool
== :: Inventory -> Inventory -> Bool
$c/= :: Inventory -> Inventory -> Bool
/= :: Inventory -> Inventory -> Bool
Eq, Int -> Inventory -> ShowS
[Inventory] -> ShowS
Inventory -> String
(Int -> Inventory -> ShowS)
-> (Inventory -> String)
-> ([Inventory] -> ShowS)
-> Show Inventory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Inventory -> ShowS
showsPrec :: Int -> Inventory -> ShowS
$cshow :: Inventory -> String
show :: Inventory -> String
$cshowList :: [Inventory] -> ShowS
showList :: [Inventory] -> ShowS
Show)

-- The 'String' is the (hashed) patch filename.
type InventoryEntry = (PatchInfo, PatchHash)

inventoryPatchNames :: Inventory -> [String]
inventoryPatchNames :: Inventory -> [String]
inventoryPatchNames = (InventoryEntry -> String) -> [InventoryEntry] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (PatchHash -> String
forall h. ValidHash h => h -> String
encodeValidHash (PatchHash -> String)
-> (InventoryEntry -> PatchHash) -> InventoryEntry -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InventoryEntry -> PatchHash
forall a b. (a, b) -> b
snd) ([InventoryEntry] -> [String])
-> (Inventory -> [InventoryEntry]) -> Inventory -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [InventoryEntry]
inventoryPatches

emptyInventory :: Inventory
emptyInventory :: Inventory
emptyInventory = Maybe InventoryHash -> [InventoryEntry] -> Inventory
Inventory Maybe InventoryHash
forall a. Maybe a
Nothing []

-- * Parsing

parseHeadInventory :: B.ByteString -> Either String HeadInventory
parseHeadInventory :: ByteString -> Either String HeadInventory
parseHeadInventory = ((HeadInventory, ByteString) -> HeadInventory)
-> Either String (HeadInventory, ByteString)
-> Either String HeadInventory
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HeadInventory, ByteString) -> HeadInventory
forall a b. (a, b) -> a
fst (Either String (HeadInventory, ByteString)
 -> Either String HeadInventory)
-> (ByteString -> Either String (HeadInventory, ByteString))
-> ByteString
-> Either String HeadInventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser HeadInventory
-> ByteString -> Either String (HeadInventory, ByteString)
forall a. Parser a -> ByteString -> Either String (a, ByteString)
parse Parser HeadInventory
pHeadInv

parseInventory :: B.ByteString -> Either String Inventory
parseInventory :: ByteString -> Either String Inventory
parseInventory = ((Inventory, ByteString) -> Inventory)
-> Either String (Inventory, ByteString) -> Either String Inventory
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Inventory, ByteString) -> Inventory
forall a b. (a, b) -> a
fst (Either String (Inventory, ByteString) -> Either String Inventory)
-> (ByteString -> Either String (Inventory, ByteString))
-> ByteString
-> Either String Inventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Inventory
-> ByteString -> Either String (Inventory, ByteString)
forall a. Parser a -> ByteString -> Either String (a, ByteString)
parse Parser Inventory
pInv

pHeadInv :: Parser HeadInventory
pHeadInv :: Parser HeadInventory
pHeadInv = (,) (PristineHash -> Inventory -> HeadInventory)
-> Parser ByteString PristineHash
-> Parser ByteString (Inventory -> HeadInventory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString PristineHash
pPristineHash Parser ByteString (Inventory -> HeadInventory)
-> Parser Inventory -> Parser HeadInventory
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Inventory
pInv

pPristineHash :: Parser PristineHash
pPristineHash :: Parser ByteString PristineHash
pPristineHash = do
  ByteString -> Parser ()
string ByteString
pristineName
  Parser ()
skipSpace
  Parser ByteString PristineHash
forall h. ValidHash h => Parser h
pHash

pInv :: Parser Inventory
pInv :: Parser Inventory
pInv = Maybe InventoryHash -> [InventoryEntry] -> Inventory
Inventory (Maybe InventoryHash -> [InventoryEntry] -> Inventory)
-> Parser ByteString (Maybe InventoryHash)
-> Parser ByteString ([InventoryEntry] -> Inventory)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe InventoryHash)
pInvParent Parser ByteString ([InventoryEntry] -> Inventory)
-> Parser ByteString [InventoryEntry] -> Parser Inventory
forall a b.
Parser ByteString (a -> b)
-> Parser ByteString a -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString [InventoryEntry]
pInvPatches

pInvParent :: Parser (Maybe InventoryHash)
pInvParent :: Parser ByteString (Maybe InventoryHash)
pInvParent = Parser ByteString InventoryHash
-> Parser ByteString (Maybe InventoryHash)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ByteString InventoryHash
 -> Parser ByteString (Maybe InventoryHash))
-> Parser ByteString InventoryHash
-> Parser ByteString (Maybe InventoryHash)
forall a b. (a -> b) -> a -> b
$ do
  ByteString -> Parser ()
string ByteString
parentName
  Parser ()
skipSpace
  Parser ByteString InventoryHash
forall h. ValidHash h => Parser h
pHash

pHash :: ValidHash h => Parser h
pHash :: forall h. ValidHash h => Parser h
pHash = Parser h
forall h. ValidHash h => Parser h
parseValidHash Parser h -> Parser () -> Parser h
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ()
char Char
'\n'

pInvPatches :: Parser [InventoryEntry]
pInvPatches :: Parser ByteString [InventoryEntry]
pInvPatches = Parser ByteString InventoryEntry
-> Parser ByteString [InventoryEntry]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser ByteString InventoryEntry
pInvEntry

pInvEntry :: Parser InventoryEntry
pInvEntry :: Parser ByteString InventoryEntry
pInvEntry = do
  PatchInfo
info <- Parser PatchInfo
readPatchInfo
  Parser ()
skipSpace
  ByteString -> Parser ()
string ByteString
hashName
  Parser ()
skipSpace
  PatchHash
hash <- Parser PatchHash
forall h. ValidHash h => Parser h
pHash
  InventoryEntry -> Parser ByteString InventoryEntry
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
info, PatchHash
hash)

-- * Showing

showInventory :: Inventory -> Doc
showInventory :: Inventory -> Doc
showInventory Inventory
inv =
  Maybe InventoryHash -> Doc
showParent (Inventory -> Maybe InventoryHash
inventoryParent Inventory
inv) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
  [InventoryEntry] -> Doc
showInventoryPatches (Inventory -> [InventoryEntry]
inventoryPatches Inventory
inv)

showInventoryPatches :: [InventoryEntry] -> Doc
showInventoryPatches :: [InventoryEntry] -> Doc
showInventoryPatches = [Doc] -> Doc
hcat ([Doc] -> Doc)
-> ([InventoryEntry] -> [Doc]) -> [InventoryEntry] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InventoryEntry -> Doc) -> [InventoryEntry] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map InventoryEntry -> Doc
showInventoryEntry

showInventoryEntry :: InventoryEntry -> Doc
showInventoryEntry :: InventoryEntry -> Doc
showInventoryEntry (PatchInfo
pinf, PatchHash
hash) =
  ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
ForStorage PatchInfo
pinf Doc -> Doc -> Doc
$$
  ByteString -> Doc
packedString ByteString
hashName Doc -> Doc -> Doc
<+> String -> Doc
text (PatchHash -> String
forall h. ValidHash h => h -> String
encodeValidHash PatchHash
hash) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
packedString ByteString
newline

showParent :: Maybe InventoryHash -> Doc
showParent :: Maybe InventoryHash -> Doc
showParent (Just InventoryHash
hash) =
  ByteString -> Doc
packedString ByteString
parentName Doc -> Doc -> Doc
$$ String -> Doc
text (InventoryHash -> String
forall h. ValidHash h => h -> String
encodeValidHash InventoryHash
hash) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ByteString -> Doc
packedString ByteString
newline
showParent Maybe InventoryHash
Nothing = Doc
forall a. Monoid a => a
mempty

-- * Accessing the pristine hash

-- | Replace the pristine hash at the start of a raw, unparsed 'HeadInventory'
-- or add it if none is present.
pokePristineHash :: PristineHash -> B.ByteString -> Doc
pokePristineHash :: PristineHash -> ByteString -> Doc
pokePristineHash PristineHash
hash ByteString
inv =
  ByteString -> Doc
invisiblePS ByteString
pristineName Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (PristineHash -> String
forall h. ValidHash h => h -> String
encodeValidHash PristineHash
hash) Doc -> Doc -> Doc
$$ ByteString -> Doc
invisiblePS (ByteString -> ByteString
skipPristineHash ByteString
inv)

takeHash :: B.ByteString -> Maybe (PristineHash, B.ByteString)
takeHash :: ByteString -> Maybe (PristineHash, ByteString)
takeHash ByteString
input = do
  let (ByteString
hline,ByteString
rest) = ByteString -> ByteString -> (ByteString, ByteString)
BC.breakSubstring ByteString
newline ByteString
input
  PristineHash
ph <- String -> Maybe PristineHash
forall h. ValidHash h => String -> Maybe h
decodeValidHash (ByteString -> String
BC.unpack ByteString
hline)
  (PristineHash, ByteString) -> Maybe (PristineHash, ByteString)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (PristineHash
ph, ByteString
rest)

peekPristineHash :: B.ByteString -> PristineHash
peekPristineHash :: ByteString -> PristineHash
peekPristineHash ByteString
inv =
  case ByteString -> Maybe ByteString
tryDropPristineName ByteString
inv of
    Just ByteString
rest ->
      case ByteString -> Maybe (PristineHash, ByteString)
takeHash ByteString
rest of
        Just (PristineHash
h, ByteString
_) -> PristineHash
h
        Maybe (PristineHash, ByteString)
Nothing -> String -> PristineHash
forall a. HasCallStack => String -> a
error (String -> PristineHash) -> String -> PristineHash
forall a b. (a -> b) -> a -> b
$ String
"Bad hash in inventory!"
    Maybe ByteString
Nothing -> ByteString -> PristineHash
forall h. ValidHash h => ByteString -> h
calcValidHash ByteString
B.empty

-- |skipPristineHash drops the 'pristine: HASH' prefix line, if present.
skipPristineHash :: B.ByteString -> B.ByteString
skipPristineHash :: ByteString -> ByteString
skipPristineHash ByteString
ps =
  case ByteString -> Maybe ByteString
tryDropPristineName ByteString
ps of
    Just ByteString
rest -> Int -> ByteString -> ByteString
B.drop Int
1 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
BC.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') ByteString
rest
    Maybe ByteString
Nothing -> ByteString
ps

tryDropPristineName :: B.ByteString -> Maybe B.ByteString
tryDropPristineName :: ByteString -> Maybe ByteString
tryDropPristineName ByteString
input =
    if ByteString
prefix ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
pristineName then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
rest else Maybe ByteString
forall a. Maybe a
Nothing
  where
    (ByteString
prefix, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt (ByteString -> Int
B.length ByteString
pristineName) ByteString
input

-- * Key phrases

pristineName :: B.ByteString
pristineName :: ByteString
pristineName = String -> ByteString
BC.pack String
"pristine:"

parentName :: B.ByteString
parentName :: ByteString
parentName = String -> ByteString
BC.pack String
"Starting with inventory:"

hashName :: B.ByteString
hashName :: ByteString
hashName = String -> ByteString
BC.pack String
"hash:"

newline :: B.ByteString
newline :: ByteString
newline = String -> ByteString
BC.pack String
"\n"

-- * Properties

prop_inventoryParseShow :: Inventory -> Bool
prop_inventoryParseShow :: Inventory -> Bool
prop_inventoryParseShow Inventory
inv =
  Inventory -> Either String Inventory
forall a b. b -> Either a b
Right Inventory
inv Either String Inventory -> Either String Inventory -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Either String Inventory
parseInventory (Doc -> ByteString
renderPS (Inventory -> Doc
showInventory Inventory
inv))

prop_peekPokePristineHash :: (PristineHash, B.ByteString) -> Bool
prop_peekPokePristineHash :: (PristineHash, ByteString) -> Bool
prop_peekPokePristineHash (PristineHash
hash, ByteString
raw) =
  PristineHash
hash PristineHash -> PristineHash -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> PristineHash
peekPristineHash (Doc -> ByteString
renderPS (PristineHash -> ByteString -> Doc
pokePristineHash PristineHash
hash ByteString
raw))

prop_skipPokePristineHash :: (PristineHash, B.ByteString) -> Bool
prop_skipPokePristineHash :: (PristineHash, ByteString) -> Bool
prop_skipPokePristineHash (PristineHash
hash, ByteString
raw) =
  ByteString
raw ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
skipPristineHash (Doc -> ByteString
renderPS (PristineHash -> ByteString -> Doc
pokePristineHash PristineHash
hash ByteString
raw))