{-# LANGUAGE TemplateHaskell #-}

{-
This module provides Template Haskell functions to retrieve git information
(branch name, commit hash, commit date, and commit count) at compile time.
It attempts to get these values by reading the .git folder.
If the values are not available (e.g., when building outside of a git repository,
or when building with Nix), it falls back to environment variables.
Environment variables take precedence over git values.
If the relevant env var is not set, it returns the empty string.

Usage:

@
module MyPrograms where

import Development.GitRev.Extras (gitHash, gitCommitDate)

main :: IO ()
main = do
  -- Falls back to reading the GIT_BRANCH env var
  putStrLn $ "git branch: " <> $(gitBranch)

  -- Falls back to reading the GIT_BRANCH env var
  putStrLn $ "git rev: " <> $(gitHash)

  -- Falls back to reading the GIT_COMMIT_DATE env var
  putStrLn $ "git commit date: " <> $(gitCommitDate)

  -- Falls back to reading the GIT_COMMIT_COUNT env var
  putStrLn $ "git commit count: " <> $(gitCommitCount)
@

When building with haskell.nix, this snippet can be used to inject the env vars:

@
haskellNix.cabalProject' {
  ...
  modules = [{
    packages = {
      <package>.components.exes.<exe>.preBuild = ''
        export GIT_HASH=${inputs.self.sourceInfo.rev or "unknown"}
        export GIT_COMMIT_DATE=${inputs.self.sourceInfo.lastModifiedDate}
      '';
    };
  }];
};
@
-}

module Development.GitRev.Extras
  ( gitBranch
  , gitHash
  , gitCommitDate
  , gitCommitCount
  ) where

import Development.GitRev qualified as GitRev
import Language.Haskell.TH qualified as TH
import System.Environment qualified as System.Environment


data VersionVariable
  = GitBranch
  | GitHash
  | GitCommitDate
  | GitCommitCount
  deriving stock (Int -> VersionVariable -> ShowS
[VersionVariable] -> ShowS
VersionVariable -> String
(Int -> VersionVariable -> ShowS)
-> (VersionVariable -> String)
-> ([VersionVariable] -> ShowS)
-> Show VersionVariable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VersionVariable -> ShowS
showsPrec :: Int -> VersionVariable -> ShowS
$cshow :: VersionVariable -> String
show :: VersionVariable -> String
$cshowList :: [VersionVariable] -> ShowS
showList :: [VersionVariable] -> ShowS
Show, VersionVariable -> VersionVariable -> Bool
(VersionVariable -> VersionVariable -> Bool)
-> (VersionVariable -> VersionVariable -> Bool)
-> Eq VersionVariable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VersionVariable -> VersionVariable -> Bool
== :: VersionVariable -> VersionVariable -> Bool
$c/= :: VersionVariable -> VersionVariable -> Bool
/= :: VersionVariable -> VersionVariable -> Bool
Eq)


-- | Falls back to reading the GIT_BRANCH env var.
gitBranch :: TH.ExpQ
gitBranch :: ExpQ
gitBranch = String -> ExpQ
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE (String -> ExpQ) -> Q String -> ExpQ
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VersionVariable -> Q String
getVersionVariable VersionVariable
GitBranch


-- | Falls back to reading the GIT_HASH env var.
gitHash :: TH.ExpQ
gitHash :: ExpQ
gitHash = String -> ExpQ
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE (String -> ExpQ) -> Q String -> ExpQ
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VersionVariable -> Q String
getVersionVariable VersionVariable
GitHash


-- | Falls back to reading the GIT_COMMIT_DATE env var.
gitCommitDate :: TH.ExpQ
gitCommitDate :: ExpQ
gitCommitDate = String -> ExpQ
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE (String -> ExpQ) -> Q String -> ExpQ
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VersionVariable -> Q String
getVersionVariable VersionVariable
GitCommitDate


-- | Falls back to reading the GIT_COMMIT_COUNT env var.
gitCommitCount :: TH.ExpQ
gitCommitCount :: ExpQ
gitCommitCount = String -> ExpQ
forall (m :: * -> *). Quote m => String -> m Exp
TH.stringE (String -> ExpQ) -> Q String -> ExpQ
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VersionVariable -> Q String
getVersionVariable VersionVariable
GitCommitCount


getVersionVariable :: VersionVariable -> TH.Q String
getVersionVariable :: VersionVariable -> Q String
getVersionVariable VersionVariable
verVar = do
  Maybe String
valueFromEnv <- Q (Maybe String)
getValueFromEnv
  case (String
valueFromGit, Maybe String
valueFromEnv) of
    (String
"UNKNOWN", Just String
v) ->
      String -> Q String
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return String
v
    (String
"UNKNOWN", Maybe String
Nothing) ->
      String -> Q String
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
    (String
_, Just String
v) ->
      String -> Q String
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return String
v
    (String
v, Maybe String
_) ->
      String -> Q String
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return String
v
  where
    valueFromGit :: String
    valueFromGit :: String
valueFromGit = case VersionVariable
verVar of
      VersionVariable
GitBranch      -> $(GitRev.gitBranch)
      VersionVariable
GitHash        -> $(GitRev.gitHash)
      VersionVariable
GitCommitDate  -> $(GitRev.gitCommitDate)
      VersionVariable
GitCommitCount -> $(GitRev.gitCommitCount)

    getValueFromEnv :: TH.Q (Maybe String)
    getValueFromEnv :: Q (Maybe String)
getValueFromEnv = String -> Q (Maybe String)
lookupEnvQ String
envVarName

    envVarName :: String
    envVarName :: String
envVarName = case VersionVariable
verVar of
      VersionVariable
GitBranch      -> String
"GIT_BRANCH"
      VersionVariable
GitHash        -> String
"GIT_HASH"
      VersionVariable
GitCommitDate  -> String
"GIT_COMMIT_DATE"
      VersionVariable
GitCommitCount -> String
"GIT_COMMIT_COUNT"

    lookupEnvQ :: String -> TH.Q (Maybe String)
    lookupEnvQ :: String -> Q (Maybe String)
lookupEnvQ = IO (Maybe String) -> Q (Maybe String)
forall a. IO a -> Q a
TH.runIO (IO (Maybe String) -> Q (Maybe String))
-> (String -> IO (Maybe String)) -> String -> Q (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
System.Environment.lookupEnv