-- |
-- Module      :  $Header$
-- Copyright   :  (c) 2015 Adam C. Foltzer
-- License     :  BSD3
-- Maintainer  :  acfoltzer@galois.com
-- Stability   :  provisional
-- Portability :  portable
--
-- Some handy Template Haskell splices for including the current git
-- hash and branch in the code of your project. Useful for including
-- in panic messages, @--version@ output, or diagnostic info for more
-- informative bug reports.
module Development.GitRev
  ( gitBranch,
    gitCommitCount,
    gitCommitDate,
    gitDescribe,
    gitDiff,
    gitDirty,
    gitDirtyTracked,
    gitHash,
    gitShortHash,
    gitTree,
  )
where

import Development.GitRev.Utils qualified as Utils
import Development.GitRev.Utils.Git qualified as Git
import Language.Haskell.TH (ExpQ, Q)
import Language.Haskell.TH.Syntax (Lift (lift))

-- | Return the hash of the current git commit, or @UNKNOWN@ if not in
-- a git repository.
--
-- ==== __Examples__
--
-- > λ. $(gitHash)
-- > "e67e943dd03744d3f93c21f84e127744e6a04543"
--
-- >>> $(gitHash)
-- ...
gitHash :: ExpQ
gitHash :: ExpQ
gitHash = Q String -> ExpQ
forall a. Lift a => Q a -> ExpQ
qToExp (Q String -> ExpQ) -> Q String -> ExpQ
forall a b. (a -> b) -> a -> b
$ Q (Either GitError String) -> Q String
forall (f :: * -> *) e.
Functor f =>
f (Either e String) -> f String
Utils.projectStringUnknown Q (Either GitError String)
Git.gitHashQ

-- | Return the short hash of the current git commit, or @UNKNOWN@ if not in
-- a git repository.
--
-- ==== __Examples__
--
-- > λ. $(gitShortHash)
-- > "e67e943"
--
-- >>> $(gitShortHash)
-- ...
gitShortHash :: ExpQ
gitShortHash :: ExpQ
gitShortHash = Q String -> ExpQ
forall a. Lift a => Q a -> ExpQ
qToExp (Q String -> ExpQ) -> Q String -> ExpQ
forall a b. (a -> b) -> a -> b
$ Q (Either GitError String) -> Q String
forall (f :: * -> *) e.
Functor f =>
f (Either e String) -> f String
Utils.projectStringUnknown Q (Either GitError String)
Git.gitShortHashQ

-- | Return the branch (or tag) name of the current git commit, or @UNKNOWN@
-- if not in a git repository. For detached heads, this will just be
-- "HEAD".
--
-- ==== __Examples__
--
-- > λ. $(gitBranch)
-- > "main"
--
-- >>> $(gitBranch)
-- ...
gitBranch :: ExpQ
gitBranch :: ExpQ
gitBranch = Q String -> ExpQ
forall a. Lift a => Q a -> ExpQ
qToExp (Q String -> ExpQ) -> Q String -> ExpQ
forall a b. (a -> b) -> a -> b
$ Q (Either GitError String) -> Q String
forall (f :: * -> *) e.
Functor f =>
f (Either e String) -> f String
Utils.projectStringUnknown Q (Either GitError String)
Git.gitBranchQ

-- | Return the long git description for the current git commit, or
-- @UNKNOWN@ if not in a git repository.
--
-- ==== __Examples__
--
-- > λ. $(gitDescribe)
-- > "e67e943"
--
-- >>> $(gitDescribe)
-- ...
gitDescribe :: ExpQ
gitDescribe :: ExpQ
gitDescribe = Q String -> ExpQ
forall a. Lift a => Q a -> ExpQ
qToExp (Q String -> ExpQ) -> Q String -> ExpQ
forall a b. (a -> b) -> a -> b
$ Q (Either GitError String) -> Q String
forall (f :: * -> *) e.
Functor f =>
f (Either e String) -> f String
Utils.projectStringUnknown Q (Either GitError String)
Git.gitDescribeQ

-- | Return @True@ if there are non-committed files present in the
-- repository.
--
-- ==== __Examples__
--
-- > λ. $(gitDirty)
-- > False
--
-- >>> $(gitDirty)
-- ...
gitDirty :: ExpQ
gitDirty :: ExpQ
gitDirty = Q Bool -> ExpQ
forall a. Lift a => Q a -> ExpQ
qToExp (Q Bool -> ExpQ) -> Q Bool -> ExpQ
forall a b. (a -> b) -> a -> b
$ Q (Either GitError Bool) -> Q Bool
forall (f :: * -> *) e. Functor f => f (Either e Bool) -> f Bool
Utils.projectFalse Q (Either GitError Bool)
Git.gitDirtyQ

-- | Return @True@ if there are non-commited changes to tracked files
-- present in the repository.
--
-- ==== __Examples__
--
-- > λ. $(gitDirtyTracked)
-- > False
--
-- >>> $(gitDirtyTracked)
-- ...
gitDirtyTracked :: ExpQ
gitDirtyTracked :: ExpQ
gitDirtyTracked = Q Bool -> ExpQ
forall a. Lift a => Q a -> ExpQ
qToExp (Q Bool -> ExpQ) -> Q Bool -> ExpQ
forall a b. (a -> b) -> a -> b
$ Q (Either GitError Bool) -> Q Bool
forall (f :: * -> *) e. Functor f => f (Either e Bool) -> f Bool
Utils.projectFalse Q (Either GitError Bool)
Git.gitDirtyTrackedQ

-- | Return the number of commits in the current head.
--
-- ==== __Examples__
--
-- > λ. $(gitCommitCount)
-- > "47"
--
-- >>> $(gitCommitCount)
-- ...
gitCommitCount :: ExpQ
gitCommitCount :: ExpQ
gitCommitCount = Q String -> ExpQ
forall a. Lift a => Q a -> ExpQ
qToExp (Q String -> ExpQ) -> Q String -> ExpQ
forall a b. (a -> b) -> a -> b
$ Q (Either GitError String) -> Q String
forall (f :: * -> *) e.
Functor f =>
f (Either e String) -> f String
Utils.projectStringUnknown Q (Either GitError String)
Git.gitCommitCountQ

-- | Return the commit date of the current head.
--
-- ==== __Examples__
--
-- > λ. $(gitCommitDate)
-- > "Mon Apr 14 22:14:44 2025 +1200"
--
-- >>> $(gitCommitDate)
-- ...
gitCommitDate :: ExpQ
gitCommitDate :: ExpQ
gitCommitDate = Q String -> ExpQ
forall a. Lift a => Q a -> ExpQ
qToExp (Q String -> ExpQ) -> Q String -> ExpQ
forall a b. (a -> b) -> a -> b
$ Q (Either GitError String) -> Q String
forall (f :: * -> *) e.
Functor f =>
f (Either e String) -> f String
Utils.projectStringUnknown Q (Either GitError String)
Git.gitCommitDateQ

-- | Return the diff of the working copy with HEAD.
--
-- ==== __Examples__
--
-- > λ. $(gitDiff)
-- > diff ...
--
-- >>> $(gitDiff)
-- ...
gitDiff :: ExpQ
gitDiff :: ExpQ
gitDiff = Q String -> ExpQ
forall a. Lift a => Q a -> ExpQ
qToExp (Q String -> ExpQ) -> Q String -> ExpQ
forall a b. (a -> b) -> a -> b
$ Q (Either GitError String) -> Q String
forall (f :: * -> *) e.
Functor f =>
f (Either e String) -> f String
Utils.projectStringUnknown Q (Either GitError String)
Git.gitDiffQ

-- | Return the hash of the current tree.
--
-- ==== __Examples__
--
-- > λ. $(gitTreeQ)
-- > "Mon Apr 14 22:14:44 2025 +1200"
--
-- >>> $(gitTreeQ)
-- ...
gitTree :: ExpQ
gitTree :: ExpQ
gitTree = Q String -> ExpQ
forall a. Lift a => Q a -> ExpQ
qToExp (Q String -> ExpQ) -> Q String -> ExpQ
forall a b. (a -> b) -> a -> b
$ Q (Either GitError String) -> Q String
forall (f :: * -> *) e.
Functor f =>
f (Either e String) -> f String
Utils.projectStringUnknown Q (Either GitError String)
Git.gitTreeQ

qToExp :: forall a. (Lift a) => Q a -> ExpQ
qToExp :: forall a. Lift a => Q a -> ExpQ
qToExp = (Q a -> (a -> ExpQ) -> ExpQ
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> ExpQ
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => a -> m Exp
lift)