{-|
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 Control.Monad.Trans.Maybe
import Language.Haskell.TH (Exp, Q, 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
  -- This makes use of the `MonadFail` instance for `MaybeT`,
  -- which simply returns `Nothing` on failure.
  hash <- IO (Maybe [Char]) -> Q (Maybe [Char])
forall a. IO a -> Q a
runIO (IO (Maybe [Char]) -> Q (Maybe [Char]))
-> (MaybeT IO [Char] -> IO (Maybe [Char]))
-> MaybeT IO [Char]
-> Q (Maybe [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT IO [Char] -> IO (Maybe [Char])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO [Char] -> Q (Maybe [Char]))
-> MaybeT IO [Char] -> Q (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ do
    Just git <- IO (Maybe [Char]) -> MaybeT IO (Maybe [Char])
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe [Char]) -> MaybeT IO (Maybe [Char]))
-> IO (Maybe [Char]) -> MaybeT IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> IO (Maybe [Char])
forall (m :: * -> *). MonadIO m => [Char] -> m (Maybe [Char])
findExecutable [Char]
"git"
    (ExitSuccess, hash, _) <- lift $ readProcessWithExitCode git ["rev-parse", "HEAD"] ""
    pure $ takeWhile (/= '\n') hash
  [| fromString <$> hash |]