Move DarcsRev and code we're sharing with it into a separate library
This commit is contained in:
fr33domlover
parent
ff5bb97383
commit
abfb77479f
13 changed files with 8 additions and 1272 deletions
|
|
@ -1,49 +0,0 @@
|
||||||
{- This file is part of Vervis.
|
|
||||||
-
|
|
||||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
||||||
-
|
|
||||||
- ♡ 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
|
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
||||||
-}
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
@ -1,50 +0,0 @@
|
||||||
{- This file is part of Vervis.
|
|
||||||
-
|
|
||||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
||||||
-
|
|
||||||
- ♡ 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
|
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
||||||
-}
|
|
||||||
|
|
||||||
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 }
|
|
||||||
|
|
@ -1,345 +0,0 @@
|
||||||
{- This file is part of Vervis.
|
|
||||||
-
|
|
||||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
||||||
-
|
|
||||||
- ♡ 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
|
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
||||||
-}
|
|
||||||
|
|
||||||
-- 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)
|
|
||||||
-}
|
|
||||||
|
|
@ -1,96 +0,0 @@
|
||||||
{- This file is part of Vervis.
|
|
||||||
-
|
|
||||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
||||||
-
|
|
||||||
- ♡ 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
|
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
||||||
-}
|
|
||||||
|
|
||||||
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
|
|
||||||
-}
|
|
||||||
|
|
@ -1,74 +0,0 @@
|
||||||
{- This file is part of Vervis.
|
|
||||||
-
|
|
||||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
||||||
-
|
|
||||||
- ♡ 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
|
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
||||||
-}
|
|
||||||
|
|
||||||
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)]
|
|
||||||
}
|
|
||||||
|
|
@ -1,107 +0,0 @@
|
||||||
{- This file is part of Vervis.
|
|
||||||
-
|
|
||||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
||||||
-
|
|
||||||
- ♡ 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
|
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
||||||
-}
|
|
||||||
|
|
||||||
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
|
|
||||||
}
|
|
||||||
|
|
@ -1,72 +0,0 @@
|
||||||
{- This file is part of Vervis.
|
|
||||||
-
|
|
||||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
||||||
-
|
|
||||||
- ♡ 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
|
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
||||||
-}
|
|
||||||
|
|
||||||
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
|
|
||||||
}
|
|
||||||
|
|
@ -1,54 +0,0 @@
|
||||||
{- This file is part of Vervis.
|
|
||||||
-
|
|
||||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
||||||
-
|
|
||||||
- ♡ 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
|
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
||||||
-}
|
|
||||||
|
|
||||||
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
|
|
||||||
}
|
|
||||||
|
|
@ -1,409 +0,0 @@
|
||||||
{- This file is part of Vervis.
|
|
||||||
-
|
|
||||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
|
||||||
-
|
|
||||||
- ♡ 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
|
|
||||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
||||||
-}
|
|
||||||
|
|
||||||
{-# 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 <user>/<repo> 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
|
|
||||||
|
|
@ -35,6 +35,11 @@ import Data.Text.Encoding (encodeUtf8, decodeUtf8With)
|
||||||
import Data.Text.Encoding.Error (strictDecode)
|
import Data.Text.Encoding.Error (strictDecode)
|
||||||
import Data.Time.Clock (getCurrentTime, diffUTCTime)
|
import Data.Time.Clock (getCurrentTime, diffUTCTime)
|
||||||
import Data.Traversable (for)
|
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 System.FilePath ((</>))
|
||||||
|
|
||||||
import qualified Data.ByteString.Lazy as BL (ByteString)
|
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.Foldable as F (find)
|
||||||
import qualified Data.Text as T (takeWhile, stripEnd)
|
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 Darcs.Local.Repository
|
||||||
import Data.Either.Local (maybeRight)
|
import Data.Either.Local (maybeRight)
|
||||||
import Data.EventTime.Local
|
import Data.EventTime.Local
|
||||||
|
|
|
||||||
|
|
@ -26,14 +26,13 @@ import Prelude
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Time.Calendar (toGregorian)
|
import Data.Time.Calendar (toGregorian)
|
||||||
import Data.Time.Clock (UTCTime (..))
|
import Data.Time.Clock (UTCTime (..))
|
||||||
|
import Development.Darcs.Rev
|
||||||
import Formatting (sformat, (%), int, left)
|
import Formatting (sformat, (%), int, left)
|
||||||
import Yesod.Core (YesodBreadcrumbs, breadcrumbs)
|
import Yesod.Core (YesodBreadcrumbs, breadcrumbs)
|
||||||
import Yesod.Core.Widget
|
import Yesod.Core.Widget
|
||||||
|
|
||||||
import qualified Data.Text as T (take)
|
import qualified Data.Text as T (take)
|
||||||
|
|
||||||
import Data.Revision.Local
|
|
||||||
import Development.DarcsRev (darcsTotalPatches, darcsRevision)
|
|
||||||
import Vervis.Avatar (getAvatarUrl)
|
import Vervis.Avatar (getAvatarUrl)
|
||||||
import Vervis.Settings (widgetFile)
|
import Vervis.Settings (widgetFile)
|
||||||
import Vervis.Style
|
import Vervis.Style
|
||||||
|
|
|
||||||
|
|
@ -8,6 +8,7 @@ resolver: lts-6.5
|
||||||
# Local packages, usually specified by relative directory name
|
# Local packages, usually specified by relative directory name
|
||||||
packages:
|
packages:
|
||||||
- '.'
|
- '.'
|
||||||
|
- '../darcs-rev'
|
||||||
- '../ssh'
|
- '../ssh'
|
||||||
- '../hit-graph'
|
- '../hit-graph'
|
||||||
- '../hit-harder'
|
- '../hit-harder'
|
||||||
|
|
|
||||||
10
vervis.cabal
10
vervis.cabal
|
|
@ -40,13 +40,6 @@ flag library-only
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules: Control.Applicative.Local
|
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
|
Darcs.Local.Repository
|
||||||
Data.Attoparsec.ByteString.Local
|
Data.Attoparsec.ByteString.Local
|
||||||
Data.Binary.Local
|
Data.Binary.Local
|
||||||
|
|
@ -68,7 +61,6 @@ library
|
||||||
Data.List.Local
|
Data.List.Local
|
||||||
Data.Maybe.Local
|
Data.Maybe.Local
|
||||||
Data.Paginate.Local
|
Data.Paginate.Local
|
||||||
Data.Revision.Local
|
|
||||||
Data.Text.UTF8.Local
|
Data.Text.UTF8.Local
|
||||||
Data.Text.Lazy.UTF8.Local
|
Data.Text.Lazy.UTF8.Local
|
||||||
Data.Time.Clock.Local
|
Data.Time.Clock.Local
|
||||||
|
|
@ -88,7 +80,6 @@ library
|
||||||
Database.Persist.Local.Sql
|
Database.Persist.Local.Sql
|
||||||
Database.Persist.Local.Sql.Orphan.Common
|
Database.Persist.Local.Sql.Orphan.Common
|
||||||
Database.Persist.Local.Sql.Orphan.PersistQueryForest
|
Database.Persist.Local.Sql.Orphan.PersistQueryForest
|
||||||
Development.DarcsRev
|
|
||||||
Diagrams.IntransitiveDAG
|
Diagrams.IntransitiveDAG
|
||||||
Formatting.CaseInsensitive
|
Formatting.CaseInsensitive
|
||||||
Network.SSH.Local
|
Network.SSH.Local
|
||||||
|
|
@ -232,6 +223,7 @@ library
|
||||||
-- for Storage.Hashed because hashed-storage seems
|
-- for Storage.Hashed because hashed-storage seems
|
||||||
-- unmaintained and darcs has its own copy
|
-- unmaintained and darcs has its own copy
|
||||||
, darcs
|
, darcs
|
||||||
|
, darcs-rev
|
||||||
, data-default
|
, data-default
|
||||||
-- for Data.Paginate.Local
|
-- for Data.Paginate.Local
|
||||||
, data-default-class
|
, data-default-class
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue