This repository has been archived by the owner on Aug 18, 2020. It is now read-only.
/
CompileInfo.hs
69 lines (57 loc) · 2.24 KB
/
CompileInfo.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
-- | Compile time information manipulations. Was introduced as
-- CSL-1563 to avoid extra library recompilations when git revision
-- changes. See the issue description/comments for more details.
module Pos.Util.CompileInfo
( CompileTimeInfo (..)
, HasCompileInfo
, compileInfo
, withCompileInfo
, retrieveCompileTimeInfo
) where
import Universum
import Data.Default (Default (def))
import Data.Reflection (Given (..), give, given)
import qualified Data.Text as T
import qualified Data.Text.Buildable
import Formatting (bprint, stext, (%))
import Instances.TH.Lift ()
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH
import System.Environment (lookupEnv)
import System.Exit (ExitCode (..))
import System.Process (readProcessWithExitCode)
-- | Data about the system that we want to retrieve in compile time.
data CompileTimeInfo = CompileTimeInfo
{ ctiGitRevision :: Text
} deriving (Show,TH.Lift)
instance Default CompileTimeInfo where
def = CompileTimeInfo { ctiGitRevision = "<def instance>"
}
instance Buildable CompileTimeInfo where
build CompileTimeInfo{..} =
bprint ("Compile time info: git revision '"%stext%"'") ctiGitRevision
type HasCompileInfo = Given CompileTimeInfo
compileInfo :: HasCompileInfo => CompileTimeInfo
compileInfo = given
withCompileInfo :: CompileTimeInfo -> (HasCompileInfo => r) -> r
withCompileInfo = give
retrieveCompileTimeInfo :: TH.Q TH.Exp
retrieveCompileTimeInfo = do
cti <- TH.runIO $ do
ctiGitRevision <- T.strip . fromString <$> retrieveGit
pure $ CompileTimeInfo {..}
TH.lift cti
where
retrieveGit :: IO String
retrieveGit =
lookupEnv "GITREV" >>= maybe retrieveFromGitExecutable pure
retrieveFromGitExecutable :: IO String
retrieveFromGitExecutable = do
(exitCode, output, _) <-
readProcessWithExitCode "git" ["rev-parse", "--verify", "HEAD"] ""
pure $ case exitCode of
ExitSuccess -> output
_ -> "Couldn't fetch git revision"