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