add build time and git info to BuildInfo

This commit is contained in:
Herbert Lange
2025-08-08 17:36:03 +02:00
parent e7c0b6dada
commit e0ad7594dd
2 changed files with 26 additions and 3 deletions

View File

@@ -158,7 +158,8 @@ library
json >= 0.9.1 && <= 0.11, json >= 0.9.1 && <= 0.11,
parallel >= 3.2.1.1 && < 3.3, parallel >= 3.2.1.1 && < 3.3,
process >= 1.4.3 && < 1.7, process >= 1.4.3 && < 1.7,
time >= 1.6.0 && <= 1.12.2 time >= 1.6.0 && <= 1.12.2,
template-haskell >= 2.20.0.0
hs-source-dirs: src/compiler hs-source-dirs: src/compiler
exposed-modules: exposed-modules:

View File

@@ -1,13 +1,35 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module GF.Infra.BuildInfo where module GF.Infra.BuildInfo where
import System.Info import System.Info
import Data.Version(showVersion) import Data.Version(showVersion)
import Language.Haskell.TH.Syntax
import Control.Monad.IO.Class
import Control.Exception
import Data.Time
import Data.Time.Format.ISO8601
import System.Process
-- Use Template Haskell to get compile time
buildTime :: String
buildTime = $(do
timeZone <- liftIO getCurrentTimeZone
time <- liftIO $ utcToLocalTime timeZone <$> getCurrentTime
return $ LitE $ StringL $ iso8601Show time )
-- Use Template Haskell to get current Git information
gitInfo :: String
gitInfo = $(do
info <- liftIO $ try $ readProcess "git" ["log", "--format=\"Commit %h Tag %(describe:tags=true)\"", "-1"] "" :: Q (Either SomeException String)
return $ LitE $ StringL $ either (\_ -> "unavailable") id info )
{-# NOINLINE buildInfo #-} {-# NOINLINE buildInfo #-}
buildInfo = buildInfo =
"Built on "++os++"/"++arch "Built on "++os++"/"++arch
++" with "++compilerName++"-"++showVersion compilerVersion ++" with "++compilerName++"-"++showVersion compilerVersion ++ " at " ++ buildTime ++ "\nGit info: " ++ gitInfo
++", flags:" ++"\nFlags:"
#ifdef USE_INTERRUPT #ifdef USE_INTERRUPT
++" interrupt" ++" interrupt"
#endif #endif