{-# LANGUAGE TemplateHaskell #-}

-- | Provides version numbers from calling git on build time or from an embedded
-- string.
--
-- The former is based on the 'gitrev' package with a 'Maybe' interface around
-- it, while the embedding is done using a special c-array placeholder in
-- cbits/revision.c
module Hydra.Version where

import Hydra.Prelude

import Development.GitRev qualified as GitRev
import Foreign.C (CString)
import GHC.Foreign (peekCStringLen)
import GHC.IO (unsafeDupablePerformIO)
import GHC.IO.Encoding (utf8)

-- | Identifier to be used when no revision can be found.
--
-- This is also the default used in 'gitrev'.
unknownVersion :: String
unknownVersion :: String
unknownVersion = String
"UNKNOWN"

-- | Determine the version on build time using `git describe`.
-- FIXME: This does not change when hydra-prelude is not re-compiled
gitDescribe :: Maybe String
gitDescribe :: Maybe String
gitDescribe
  | String
fromGit String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
unknownVersion = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just String
fromGit
 where
  -- Git describe version found during compilation by running git. If git could
  -- not be run, then this will be "UNKNOWN".
  fromGit :: String
fromGit = $(GitRev.gitDescribe)

-- | Determine the version on build time using `git rev-parse`.
-- FIXME: This does not change when hydra-prelude is not re-compiled
gitRevision :: Maybe String
gitRevision :: Maybe String
gitRevision
  | String
fromGit String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
unknownVersion = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just String
fromGit
 where
  -- Git revision found during compilation by running git. If
  -- git could not be run, then this will be "UNKNOWN".
  fromGit :: String
fromGit = $(GitRev.gitHash)

-- Placeholder for the git revision. Must match name in 'cbits/revision.c'.
foreign import ccall "&_hydra_gitrev" c_gitrev :: CString

-- | The git revision embedded at a special place holder in the object/binary.
-- NOTE: Keep this consistent with what is hard-coded in 'cbits/revision.c'
embeddedRevision :: Maybe String
embeddedRevision :: Maybe String
embeddedRevision
  | String
embedded String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
placeholder = Maybe String
forall a. Maybe a
Nothing
  | Bool
otherwise = String -> Maybe String
forall a. a -> Maybe a
Just String
embedded
 where
  embedded :: String
embedded = IO String -> String
forall a. IO a -> a
unsafeDupablePerformIO (TextEncoding -> CStringLen -> IO String
peekCStringLen TextEncoding
utf8 (CString
c_gitrev, Int
40))

  placeholder :: String
placeholder = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
40 Char
'0'