{- This file is part of hit-graph.
 -
 - 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.Git.Graph.Util
    ( ObjId (..)
    , resolveNameMaybe
    , resolveName
    , listReferences
    , loadCommits
    , loadCommitsMulti
    )
where

import Control.Monad.IO.Class
import Data.Foldable (foldl', foldlM)
import Data.Git.Named (RefName (..))
import Data.Git.Ref (Ref, toBinary)
import Data.Git.Repository (getCommit, resolveRevision, branchList, tagList)
import Data.Git.Revision (Revision (..))
import Data.Git.Storage (Git)
import Data.Git.Types (Commit (..))
import Data.Graph.Inductive.Graph (Graph (mkGraph), Node)
import Data.Graph.Inductive.PatriciaTree (Gr)
import Data.Hashable (Hashable (..))
import Data.Maybe (catMaybes, fromMaybe)
import Data.Ord (Down (..))

--import qualified Data.DList as D
import qualified Data.HashMap.Strict as M
import qualified Data.Set as S

import Data.Graph.Inductive.Query.Topsort

-- | A git object identifier. This is a SHA-1 hash. Its common textual
-- representation is a 40-byte ASCII hexadecimal string.
newtype ObjId = ObjId { unObjId :: Ref } deriving Eq

instance Hashable ObjId where
    hashWithSalt salt = hashWithSalt salt . toBinary . unObjId
    hash = hash . toBinary . unObjId

-- | For a given ref name - HEAD or branch or tag - determine its ref hash.
resolveNameMaybe :: Git -> String -> IO (Maybe ObjId)
resolveNameMaybe git name =
    fmap ObjId <$> resolveRevision git (Revision name [])

-- | For a given ref name - HEAD or branch or tag - determine its ref hash.
resolveName :: Git -> String -> IO ObjId
resolveName git name = do
    moid <- resolveNameMaybe git name
    return $ fromMaybe (error "No such ref name in the repo") moid

-- | List the available references in a git repo, sorted by ref name. The list
-- includes HEAD, branches and tags.
listReferences :: Git -> IO [(ObjId, String)]
listReferences git = do
    branches <- S.mapMonotonic refNameRaw <$> branchList git
    tags <- S.mapMonotonic refNameRaw <$> tagList git
    let names = S.toAscList $ S.insert "HEAD" $ S.union branches tags
    mentries <-
        traverse
            (\ name -> fmap (flip (,) name) <$> resolveNameMaybe git name)
            names
    return $ catMaybes mentries

-- | Load the entire graph of commits which are ancestors of the given ref
-- (and that ref itself). Fold the commit structure into a value of type @a@
-- inside monad @m@.
--
-- This is a low-level function which operates on a commit tree, i.e. the same
-- ref may be visited more than once (if it has more than one child commit).
-- You can use the provided flexibility to implement graph algorithms over the
-- commits, or build a graph using some graph library and use that library's
-- tools for further processing.
loadCommits
    :: MonadIO m
    => Git
    -- ^ Open git repository context
    -> ((ObjId, Commit) -> ObjId -> a -> m (a, Maybe Commit))
    -- ^ Given a child commit, one of its parent commits and an @a@ value,
    -- generate an updated @a@ value. The second returned value determines
    -- whether traversal should proceed to the parent of the parent commit. If
    -- you return 'Nothing', it won't. If you load the parent commit (e.g. with
    -- 'getCommit') and return 'Just' it, traversal will proceed to its
    -- parents.
    -> a
    -- ^ Initial value
    -> ObjId
    -- ^ Hash of the commit whose ancestor graph should be loaded
    -> Maybe Commit
    -- ^ If you already read the commit for the ref passed as the previous
    -- parameter, pass the commit here to avoid repeated loading of it.
    -- Otherwise, pass 'Nothing' and it will be read from the repo.
    -> m a
loadCommits git func val oid mcmt = readCommitMaybe oid mcmt >>= go val oid
    where
    readCommit = liftIO . getCommit git . unObjId
    readCommitMaybe r = maybe (readCommit r) return
    step p v r = do
        (v', mc) <- func p r v
        case mc of
            Nothing -> return v'
            Just c  -> go v' r c
    go v r c = foldlM (step (r, c)) v $ map ObjId $ commitParents c

-- | Like 'loadCommits', but takes a list of refs and goes over all their
-- ancestors. This is just a convenience shortcut which folds a list with
-- 'loadCommits'. Passing a list with a single element is the same as running
-- 'loadCommits'.
loadCommitsMulti
    :: MonadIO m
    => Git
    -- ^ Open git repository context
    -> ((ObjId, Commit) -> ObjId -> a -> m (a, Maybe Commit))
    -- ^ Given a child commit, one of its parent commits and an @a@ value,
    -- generate an updated @a@ value. The second returned value determines
    -- whether traversal should proceed to the parent of the parent commit. If
    -- you return 'Nothing', it won't. If you load the parent commit (e.g. with
    -- 'getCommit') and return 'Just' it, traversal will proceed to its
    -- parents.
    -> a
    -- ^ Initial value
    -> [(ObjId, Maybe Commit)]
    -- ^ Commits whose ancestors to scan. For each commit, pass:
    --
    -- (1) Hash of the commit
    -- (2) If you already loaded the commit from the ref, pass the commit here
    --     to avoid repeated loading of it. Otherwise, pass 'Nothing' and it
    --     will be read from the repo.
    -> m a
loadCommitsMulti git func val pairs =
    foldlM (\ v (r, mc) -> loadCommits git func v r mc) val pairs