module Cardano.Git.RevFromGit
  ( gitRevFromGit
  ) where

import           Cardano.Prelude
import           Prelude (String)

import qualified Language.Haskell.TH as TH
import qualified System.IO as IO
import           System.IO.Error (isDoesNotExistError)
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 = do
    (ExitCode
exitCode, String
output, String
errorMessage) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode_ String
"git" [String
"rev-parse", String
"--verify", String
"HEAD"] String
""
    case ExitCode
exitCode of
      ExitCode
ExitSuccess -> String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
output
      ExitFailure Int
_ -> do
        Handle -> String -> IO ()
IO.hPutStrLn Handle
IO.stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"WARNING: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorMessage
        String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
""

  readProcessWithExitCode_ :: FilePath -> [String] -> String -> IO (ExitCode, String, String)
  readProcessWithExitCode_ :: String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode_ String
cmd [String]
args String
input =
    IO (ExitCode, String, String)
-> (IOError -> IO (ExitCode, String, String))
-> IO (ExitCode, String, String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
cmd [String]
args String
input) ((IOError -> IO (ExitCode, String, String))
 -> IO (ExitCode, String, String))
-> (IOError -> IO (ExitCode, String, String))
-> IO (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ \IOError
e ->
    if IOError -> Bool
isDoesNotExistError IOError
e
    then (ExitCode, String, String) -> IO (ExitCode, String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
127, String
"", IOError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show IOError
e)
    else (ExitCode, String, String) -> IO (ExitCode, String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
999, String
"", IOError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show IOError
e)