{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}

{- FOURMOLU_DISABLE -}
{-# LANGUAGE TemplateHaskellQuotes #-}

module Cardano.Git.Rev
  ( gitRev
  ) where

import           Data.Text (Text)
import qualified Data.Text as Text

import           Foreign.C.String (CString)
import           GHC.Foreign (peekCStringLen)
import           Language.Haskell.TH (Exp, Q)
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH
import           System.IO (utf8)
import           System.IO.Unsafe (unsafeDupablePerformIO)

#if !defined(arm_HOST_ARCH)
import           Control.Exception (catch)
import           System.Exit (ExitCode (..))
import qualified System.IO as IO
import           System.IO.Error (isDoesNotExistError)
import           System.Process (readProcessWithExitCode)
#endif

foreign import ccall "&_cardano_git_rev" c_gitrev :: CString

-- This must be a TH splice to ensure the git commit is captured at build time.
-- ie called as `$(gitRev)`.
gitRev :: Q Exp
gitRev :: Q Exp
gitRev =
    [| if
         | gitRevEmbed /= zeroRev -> gitRevEmbed
         | otherwise              -> $(Text -> Q Exp
textE (Text -> Q Exp) -> Q Text -> Q Exp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Text -> Q Text
forall a. IO a -> Q a
TH.runIO IO Text
runGitRevParse)
    |]

-- Git revision embedded after compilation using
-- Data.FileEmbed.injectWith. If nothing has been injected,
-- this will be filled with 0 characters.
gitRevEmbed :: Text
gitRevEmbed :: Text
gitRevEmbed = [Char] -> Text
Text.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
28 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ IO [Char] -> [Char]
forall a. IO a -> a
unsafeDupablePerformIO (TextEncoding -> CStringLen -> IO [Char]
peekCStringLen TextEncoding
utf8 (CString
c_gitrev, Int
68))

runGitRevParse :: IO Text
#if defined(arm_HOST_ARCH)
-- cross compiling to arm fails; due to a linker bug
runGitRevParse = pure zeroRev
#else
runGitRevParse :: IO Text
runGitRevParse = do
    (ExitCode
exitCode, [Char]
output, [Char]
errorMessage) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode_ [Char]
"git" [[Char]
"rev-parse", [Char]
"--verify", [Char]
"HEAD"] [Char]
""
    case ExitCode
exitCode of
      ExitCode
ExitSuccess -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.strip ([Char] -> Text
Text.pack [Char]
output)
      ExitFailure Int
_ -> do
        Handle -> [Char] -> IO ()
IO.hPutStrLn Handle
IO.stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"WARNING: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
errorMessage
        Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
zeroRev
  where
    readProcessWithExitCode_ :: FilePath -> [String] -> String -> IO (ExitCode, String, String)
    readProcessWithExitCode_ :: [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode_ [Char]
cmd [[Char]]
args [Char]
input =
      IO (ExitCode, [Char], [Char])
-> (IOError -> IO (ExitCode, [Char], [Char]))
-> IO (ExitCode, [Char], [Char])
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch ([Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
cmd [[Char]]
args [Char]
input) ((IOError -> IO (ExitCode, [Char], [Char]))
 -> IO (ExitCode, [Char], [Char]))
-> (IOError -> IO (ExitCode, [Char], [Char]))
-> IO (ExitCode, [Char], [Char])
forall a b. (a -> b) -> a -> b
$ \IOError
e ->
      if IOError -> Bool
isDoesNotExistError IOError
e
        then (ExitCode, [Char], [Char]) -> IO (ExitCode, [Char], [Char])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ExitCode
ExitFailure Int
127, [Char]
"", IOError -> [Char]
forall a. Show a => a -> [Char]
show IOError
e)
        else (ExitCode, [Char], [Char]) -> IO (ExitCode, [Char], [Char])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ExitCode
ExitFailure Int
999, [Char]
"", IOError -> [Char]
forall a. Show a => a -> [Char]
show IOError
e)
#endif

textE :: Text -> Q Exp
textE :: Text -> Q Exp
textE = Text -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Text -> m Exp
TH.lift

zeroRev :: Text
zeroRev :: Text
zeroRev = Text
"0000000000000000000000000000000000000000"