Skip to content
Open
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 16 additions & 5 deletions src/Simplex/Messaging/Server/Main/GitCommit.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,14 +6,25 @@ module Simplex.Messaging.Server.Main.GitCommit
) where

import Language.Haskell.TH
import Language.Haskell.TH.Syntax (addDependentFile)
import System.Process
import Control.Exception
import Control.Monad (filterM)
import System.Directory (doesFileExist)
import System.Exit
import System.FilePath ((</>))

gitCommit :: Q Exp
gitCommit = stringE . commit =<< runIO (try $ readProcessWithExitCode "git" ["rev-parse", "HEAD"] "")
gitCommit =
runIO gitHead >>= \case
Right (ExitSuccess, out, _)
| [commit, gitDir] <- lines out -> do
-- without these dependencies GHC recompilation check would not know that the commit changed.
-- HEAD reflog is updated on any HEAD change and, unlike branch ref files, git gc cannot remove it
-- mid-build; it is absent when reflogs are disabled, and addDependentFile fails on a missing file
mapM_ addDependentFile =<< runIO (filterM doesFileExist [gitDir </> "HEAD", gitDir </> "logs" </> "HEAD"])
stringE commit
_ -> stringE ""
where
commit :: Either SomeException (ExitCode, String, String) -> String
commit = \case
Right (ExitSuccess, out, _) -> take 40 out
_ -> ""
gitHead :: IO (Either SomeException (ExitCode, String, String))
gitHead = try $ readProcessWithExitCode "git" ["rev-parse", "HEAD", "--git-dir"] ""
Loading