107 lines
3.3 KiB
Haskell
107 lines
3.3 KiB
Haskell
{- 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
|
|
}
|