{- 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
    }