{-# LANGUAGE BlockArguments #-}
{-|
Module      : KMonad.Args.TH
Description : Template Haskell to use in the CLI
Copyright   : (c) slotThe, 2021
License     : MIT

Maintainer  : soliditsallgood@mailbox.org
Stability   : experimental
Portability : non-portable (TH)

-}
module KMonad.Args.TH (gitHash) where

import KMonad.Prelude

import Language.Haskell.TH (Exp, Q)
import Language.Haskell.TH.Syntax (runIO)
import UnliftIO.Directory (findExecutable)
import UnliftIO.Process (readProcessWithExitCode)

-- | Get the git hash of the current commit at compile time.
gitHash :: Q Exp
gitHash :: Q Exp
gitHash = do
  [Char]
str <- IO [Char] -> Q [Char]
forall a. IO a -> Q a
runIO do
    [Char] -> IO (Maybe [Char])
forall (m :: * -> *). MonadIO m => [Char] -> m (Maybe [Char])
findExecutable [Char]
"git" IO (Maybe [Char]) -> (Maybe [Char] -> IO [Char]) -> IO [Char]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe [Char]
Nothing  -> [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
""                         -- Git not present
      Just [Char]
git -> do
        (ExitCode
exitCode, [Char]
hash, [Char]
_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
forall (m :: * -> *).
MonadIO m =>
[Char] -> [[Char]] -> [Char] -> m (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
git [[Char]
"rev-parse", [Char]
"HEAD"] [Char]
""
        [Char] -> IO [Char]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case ExitCode
exitCode of
          ExitCode
ExitSuccess -> (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') [Char]
hash
          ExitCode
_           -> [Char]
""                       -- Not in a git repo
  [| fromString str |]