module Cardano.Config.Git.RevFromGit (
      gitRevFromGit
    ) where

import           Cardano.Prelude
import           Prelude (String)

import qualified Language.Haskell.TH as TH
import           System.IO.Error (ioeGetErrorType, isDoesNotExistErrorType)
import           System.Process (readProcessWithExitCode)

-- | Git revision found by running git rev-parse. If git could not be
-- executed, then this will be an empty string.
gitRevFromGit :: TH.Q TH.Exp
gitRevFromGit :: Q Exp
gitRevFromGit = Lit -> Exp
TH.LitE (Lit -> Exp) -> (String -> Lit) -> String -> Exp
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Lit
TH.StringL (String -> Exp) -> Q String -> Q Exp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String -> Q String
forall a. IO a -> Q a
TH.runIO IO String
runGitRevParse
    where
        runGitRevParse :: IO String
        runGitRevParse :: IO String
runGitRevParse = (IOError -> Maybe ())
-> (() -> IO String) -> IO String -> IO String
forall e b a.
Exception e =>
(e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust IOError -> Maybe ()
missingGit (IO String -> () -> IO String
forall a b. a -> b -> a
const (IO String -> () -> IO String) -> IO String -> () -> IO String
forall a b. (a -> b) -> a -> b
$ String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"") (IO String -> IO String) -> IO String -> IO String
forall a b. (a -> b) -> a -> b
$ do
            (ExitCode
exitCode, String
output, String
_) <-
                String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"git" [String
"rev-parse", String
"--verify", String
"HEAD"] String
""
            String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ case ExitCode
exitCode of
                ExitCode
ExitSuccess -> String
output
                ExitCode
_           -> String
""

        missingGit :: IOError -> Maybe ()
missingGit IOError
e = if IOErrorType -> Bool
isDoesNotExistErrorType (IOError -> IOErrorType
ioeGetErrorType IOError
e) then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing