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

{- FOURMOLU_DISABLE -}

#if __GLASGOW_HASKELL__ >= 900
{-# LANGUAGE TemplateHaskellQuotes #-}
#else
-- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2288
{-# LANGUAGE TemplateHaskell #-}
#endif

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              -> $(textE =<< TH.runIO 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 forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
28 forall a b. (a -> b) -> a -> b
$ 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall a b. (a -> b) -> a -> b
$ [Char]
"WARNING: " forall a. [a] -> [a] -> [a]
++ [Char]
errorMessage
        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 =
      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) forall a b. (a -> b) -> a -> b
$ \IOError
e ->
      if IOError -> Bool
isDoesNotExistError IOError
e
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ExitCode
ExitFailure Int
127, [Char]
"", forall a. Show a => a -> [Char]
show IOError
e)
        else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> ExitCode
ExitFailure Int
999, [Char]
"", forall a. Show a => a -> [Char]
show IOError
e)
#endif

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

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