diff --git a/src/Darcs/Local/Hash/Codec.hs b/src/Darcs/Local/Hash/Codec.hs deleted file mode 100644 index dc787f2..0000000 --- a/src/Darcs/Local/Hash/Codec.hs +++ /dev/null @@ -1,49 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -module Darcs.Local.Hash.Codec - ( encodePatchHash - , encodeInventoryHash - ) -where - -import Prelude - -import Data.ByteString (ByteString) -import Data.Monoid ((<>)) - -import qualified Data.ByteString as B (length, replicate) -import qualified Data.ByteString.Base16 as B16 (encode) -import qualified Data.ByteString.Lex.Integral as BX (packDecimal) - -import Darcs.Local.Hash.Types - -encodeHash :: ByteString -> ByteString -encodeHash = B16.encode - -encodeSize :: Int -> ByteString -encodeSize n = - case BX.packDecimal n of - Nothing -> error "negative size in sizehash" - Just b -> - if B.length b < 10 - then B.replicate (10 - B.length b) 0x30 <> b - else b - -encodePatchHash :: PatchHash -> ByteString -encodePatchHash (PatchHash h) = encodeHash h - -encodeInventoryHash :: InventoryHash -> ByteString -encodeInventoryHash (InventoryHash s h) = encodeSize s <> "-" <> encodeHash h diff --git a/src/Darcs/Local/Hash/Types.hs b/src/Darcs/Local/Hash/Types.hs deleted file mode 100644 index 30d5215..0000000 --- a/src/Darcs/Local/Hash/Types.hs +++ /dev/null @@ -1,50 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -module Darcs.Local.Hash.Types - ( PatchHash (..) - , ContentHash (..) - , InventoryHash (..) - , PristineHash (..) - ) -where - -import Prelude - -import Data.ByteString (ByteString) - --- | A SHA1 hash of the patch info (author, title, description including junk, --- timestamp). The hash is in binary form, not hex, i.e. its size is always 20 --- bytes. -newtype PatchHash = PatchHash { unPatchHash :: ByteString } - --- | Content size and SHA256 hash of a patch's info and content. The hash is in --- binary form, not hex, i.e. its size is always 32 bytes. -data ContentHash = ContentHash - { chSize :: Int - , chHash :: ByteString - } - --- | Content size and SHA256 hash of an inventory (a patch set in a single --- invetory file). The hash is in binary form, not hex, i.e. its size is always --- 32 bytes. -data InventoryHash = InventoryHash - { ihSize :: Int - , ihHash :: ByteString - } - --- | A SHA256 hash of the entire recorded state of the repo. The hash is in --- binary form, not hex, i.e. its size is always 32 bytes. -newtype PristineHash = PristineHash { unPristineHash :: ByteString } diff --git a/src/Darcs/Local/Inventory/Parser.hs b/src/Darcs/Local/Inventory/Parser.hs deleted file mode 100644 index 50c0827..0000000 --- a/src/Darcs/Local/Inventory/Parser.hs +++ /dev/null @@ -1,345 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - --- We use the ByteString based Attoparsec and not the Text based one because we --- need to create a hash of the patch info. If we use the Text one, Attoparsec --- decodes the text, hopefully as UTF-8, and then we need to encode again to --- ByteString for the hashing. This is dangerous because if the encoding --- doesn't result with the exact original text, we'll have the wrong hash. To --- make sure it's exactly the right content, we use ByteString first and then --- later decode to Text. -module Darcs.Local.Inventory.Parser - ( latestInventoryPristineP - , latestInventorySizeP - , latestInventoryPrevSizeP - , latestInventoryPageP - , latestInventoryAllP - , earlyInventorySizeP - , earlyInventoryPrevSizeP - , earlyInventoryPageP - , earlyInventoryAllP - ) -where - -import Prelude hiding (take, takeWhile) - -import Control.Applicative (many, optional, liftA2) -import Control.Arrow (second) -import Control.Monad (replicateM_) -import Crypto.Hash -import Data.Attoparsec.ByteString -import Data.ByteArray (convert) -import Data.ByteString (ByteString) -import Data.Time.Calendar (fromGregorianValid) -import Data.Time.Clock (UTCTime (..), secondsToDiffTime) -import Data.Word (Word8) -import System.FilePath (()) - -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Base16 as B16 -import qualified Data.ByteString.Lex.Integral as BX - -import Control.Applicative.Local -import Darcs.Local.Hash.Types -import Darcs.Local.Inventory.Types -import Darcs.Local.Patch -import Darcs.Local.Patch.Types -import Data.Attoparsec.ByteString.Local -import Data.ByteString.Local (stripPrefix) -import Data.Text.UTF8.Local (decodeStrict) - -lf :: Word8 -lf = 10 -space :: Word8 -space = 32 -star :: Word8 -star = 42 -dash :: Word8 -dash = 45 -zero :: Word8 -zero = 48 -nine :: Word8 -nine = 57 -sqrOpen :: Word8 -sqrOpen = 91 ---sqrClose :: Word8 ---sqrClose = 93 - -digit :: Parser Word8 -digit = satisfy $ \ w -> zero <= w && w <= nine - -digitP :: Num a => Parser a -digitP = fmap (\ c -> fromIntegral $ c - zero) digit - -decimal2P :: Num a => Parser a -decimal2P = - (\ h l -> 10 * h + l) <$> - digitP <*> - digitP - -decimal4P :: Num a => Parser a -decimal4P = - (\ hh h l ll -> 10 * (10 * (10 * hh + h) + l) + ll) <$> - digitP <*> - digitP <*> - digitP <*> - digitP - -patchTimeP :: Parser UTCTime -patchTimeP = do - year <- decimal4P - month <- decimal2P - day <- decimal2P - - hours <- decimal2P - minutes <- decimal2P - seconds <- decimal2P - - case fromGregorianValid year month day of - Nothing -> fail "Invalid patch date" - Just uday -> return UTCTime - { utctDay = uday - , utctDayTime = - secondsToDiffTime $ 3600 * hours + 60 * minutes + seconds - } - -line :: Parser ByteString -line = restOfLine - -restOfLine :: Parser ByteString -restOfLine = takeWhile (/= lf) - -eol :: Parser () -eol = skip (== lf) - -skipLine :: Parser () -skipLine = skipWhile (/= lf) - -skipRestOfLine :: Parser () -skipRestOfLine = skipLine - -skipPatchP :: Parser () -skipPatchP = - -- title - skipLine *> eol *> - -- author, inverted, time - skipLine *> eol *> - -- ignore, description - (skipMany $ skip (== space) *> skipRestOfLine *> eol) *> - -- end of info - (string "] \n") *> - -- hash - skipLine - -sha256P :: Parser ByteString -sha256P = do - bs <- take 64 - case second B.null $ B16.decode bs of - (h, True) -> return h - _ -> fail "SHA256 decoding from hex failed" - -sizeP :: Parser Int -sizeP = do - bs <- take 10 - case second B.null <$> BX.readDecimal bs of - Just (n, True) -> return n - _ -> fail "sizeP failed" - -sizeSha256P :: Parser (Int, ByteString) -sizeSha256P = liftA2 (,) sizeP (skip (== dash) *> sha256P) - -pristineP :: Parser PristineHash -pristineP = string "pristine:" *> (PristineHash <$> sha256P) - -prevInvP :: Parser InventoryHash -prevInvP = - string "Starting with inventory" *> eol *> - (uncurry InventoryHash <$> sizeSha256P) - -patchInfoRawP :: Parser PatchInfoRaw -patchInfoRawP = do - word8 sqrOpen - title <- takeWhile1 (/= lf) - eol - - author <- takeWhile1 (/= star) - word8 star - inverted <- (/= star) <$> (satisfy $ \ c -> c == star || c == dash) - (timeRaw, time) <- match patchTimeP - eol - - word8 space - junkp <- string "Ignore-this: " - junkc <- takeWhile1 (/= lf) - eol - - lines <- many $ word8 space *> takeWhile (/= lf) <* eol - string "] \nhash: " - - hash <- sizeSha256P - - return PatchInfoRaw - { pirAuthor = author - , pirHash = hash - , pirTitle = title - , pirDescription = lines - , pirJunkPrefix = junkp - , pirJunkContent = junkc - , pirTime = (timeRaw, time) - , pirInverted = inverted - } - --- TODO --- --- * Finish DarcsRev code, make it build --- * Update darcs change view code to work correctly in the case of previous --- inventories, test vervis against libravatar for that - --- | Parse patch metadata and compute the metadata's hash, which can be used as --- a patch identifier for lookup and matching. -patchInfoP :: Parser (PatchInfo, PatchHash) -patchInfoP = do - pir <- patchInfoRawP - return (refinePatchInfo pir, PatchHash $ convert $ hashPatchInfo SHA1 pir) - -tagInfoP :: Parser (TagInfo, PatchHash) -tagInfoP = do - (pi, ph) <- patchInfoP - case patchToTag pi of - Nothing -> fail "Expected a tag, got a patch that isn't a tag" - Just ti -> return (ti, ph) - -------------------------------------------------------------------------------- --- Latest inventory -------------------------------------------------------------------------------- - -latestInventoryPristineP :: Parser PristineHash -latestInventoryPristineP = pristineP - -latestInventorySizeP :: Parser Int -latestInventorySizeP = - -- pristine hash - skipLine *> - -- previous inventory - optional - ( eol *> string "Starting" *> skipRestOfLine *> - eol *> skipLine - ) *> - -- patch info - (length <$> many (eol *> skipPatchP)) <* - eol - -latestInventoryPrevSizeP :: Parser (Maybe InventoryHash, Int) -latestInventoryPrevSizeP = - liftA2 (,) - ( -- pristine hash - skipLine *> - -- previous inventory - optional (eol *> prevInvP) - ) - ( -- patch info - (length <$> many (eol *> skipPatchP)) <* - eol - ) - -latestInventoryPageP - :: Int -> Int -> Parser (Maybe InventoryHash, [(PatchInfo, PatchHash)]) -latestInventoryPageP off lim = - let f mPrevTag pis = - case mPrevTag of - Nothing -> (Nothing, pis) - Just (ih, pi) -> (Just ih, pi : pis) - in liftA2 f - -- pristine - ( skipLine *> - -- previous inventory and clean tag - optional (liftA2 (,) (eol *> prevInvP) (eol *> patchInfoP)) <* - -- skip offset - replicateM_ off (eol *> skipPatchP) - ) - -- take limit - (atMost lim $ eol *> patchInfoP) - -latestInventoryAllP :: Parser LatestInventory -latestInventoryAllP = LatestInventory - <$> pristineP - <*> optional (liftA2 (,) (eol *> prevInvP) (eol *> tagInfoP)) - <*> many (eol *> patchInfoP) - <* eol - -------------------------------------------------------------------------------- --- Early inventory -------------------------------------------------------------------------------- - -earlyInventorySizeP :: Parser Int -earlyInventorySizeP = - -- previous inventory - optional - ( string "Starting" *> skipRestOfLine *> - eol *> skipLine - ) *> - -- patch info - (length <$> many (eol *> skipPatchP)) <* - eol - -earlyInventoryPrevSizeP :: Parser (Maybe InventoryHash, Int) -earlyInventoryPrevSizeP = - liftA2 (,) - -- previous inventory - (optional $ prevInvP <* eol) - -- patch info - (length <$> many (skipPatchP *> eol)) - -earlyInventoryPageP - :: Int -> Int -> Parser (Maybe InventoryHash, [(PatchInfo, PatchHash)]) -earlyInventoryPageP off lim = - let f mPrevTag pis = - case mPrevTag of - Nothing -> (Nothing, pis) - Just (ih, pi) -> (Just ih, pi : pis) - in liftA2 f - -- previous inventory and clean tag - ( optional (liftA2 (,) (prevInvP <* eol) (patchInfoP <* eol)) <* - -- skip offset - replicateM_ off (skipPatchP *> eol) - ) - -- take limit - (atMost lim $ patchInfoP <* eol) - -earlyInventoryAllP :: Parser (Either EarliestInventory MiddleInventory) -earlyInventoryAllP = - let f Nothing pis = Left $ EarliestInventory pis - f (Just (prev, ti)) pis = Right $ MiddleInventory prev ti pis - in liftA2 f - (optional $ liftA2 (,) (prevInvP <* eol) (tagInfoP <* eol)) - (many (patchInfoP <* eol)) - -{- -patchInfosOffsetP :: Int -> Parser PatchSeq -patchInfosOffsetP off = PatchSeq - <$> pristineP - <*> optional (eol *> prevInvP) - <*> ( replicateM_ off (eol *> skipPatchP) *> - many (eol *> patchInfoP) - ) - <* eol - -patchInfosLimitP :: Int -> Parser PatchSeq -patchInfosLimitP lim = PatchSeq - <$> pristineP - <*> optional (eol *> prevInvP) - <*> atMost lim (eol *> patchInfoP) --} diff --git a/src/Darcs/Local/Inventory/Read.hs b/src/Darcs/Local/Inventory/Read.hs deleted file mode 100644 index 5ab243e..0000000 --- a/src/Darcs/Local/Inventory/Read.hs +++ /dev/null @@ -1,96 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -module Darcs.Local.Inventory.Read - ( readLatestInventory - , readCompressedInventory - ) -where - -import Prelude - -import Codec.Compression.Zlib.Internal -import Control.Applicative (many, optional, liftA2) -import Control.Arrow (second) -import Control.Monad (replicateM_) -import Crypto.Hash -import Data.Attoparsec.ByteString -import Data.ByteArray (convert) -import Data.ByteString (ByteString) -import Data.Time.Calendar (fromGregorianValid) -import Data.Time.Clock (UTCTime (..), secondsToDiffTime) -import Data.Word (Word8) -import System.FilePath (()) - -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Base16 as B16 -import qualified Data.ByteString.Lex.Integral as BX - -import Control.Applicative.Local -import Darcs.Local.Hash.Codec -import Darcs.Local.Hash.Types -import Darcs.Local.Inventory.Parser -import Darcs.Local.Inventory.Types -import Data.Attoparsec.ByteString.Local -import Data.ByteString.Local (stripPrefix) -import Data.Text.UTF8.Local (decodeStrict) - -darcsDir :: FilePath -darcsDir = "_darcs" - -inventoryDir :: FilePath -inventoryDir = "inventories" - -inventoryFile :: FilePath -inventoryFile = "hashed_inventory" - -readLatestInventory :: FilePath -> Parser a -> IO (Either String a) -readLatestInventory repo = - parseFileIncremental $ repo darcsDir inventoryFile - -readCompressedInventory - :: FilePath -> InventoryHash -> Parser a -> IO (Either String a) -readCompressedInventory repo ih = - let invFile = BC.unpack $ encodeInventoryHash ih - invPath = repo darcsDir inventoryDir invFile - defParams = defaultDecompressParams - bufSize = min (decompressBufferSize defParams) (ihSize ih) - params = defParams { decompressBufferSize = bufSize } - in parseCompressedFileIncremental gzipFormat params invPath - -{- -readLatestInventorySize :: FilePath -> IO (Either String Int) - -readLatestInventoryAll :: FilePath -> IO (Either String LatestInventory) - -readLatestInventoryPage - :: Int -> Int -> FilePath -> IO (Either String LatestInventory) - -readInventorySize :: FilePath -> IO (Either String Int) -readInventorySize repoPath = do - let invPath = repoPath darcsDir inventoryFile - parseFileIncremental invPath $ patchInfosCountP <* endOfInput - -readPatchInfoAll :: FilePath -> IO (Either String PatchSeq) -readPatchInfoAll repoPath = do - let invPath = repoPath darcsDir inventoryFile - parseFileIncremental invPath $ patchInfosAllP <* endOfInput - -readPatchInfoPage :: Int -> Int -> FilePath -> IO (Either String PatchSeq) -readPatchInfoPage off lim repoPath = do - let invPath = repoPath darcsDir inventoryFile - parseFileIncremental invPath $ patchInfosOffsetLimitP off lim --} diff --git a/src/Darcs/Local/Inventory/Types.hs b/src/Darcs/Local/Inventory/Types.hs deleted file mode 100644 index ebb4a7f..0000000 --- a/src/Darcs/Local/Inventory/Types.hs +++ /dev/null @@ -1,74 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -module Darcs.Local.Inventory.Types - ( LatestInventory (..) - , MiddleInventory (..) - , EarliestInventory (..) - ) -where - --- TODO --- --- Apparently, after a while, some of the patches are moved from --- hashed_inventory into the inventories/ dir. So the patch set contains more --- than one group. This means I need to extend my parser to cover this case. --- Sources for info about this thing: --- --- * Darcs source code --- * Darcs wiki --- * Local Darcs repos I have --- --- From Darcs source code: --- --- > The patches in a repository are stored in chunks broken up at \"clean\" --- > tags. A tag is clean if the only patches before it in the current --- > repository ordering are ones that the tag depends on (either directly --- > or indirectly). Each chunk is stored in a separate inventory file on disk. --- > --- > A 'PatchSet' represents a repo's history as the list of patches since the --- > last clean tag, and then a list of patch lists each delimited by clean tags. --- > --- > A 'Tagged' is a single chunk of a 'PatchSet'. It has a 'PatchInfo' --- > representing a clean tag, the hash of the previous inventory (if it exists), --- > and the list of patches since that previous inventory. --- --- Let's start with finding out the format of the binary inventories and --- parsing them. - -import Prelude - -import Data.ByteString (ByteString) -import Data.Text (Text) -import Data.Time.Clock (UTCTime) - -import Darcs.Local.Hash.Types -import Darcs.Local.Patch.Types - -data LatestInventory = LatestInventory - { liPristineHash :: PristineHash - , liPrevTag :: Maybe (InventoryHash, (TagInfo, PatchHash)) - , liPatches :: [(PatchInfo, PatchHash)] - } - -data MiddleInventory = MiddleInventory - { miPrevious :: InventoryHash - , miTag :: (TagInfo, PatchHash) - , miPatches :: [(PatchInfo, PatchHash)] - } - -newtype EarliestInventory = EarliestInventory - { eiPatches :: [(PatchInfo, PatchHash)] - } diff --git a/src/Darcs/Local/Patch.hs b/src/Darcs/Local/Patch.hs deleted file mode 100644 index a1bd938..0000000 --- a/src/Darcs/Local/Patch.hs +++ /dev/null @@ -1,107 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -module Darcs.Local.Patch - ( hashPatchInfo - , refinePatchInfo - , tagToPatch - , patchToTag - , patchToTag_ - ) -where - -import Prelude hiding (take, takeWhile) - -import Control.Applicative (many, optional, liftA2) -import Control.Arrow (second) -import Control.Monad (replicateM_) -import Crypto.Hash -import Data.Attoparsec.ByteString -import Data.ByteArray (convert) -import Data.ByteString (ByteString) -import Data.Time.Calendar (fromGregorianValid) -import Data.Time.Clock (UTCTime (..), secondsToDiffTime) -import Data.Word (Word8) -import System.FilePath (()) - -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Base16 as B16 -import qualified Data.ByteString.Lex.Integral as BX - -import Control.Applicative.Local -import Darcs.Local.Hash.Types -import Darcs.Local.Inventory.Types -import Darcs.Local.Patch.Types -import Data.Attoparsec.ByteString.Local -import Data.ByteString.Local (stripPrefix) -import Data.Text.UTF8.Local (decodeStrict) - -hashPatchInfo :: HashAlgorithm a => a -> PatchInfoRaw -> Digest a -hashPatchInfo _algo pir = - let add = flip hashUpdate - adds = flip hashUpdates - in hashFinalize $ - add (if pirInverted pir then "t" else "f" :: ByteString) $ - adds (pirDescription pir) $ - add (pirJunkContent pir) $ - add (pirJunkPrefix pir) $ - add (fst $ pirTime pir) $ - add (pirAuthor pir) $ - add (pirTitle pir) - hashInit - -refinePatchInfo :: PatchInfoRaw -> PatchInfo -refinePatchInfo pir = - let rtitle = pirTitle pir - (title, tag) = case stripPrefix "TAG " rtitle of - Nothing -> (rtitle, False) - Just rest -> (rest, True) - description = case pirDescription pir of - [] -> Nothing - l -> Just $ BC.unlines l - in PatchInfo - { piAuthor = decodeStrict $ pirAuthor pir - , piHash = uncurry ContentHash $ pirHash pir - , piTitle = decodeStrict title - , piDescription = decodeStrict <$> description - , piTag = tag - , piTime = snd $ pirTime pir - } - -tagToPatch :: TagInfo -> PatchInfo -tagToPatch tag = PatchInfo - { piAuthor = tiAuthor tag - , piHash = tiHash tag - , piTitle = tiTitle tag - , piDescription = tiDescription tag - , piTag = True - , piTime = tiTime tag - } - -patchToTag :: PatchInfo -> Maybe TagInfo -patchToTag pi = - if piTag pi - then Just $ patchToTag_ pi - else Nothing - -patchToTag_ :: PatchInfo -> TagInfo -patchToTag_ patch = TagInfo - { tiAuthor = piAuthor patch - , tiHash = piHash patch - , tiTitle = piTitle patch - , tiDescription = piDescription patch - , tiTime = piTime patch - } diff --git a/src/Darcs/Local/Patch/Types.hs b/src/Darcs/Local/Patch/Types.hs deleted file mode 100644 index 8cafe46..0000000 --- a/src/Darcs/Local/Patch/Types.hs +++ /dev/null @@ -1,72 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -module Darcs.Local.Patch.Types - ( PatchInfoRaw (..) - , PatchInfo (..) - , TagInfo (..) - ) -where - -import Prelude - -import Data.ByteString (ByteString) -import Data.Text (Text) -import Data.Time.Clock (UTCTime) - -import Darcs.Local.Hash.Types (ContentHash) - --- | Patch metadata in raw form. This is intended for accurate hashing of the --- patch info. -data PatchInfoRaw = PatchInfoRaw - { pirAuthor :: ByteString - , pirHash :: (Int, ByteString) - , pirTitle :: ByteString - , pirDescription :: [ByteString] - , pirJunkPrefix :: ByteString - , pirJunkContent :: ByteString - , pirTime :: (ByteString, UTCTime) - , pirInverted :: Bool - } - --- | Patch metadata read from the inventory file. -data PatchInfo = PatchInfo - { -- | Author name and email - piAuthor :: Text - -- | Patch content hash - , piHash :: ContentHash - -- | Single message line - , piTitle :: Text - -- | Optional description, may contain several lines - , piDescription :: Maybe Text - -- | Whether this is a tag - , piTag :: Bool - -- | When the patch was recorded - , piTime :: UTCTime - } - --- | Tag metadata read from the inventory file. -data TagInfo = TagInfo - { -- | Author name and email - tiAuthor :: Text - -- | Tag content hash - , tiHash :: ContentHash - -- | Single message line - , tiTitle :: Text - -- | Optional description, may contain several lines - , tiDescription :: Maybe Text - -- | When the tag was recorded - , tiTime :: UTCTime - } diff --git a/src/Data/Revision/Local.hs b/src/Data/Revision/Local.hs deleted file mode 100644 index 7c414ee..0000000 --- a/src/Data/Revision/Local.hs +++ /dev/null @@ -1,54 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -module Data.Revision.Local - ( Change (..) - , Revision (..) - , Version (..) - ) -where - -import Prelude - -import Data.Text (Text) -import Data.Time.Clock (UTCTime) - --- | A recorded patch or tag. -data Change = Change - { -- | When it was recorded. - cgTime :: UTCTime - -- | Lowercase hex representation of its SHA1 info hash. - , cgHash :: Text - -- | Single-line title. - , cgTitle :: Text - } - --- | Given a non-empty repo, this refers to a point in its history. -data Revision - -- | The last change is a tag. - = RevTag Change - -- | The last change isn't a tag, but a tag exists earlier in the history. - -- Specifies details of the last tag, the number of patches after that tag, - -- and details of the last patch. - | RevTagPlus Change Int Change - -- | There are no recorded tags. Specifies the last patch. - | RevPatch Change - -data Version = Version - { verSharer :: Text - , verRepo :: Text - , verChanges :: Int - , verRevision :: Revision - } diff --git a/src/Development/DarcsRev.hs b/src/Development/DarcsRev.hs deleted file mode 100644 index b11f008..0000000 --- a/src/Development/DarcsRev.hs +++ /dev/null @@ -1,409 +0,0 @@ -{- This file is part of Vervis. - - - - Written in 2016 by fr33domlover . - - - - ♡ Copying is an act of love. Please copy, reuse and share. - - - - The author(s) have dedicated all copyright and related and neighboring - - rights to this software to the public domain worldwide. This software is - - distributed without any warranty. - - - - You should have received a copy of the CC0 Public Domain Dedication along - - with this software. If not, see - - . - -} - -{-# LANGUAGE CPP #-} - -module Development.DarcsRev - ( -- * Simple literals - -- ** Last patch - darcsLastPatchHash - , darcsLastPatchHash_ - , darcsLastPatchTime - , darcsLastPatchTime_ - , darcsLastPatchTitle - , darcsLastPatchTitle_ - , darcsLastPatchIsTag - , darcsLastPatchIsTag_ - -- ** Last tag - , darcsTagExists - , darcsLastTagHash - , darcsLastTagHash_ - , darcsLastTagTime - , darcsLastTagTime_ - , darcsLastTagName - , darcsLastTagName_ - -- ** Other revision info - , darcsPatchesSinceLastTag - , darcsBranchSharer - , darcsBranchRepo - , darcsTotalPatches - , darcsTreeDirty - -- * Records - -- ** Last patch - , darcsLastPatch - , darcsLastPatch_ - -- ** Last tag - , darcsLastTag - , darcsLastTag_ - -- ** Revision - , darcsRevision - , darcsRevision_ - ) -where - -import Prelude - -import Data.Fixed -import Data.Foldable (find) -import Data.List (sortOn) -import Data.Maybe (listToMaybe) -import Data.Ord (Down (..)) -import Data.Time -import Language.Haskell.TH - -import qualified Data.ByteString.Char8 as BC (unpack) -import qualified Data.Text as T (unpack) - -import Darcs.Local.Hash.Codec -import Darcs.Local.Hash.Types -import Darcs.Local.Patch -import Darcs.Local.Patch.Types -import Darcs.Local.Inventory.Parser -import Darcs.Local.Inventory.Read -import Darcs.Local.Inventory.Types -import Data.Revision.Local - --- TODO --- --- * Number of patches since latest tag --- * Branch name, basically the / thing. This allows to identify --- which "darcs branch" is being used --- * Whether there are unrecorded changes to tracked files - -------------------------------------------------------------------------------- --- Utils -------------------------------------------------------------------------------- - -repoPath :: FilePath -repoPath = "." - -readLatestInv :: Q [(PatchInfo, PatchHash)] -readLatestInv = runIO $ do - einv <- readLatestInventory repoPath latestInventoryAllP - case einv of - Left err -> error $ "Failed to parse Darcs inventory file: " ++ err - Right inv -> return $ - case snd <$> liPrevTag inv of - Nothing -> liPatches inv - Just (tag, h) -> (tagToPatch tag, h) : liPatches inv - -readLastPatch :: Q (Maybe (PatchInfo, PatchHash)) -readLastPatch = listToMaybe . sortOn (Down . piTime . fst) <$> readLatestInv - -readLastPatch_ :: Q (PatchInfo, PatchHash) -readLastPatch_ = do - mp <- readLastPatch - case mp of - Nothing -> fail "Couldn't read last patch, repo seems empty" - Just p -> return p - -readLastTag :: Q (Maybe (PatchInfo, PatchHash)) -readLastTag = - listToMaybe . sortOn (Down . piTime . fst) . filter (piTag . fst) <$> - readLatestInv - -readLastTag_ :: Q (PatchInfo, PatchHash) -readLastTag_ = do - mp <- readLastTag - case mp of - Nothing -> fail "Couldn't read last tag, repo seems to have no tags" - Just p -> return p - -darcsHash :: Q PatchHash -> Q Exp -darcsHash readHash = readHash >>= stringE . BC.unpack . encodePatchHash - -darcsTime :: Q PatchInfo -> Q Exp -darcsTime readPI = do - pi <- readPI - let UTCTime (ModifiedJulianDay day) diff' = piTime pi -#if MIN_VERSION_time(1,6,0) - diff = diffTimeToPicoseconds diff' -#else - diff = - let MkFixed pico = realToFrac diff' :: Pico - in pico -#endif - recConE 'UTCTime - [ fieldExp - 'utctDay - (appE (conE 'ModifiedJulianDay) (litE $ integerL day)) - , fieldExp - 'utctDayTime - (appE (varE 'picosecondsToDiffTime) (litE $ integerL diff)) - ] - -darcsTitle :: Q PatchInfo -> Q Exp -darcsTitle readPI = readPI >>= stringE . T.unpack . piTitle - -darcsIsTag :: Q PatchInfo -> Q Exp -darcsIsTag readPI = do - pi <- readPI - conE $ if piTag pi then 'True else 'False - -darcsPatch :: Q (PatchInfo, PatchHash) -> Q Exp -darcsPatch readPH = do - (pi, h) <- readPH - recConE 'Change - [ fieldExp 'cgTime (darcsTime $ return pi) - , fieldExp 'cgHash (darcsHash $ return h) - , fieldExp 'cgTitle (darcsTitle $ return pi) - ] - -darcsRev :: (PatchInfo, PatchHash) -> [(PatchInfo, PatchHash)] -> Q Exp -darcsRev piLast piRest = - case break (piTag . fst) (piLast : piRest) of - (_, []) -> appE (conE 'RevPatch) (darcsPatch $ return piLast) - ([], (tag:_)) -> appE (conE 'RevTag) (darcsPatch $ return tag) - (after, (tag:_)) -> - appsE - [ conE 'RevTagPlus - , darcsPatch $ return tag - , litE $ integerL $ toInteger $ length after - , darcsPatch $ return piLast - ] - -fmapMaybeTH :: (Q a -> Q Exp) -> Q (Maybe a) -> Q Exp -fmapMaybeTH f a = do - mr <- a - case mr of - Nothing -> conE 'Nothing - Just r -> appE (conE 'Just) (f $ return r) - -------------------------------------------------------------------------------- --- Simple literals -------------------------------------------------------------------------------- - -------------------------------------------------------------------------------- --- -- Last patch -------------------------------------------------------------------------------- - --- | The ASCII lowercase hexadecimal representation of the hash of the last --- recorded patch, as a string literal. This the SHA256 patch hash, i.e. a hash --- of the patch info, not content. This is what @darcs log@ displays. --- --- If the repository is empty, this generates 'Nothing', otherwise 'Just' the --- string literal. -darcsLastPatchHash :: Q Exp -darcsLastPatchHash = fmapMaybeTH darcsHash $ fmap snd <$> readLastPatch - --- | The ASCII lowercase hexadecimal representation of the hash of the last --- recorded patch, as a string literal. This the SHA256 patch hash, i.e. a hash --- of the patch info, not content. This is what @darcs log@ displays. --- --- If the repository is empty, this will fail during compilation. -darcsLastPatchHash_ :: Q Exp -darcsLastPatchHash_ = darcsHash $ snd <$> readLastPatch_ - --- | The time of the last recorded patch, as a 'UTCTime' value. --- --- If the repository is empty, this generates 'Nothing', otherwise 'Just' the --- 'UTCTime' value. -darcsLastPatchTime :: Q Exp -darcsLastPatchTime = fmapMaybeTH darcsTime $ fmap fst <$> readLastPatch - --- | The time of the last recorded patch, as a 'UTCTime' value. --- --- If the repository is empty, this will fail during compilation. -darcsLastPatchTime_ :: Q Exp -darcsLastPatchTime_ = darcsTime $ fst <$> readLastPatch_ - --- | The title of the last recorded patch, as a string literal. --- --- If the repository is empty, this generates 'Nothing', otherwise 'Just' the --- string literal. -darcsLastPatchTitle :: Q Exp -darcsLastPatchTitle = fmapMaybeTH darcsTitle $ fmap fst <$> readLastPatch - --- | The title of the last recorded patch, as a string literal. --- --- If the repository is empty, this will fail during compilation. -darcsLastPatchTitle_ :: Q Exp -darcsLastPatchTitle_ = darcsTitle $ fst <$> readLastPatch_ - --- | A 'Bool' saying whether the last recorded patch is actually a tag. --- --- If the repository is empty, this generates 'Nothing', otherwise 'Just' the --- 'Bool' value. -darcsLastPatchIsTag :: Q Exp -darcsLastPatchIsTag = fmapMaybeTH darcsIsTag $ fmap fst <$> readLastPatch - --- | A 'Bool' saying whether the last recorded patch is actually a tag. --- --- If the repository is empty, this will fail during compilation. -darcsLastPatchIsTag_ :: Q Exp -darcsLastPatchIsTag_ = darcsIsTag $ fst <$> readLastPatch_ - -------------------------------------------------------------------------------- --- -- Last tag -------------------------------------------------------------------------------- - --- | Whether the repo history contains any tags, as a 'Bool' value. -darcsTagExists :: Q Exp -darcsTagExists = do - pis <- readLatestInv - conE $ if any (piTag . fst) pis - then 'True - else 'False - --- | The ASCII lowercase hexadecimal representation of the hash of the last --- recorded tag (i.e. the last patch that is a tag). --- --- If the repository has no tags, this generates 'Nothing', otherwise 'Just' --- the string literal. -darcsLastTagHash :: Q Exp -darcsLastTagHash = fmapMaybeTH darcsHash $ fmap snd <$> readLastTag - --- | The ASCII lowercase hexadecimal representation of the hash of the last --- recorded tag (i.e. the last patch that is a tag). --- --- If the repository has no tags, this will fail during compilation. -darcsLastTagHash_ :: Q Exp -darcsLastTagHash_ = darcsHash $ snd <$> readLastTag_ - --- | The time of the last recorded tag, as a 'UTCTime' value. --- --- If the repository has no tags, this generates 'Nothing', otherwise 'Just' --- the 'UTCTime' value. -darcsLastTagTime :: Q Exp -darcsLastTagTime = fmapMaybeTH darcsTime $ fmap fst <$> readLastTag - --- | The time of the last recorded tag, as a 'UTCTime' value. --- --- If the repository has no tags, this will fail during compilation. -darcsLastTagTime_ :: Q Exp -darcsLastTagTime_ = darcsTime $ fst <$> readLastTag_ - --- | The name of the last recorded tag, as a string literal. This is a result --- of taking the title of the tag and dropping the @"TAG "@ prefix. --- --- If the repository has no tags, this generates 'Nothing', otherwise 'Just' --- the string literal. -darcsLastTagName :: Q Exp -darcsLastTagName = fmapMaybeTH darcsTitle $ fmap fst <$> readLastTag - --- | The name of the last recorded tag, as a string literal. This is a result --- of taking the title of the tag and dropping the @"TAG "@ prefix. --- --- If the repository has no tags, this will fail during compilation. -darcsLastTagName_ :: Q Exp -darcsLastTagName_ = darcsTitle $ fst <$> readLastTag_ - -------------------------------------------------------------------------------- --- -- Other revision info -------------------------------------------------------------------------------- - --- | Number of patches recorded after the last tag, as a number literal. If --- there's no tag found, the number is (-1). -darcsPatchesSinceLastTag :: Q Exp -darcsPatchesSinceLastTag = do - pisAll <- sortOn (Down . piTime . fst) <$> readLatestInv - case break (piTag . fst) pisAll of - (_, []) -> litE $ integerL (-1) - (pisAfter, (_tag : _pisBefore)) -> - litE $ integerL $ toInteger $ length pisAfter - --- | Not implemented yet -darcsBranchSharer :: Q Exp -darcsBranchSharer = undefined - --- | Not implemented yet -darcsBranchRepo :: Q Exp -darcsBranchRepo = undefined - --- | Total number of recorded patches. -darcsTotalPatches :: Q Exp -darcsTotalPatches = do - let go Nothing n = return n - go (Just ih) n = do - einv <- readCompressedInventory repoPath ih earlyInventoryPrevSizeP - case einv of - Left err -> error $ "Failed to parse inventory: " ++ err - Right (mih, m) -> go mih $ n + m - nPatches <- runIO $ do - einv <- readLatestInventory repoPath latestInventoryPrevSizeP - case einv of - Left err -> error $ "Failed to parse latest inventory: " ++ err - Right (mih, n) -> go mih n - litE $ integerL $ toInteger nPatches - --- | Not implemented yet -darcsTreeDirty :: Q Exp -darcsTreeDirty = undefined - -------------------------------------------------------------------------------- --- Records -------------------------------------------------------------------------------- - -------------------------------------------------------------------------------- --- -- Last patch -------------------------------------------------------------------------------- - --- | The time, hash and title of the last patch, as a 'Change' value. --- --- If the repository is empty, this generates 'Nothing', otherwise 'Just' the --- 'Change' value. -darcsLastPatch :: Q Exp -darcsLastPatch = fmapMaybeTH darcsPatch readLastPatch - --- | The time, hash and title of the last patch, as a 'Change' value. --- --- If the repository is empty, this will fail during compilation. -darcsLastPatch_ :: Q Exp -darcsLastPatch_ = darcsPatch readLastPatch_ - -------------------------------------------------------------------------------- --- -- Last tag -------------------------------------------------------------------------------- - --- | The time, hash and title of the last tag, as a 'Change' value. --- --- If the repository has no tags, this generates 'Nothing', otherwise 'Just' --- the 'Change' value. -darcsLastTag :: Q Exp -darcsLastTag = fmapMaybeTH darcsPatch readLastTag - --- | The time, hash and title of the last tag, as a 'Change' value. --- --- If the repository has no tags, this will fail during compilation. -darcsLastTag_ :: Q Exp -darcsLastTag_ = darcsPatch readLastTag_ - -------------------------------------------------------------------------------- --- -- Revision -------------------------------------------------------------------------------- - --- | Representation of the current revision as a 'Revision' value. Generates --- 'Nothing' if the repo is empty, otherwise 'Just' the value. --- --- * If there are no tags in the repo, it gives you the last patch details. --- * If the last patch is a tag, it gives you its details. --- * If there is a tag but it isn't the last patch, it gives you details of the --- last lag, the last patch, and how many patches there are after the last --- tag. -darcsRevision :: Q Exp -darcsRevision = do - pis <- sortOn (Down . piTime . fst) <$> readLatestInv - case pis of - [] -> conE 'Nothing - (l:r) -> appE (conE 'Just) $ darcsRev l r - --- | Representation of the current revision as a 'Revision' value. If the --- repo is empty, fails during compilation. -darcsRevision_ :: Q Exp -darcsRevision_ = do - pis <- sortOn (Down . piTime . fst) <$> readLatestInv - case pis of - [] -> fail "Repo has no patches, can't determine revision" - (l:r) -> darcsRev l r diff --git a/src/Vervis/Darcs.hs b/src/Vervis/Darcs.hs index 401baef..2168ac4 100644 --- a/src/Vervis/Darcs.hs +++ b/src/Vervis/Darcs.hs @@ -35,6 +35,11 @@ import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (strictDecode) import Data.Time.Clock (getCurrentTime, diffUTCTime) import Data.Traversable (for) +import Development.Darcs.Internal.Hash.Codec +import Development.Darcs.Internal.Inventory.Parser +import Development.Darcs.Internal.Inventory.Read +import Development.Darcs.Internal.Inventory.Types +import Development.Darcs.Internal.Patch.Types import System.FilePath (()) import qualified Data.ByteString.Lazy as BL (ByteString) @@ -42,11 +47,6 @@ import qualified Data.ByteString.Base16 as B16 (encode) import qualified Data.Foldable as F (find) import qualified Data.Text as T (takeWhile, stripEnd) -import Darcs.Local.Hash.Codec -import Darcs.Local.Inventory.Parser -import Darcs.Local.Inventory.Read -import Darcs.Local.Inventory.Types -import Darcs.Local.Patch.Types import Darcs.Local.Repository import Data.Either.Local (maybeRight) import Data.EventTime.Local diff --git a/src/Vervis/Widget.hs b/src/Vervis/Widget.hs index 1bd59ef..2e03e0f 100644 --- a/src/Vervis/Widget.hs +++ b/src/Vervis/Widget.hs @@ -26,14 +26,13 @@ import Prelude import Data.Text (Text) import Data.Time.Calendar (toGregorian) import Data.Time.Clock (UTCTime (..)) +import Development.Darcs.Rev import Formatting (sformat, (%), int, left) import Yesod.Core (YesodBreadcrumbs, breadcrumbs) import Yesod.Core.Widget import qualified Data.Text as T (take) -import Data.Revision.Local -import Development.DarcsRev (darcsTotalPatches, darcsRevision) import Vervis.Avatar (getAvatarUrl) import Vervis.Settings (widgetFile) import Vervis.Style diff --git a/stack.yaml b/stack.yaml index 9e42870..04b4812 100644 --- a/stack.yaml +++ b/stack.yaml @@ -8,6 +8,7 @@ resolver: lts-6.5 # Local packages, usually specified by relative directory name packages: - '.' + - '../darcs-rev' - '../ssh' - '../hit-graph' - '../hit-harder' diff --git a/vervis.cabal b/vervis.cabal index 4e8dcfb..8fb831b 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -40,13 +40,6 @@ flag library-only library exposed-modules: Control.Applicative.Local - Darcs.Local.Hash.Codec - Darcs.Local.Hash.Types - Darcs.Local.Inventory.Parser - Darcs.Local.Inventory.Read - Darcs.Local.Inventory.Types - Darcs.Local.Patch - Darcs.Local.Patch.Types Darcs.Local.Repository Data.Attoparsec.ByteString.Local Data.Binary.Local @@ -68,7 +61,6 @@ library Data.List.Local Data.Maybe.Local Data.Paginate.Local - Data.Revision.Local Data.Text.UTF8.Local Data.Text.Lazy.UTF8.Local Data.Time.Clock.Local @@ -88,7 +80,6 @@ library Database.Persist.Local.Sql Database.Persist.Local.Sql.Orphan.Common Database.Persist.Local.Sql.Orphan.PersistQueryForest - Development.DarcsRev Diagrams.IntransitiveDAG Formatting.CaseInsensitive Network.SSH.Local @@ -232,6 +223,7 @@ library -- for Storage.Hashed because hashed-storage seems -- unmaintained and darcs has its own copy , darcs + , darcs-rev , data-default -- for Data.Paginate.Local , data-default-class