master..0612da8 · typeable/gitrev

git.iko.soy/typeable/gitrev

on 0612da8 help sign in

.travis.yml+1−85

since splitsnapshots

unifiedsplit

@@ -1,85 +1 @@

1−# This file has been generated -- see https://github.com/hvr/multi-ghc-travis

2−language: c

1+language: haskell

3−sudo: false

4−

5−cache:

6− directories:

7− - $HOME/.cabsnap

8− - $HOME/.cabal/packages

9−

10−before_cache:

11− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

12− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar

13−

14−matrix:

15− include:

16− - env: CABALVER=1.16 GHCVER=7.6.3

17− compiler: ": #GHC 7.6.3"

18− addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}

19− - env: CABALVER=1.18 GHCVER=7.8.4

20− compiler: ": #GHC 7.8.4"

21− addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}

22− - env: CABALVER=1.22 GHCVER=7.10.3

23− compiler: ": #GHC 7.10.3"

24− addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}

25− - env: CABALVER=1.24 GHCVER=8.0.2

26− compiler: ": #GHC 8.0.2"

27− addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}}

28−

29−before_install:

30− - unset CC

31− - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH

32−

33−install:

34− - cabal --version

35− - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"

36− - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];

37− then

38− zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >

39− $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;

40− fi

41− - travis_retry cabal update -v

42− - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config

43− - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt

44− - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt

45−

46−# check whether current requested install-plan matches cached package-db snapshot

47− - if diff -u $HOME/.cabsnap/installplan.txt installplan.txt;

48− then

49− echo "cabal build-cache HIT";

50− rm -rfv .ghc;

51− cp -a $HOME/.cabsnap/ghc $HOME/.ghc;

52− cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;

53− else

54− echo "cabal build-cache MISS";

55− rm -rf $HOME/.cabsnap;

56− mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;

57− cabal install --only-dependencies --enable-tests --enable-benchmarks;

58− fi

59−

60−# snapshot package-db on cache miss

61− - if [ ! -d $HOME/.cabsnap ];

62− then

63− echo "snapshotting package-db to build-cache";

64− mkdir $HOME/.cabsnap;

65− cp -a $HOME/.ghc $HOME/.cabsnap/ghc;

66− cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;

67− fi

68−

69−# Here starts the actual work to be performed for the package under test;

70−# any command which exits with a non-zero exit code causes the build to fail.

71−script:

72− - if [ -f configure.ac ]; then autoreconf -i; fi

73− - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging

74− - cabal build # this builds all libraries and executables (including tests/benchmarks)

75− - cabal test

76− - cabal check

77− - cabal sdist # tests that a source-distribution can be generated

78−

79−# Check that the resulting source distribution can be built & installed.

80−# If there are no other `.tar.gz` files in `dist`, this can be even simpler:

81−# `cabal install --force-reinstalls dist/*-*.tar.gz`

82− - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&

83− (cd dist && cabal install --force-reinstalls "$SRC_TGZ")

84−

85−# EOF

Example.hs+1−6

@@ -1,16 +1,11 @@

1−{-# LANGUAGE NoImplicitPrelude #-}

2{-# LANGUAGE TemplateHaskell #-}

1{-# LANGUAGE TemplateHaskell #-}

3module Example where

2module Example where

4−import Prelude (String, concat, error, otherwise)

5import Development.GitRev

3import Development.GitRev

7panic :: String -> a

5panic :: String -> a

8panic msg = error panicMsg

6panic msg = error panicMsg

9 where panicMsg =

7 where panicMsg =

10− concat [ "[panic ", $(gitBranch), "@", $(gitHash)

8+ concat [ "[panic ", $(gitBranch), "@", $(gitHash), dirty, "] ", msg ]

11− , " (", $(gitCommitDate), ")"

12− , " (", $(gitCommitCount), " commits in HEAD)"

13− , dirty, "] ", msg ]

14 dirty | $(gitDirty) = " (uncommitted files present)"

9 dirty | $(gitDirty) = " (uncommitted files present)"

15 | otherwise = ""

10 | otherwise = ""

README.mddeleted−23

@@ -1,23 +0,0 @@

1−[![Build Status](https://travis-ci.org/acfoltzer/gitrev.svg?branch=master)](https://travis-ci.org/acfoltzer/gitrev)

2−

3−Some handy Template Haskell splices for including the current git hash

4−and branch in the code of your project. Useful for including in panic

5−messages, `--version` output, or diagnostic info for more informative

6−bug reports.

7−

8−Most of the complication in the `GitRev` module is due to the various

9−places the current git hash might be stored:

10−

11−1. Detached HEAD: the hash is in `.git/HEAD`

12−2. On a branch or tag: the hash is in a file pointed to by `.git/HEAD`

13−in a location like `.git/refs/heads`

14−3. On a branch or tag but in a repository with packed refs: the hash

15−is in `.git/packed-refs`

16−4. In any of the above situations, if the current repo is checked out

17−as a submodule, follow the reference to its `.git` directory first

18−

19−These files are added as dependencies to modules that use `GitRev`, and

20−so the module should be rebuilt automatically whenever these files

21−change.

22−

23−If you run into further scenarios that cause problems, let me know!

gitrev.cabal+2−6

@@ -1,5 +1,5 @@

1name: gitrev

2−version: 1.3.1

2+version: 1.0.0

3synopsis: Compile git revision info into Haskell projects

4homepage: https://github.com/acfoltzer/gitrev

5license: BSD3

@@ -9,21 +9,17 @@ maintainer: acfoltzer@galois.com

9category: Development

10build-type: Simple

11cabal-version: >=1.10

12−tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2

13−description: Some handy Template Haskell splices for including the current git hash and branch in the code of your project. Useful for including in panic messages, @--version@ output, or diagnostic info for more informative bug reports.

15source-repository head

13source-repository head

16 type: git

14 type: git

17 location: https://github.com/acfoltzer/gitrev.git

15 location: https://github.com/acfoltzer/gitrev.git

19library

17library

20− build-depends: base >= 4.6 && < 5,

18+ build-depends: base >= 4.7,

21− base-compat >= 0.6.0,

22 directory,

19 directory,

23 filepath,

20 filepath,

24 template-haskell,

21 template-haskell,

25 process

22 process

26 hs-source-dirs: src

23 hs-source-dirs: src

27− ghc-options: -Wall

28 default-language: Haskell2010

24 default-language: Haskell2010

29 exposed-modules: Development.GitRev

25 exposed-modules: Development.GitRev

src/Development/GitRev.hs+15−90

@@ -1,6 +1,3 @@

1−{-# LANGUAGE LambdaCase #-}

2−{-# LANGUAGE MultiWayIf #-}

3−

4-- |

1-- |

5-- Module : $Header$

2-- Module : $Header$

@@ -20,28 +17,18 @@

20-- > panic :: String -> a

17-- > panic :: String -> a

21-- > panic msg = error panicMsg

18-- > panic msg = error panicMsg

22-- > where panicMsg =

19-- > where panicMsg =

23−-- > concat [ "[panic ", $(gitBranch), "@", $(gitHash)

20+-- > concat [ "[panic ", $(gitBranch), "@", $(gitHash), dirty, "] ", msg ]

24−-- > , " (", $(gitCommitDate), ")"

25−-- > , " (", $(gitCommitCount), " commits in HEAD)"

26−-- > , dirty, "] ", msg ]

27-- > dirty | $(gitDirty) = " (uncommitted files present)"

21-- > dirty | $(gitDirty) = " (uncommitted files present)"

28-- > | otherwise = ""

22-- > | otherwise = ""

29-- >

23-- >

30-- > main = panic "oh no!"

24-- > main = panic "oh no!"

31--

25--

32-- > % cabal exec runhaskell Example.hs

26-- > % cabal exec runhaskell Example.hs

33−-- > Example.hs: [panic master@2ae047ba5e4a6f0f3e705a43615363ac006099c1 (Mon Jan 11 11:50:59 2016 -0800) (14 commits in HEAD) (uncommitted files present)] oh no!

27+-- > Example.hs: [panic master@4a0a592c37ad908889bd2a7a411923a903ed05a3 (uncommitted files present)] oh no!

35−module Development.GitRev

29+module Development.GitRev (gitHash, gitBranch, gitDirty) where

36− ( gitBranch

37− , gitCommitCount

38− , gitCommitDate

39− , gitDescribe

40− , gitDirty

41− , gitDirtyTracked

42− , gitHash

43− ) where

31+import Control.Applicative

45import Control.Exception

32import Control.Exception

46import Control.Monad

33import Control.Monad

47import Data.Maybe

34import Data.Maybe

@@ -52,21 +39,18 @@ import System.Exit

52import System.FilePath

39import System.FilePath

53import System.Process

40import System.Process

55−import Prelude ()

56−import Prelude.Compat

57−

58-- | Run git with the given arguments and no stdin, returning the

42-- | Run git with the given arguments and no stdin, returning the

59-- stdout output. If git isn't available or something goes wrong,

43-- stdout output. If git isn't available or something goes wrong,

60-- return the second argument.

44-- return the second argument.

61−runGit :: [String] -> String -> IndexUsed -> Q String

45+runGit :: [String] -> String -> Q String

62−runGit args def useIdx = do

46+runGit args def = do

63 let oops :: SomeException -> IO (ExitCode, String, String)

47 let oops :: SomeException -> IO (ExitCode, String, String)

64 oops _e = return (ExitFailure 1, def, "")

48 oops _e = return (ExitFailure 1, def, "")

65 gitFound <- runIO $ isJust <$> findExecutable "git"

49 gitFound <- runIO $ isJust <$> findExecutable "git"

66 if gitFound

50 if gitFound

67 then do

51 then do

68 -- a lot of bookkeeping to record the right dependencies

52 -- a lot of bookkeeping to record the right dependencies

69− pwd <- runIO getDotGit

53+ pwd <- runIO getCurrentDirectory

70 let hd = pwd </> ".git" </> "HEAD"

54 let hd = pwd </> ".git" </> "HEAD"

71 index = pwd </> ".git" </> "index"

55 index = pwd </> ".git" </> "index"

72 packedRefs = pwd </> ".git" </> "packed-refs"

56 packedRefs = pwd </> ".git" </> "packed-refs"

@@ -74,7 +58,8 @@ runGit args def useIdx = do

74 when hdExists $ do

58 when hdExists $ do

75 -- the HEAD file either contains the hash of a detached head

59 -- the HEAD file either contains the hash of a detached head

76 -- or a pointer to the file that contains the hash of the head

60 -- or a pointer to the file that contains the hash of the head

77− splitAt 5 `fmap` runIO (readFile hd) >>= \case

61+ hdRef <- runIO $ readFile hd

62+ case splitAt 5 hdRef of

78 -- pointer to ref

63 -- pointer to ref

79 ("ref: ", relRef) -> do

64 ("ref: ", relRef) -> do

80 let ref = pwd </> ".git" </> relRef

65 let ref = pwd </> ".git" </> relRef

@@ -84,7 +69,7 @@ runGit args def useIdx = do

84 _hash -> addDependentFile hd

69 _hash -> addDependentFile hd

85 -- add the index if it exists to set the dirty flag

70 -- add the index if it exists to set the dirty flag

86 indexExists <- runIO $ doesFileExist index

71 indexExists <- runIO $ doesFileExist index

87− when (indexExists && useIdx == IdxUsed) $ addDependentFile index

72+ when indexExists $ addDependentFile index

88 -- if the refs have been packed, the info we're looking for

73 -- if the refs have been packed, the info we're looking for

89 -- might be in that file rather than the one-file-per-ref case

74 -- might be in that file rather than the one-file-per-ref case

90 -- handled above

75 -- handled above

@@ -97,84 +82,24 @@ runGit args def useIdx = do

97 ExitFailure _ -> return def

82 ExitFailure _ -> return def

98 else return def

83 else return def

100−-- | Determine where our @.git@ directory is, in case we're in a

101−-- submodule.

102−getDotGit :: IO FilePath

103−getDotGit = do

104− pwd <- getGitRoot

105− let dotGit = pwd </> ".git"

106− oops = return dotGit -- it's gonna fail, that's fine

107− isDir <- doesDirectoryExist dotGit

108− isFile <- doesFileExist dotGit

109− if | isDir -> return dotGit

110− | not isFile -> oops

111− | isFile ->

112− splitAt 8 `fmap` readFile dotGit >>= \case

113− ("gitdir: ", relDir) -> do

114− isRelDir <- doesDirectoryExist relDir

115− if isRelDir

116− then return relDir

117− else oops

118− _ -> oops

119−

120−-- | Get the root directory of the Git repo.

121−getGitRoot :: IO FilePath

122−getGitRoot = do

123− pwd <- getCurrentDirectory

124− (code, out, _) <-

125− readProcessWithExitCode "git" ["rev-parse", "--show-toplevel"] ""

126− case code of

127− ExitSuccess -> return $ takeWhile (/= '\n') out

128− ExitFailure _ -> return pwd -- later steps will fail, that's fine

129−

130−-- | Type to flag if the git index is used or not in a call to runGit

131−data IndexUsed = IdxUsed -- ^ The git index is used

132− | IdxNotUsed -- ^ The git index is /not/ used

133− deriving (Eq)

134−

135-- | Return the hash of the current git commit, or @UNKNOWN@ if not in

85-- | Return the hash of the current git commit, or @UNKNOWN@ if not in

136-- a git repository

86-- a git repository

137gitHash :: ExpQ

87gitHash :: ExpQ

138gitHash =

88gitHash =

139− stringE =<< runGit ["rev-parse", "HEAD"] "UNKNOWN" IdxNotUsed

89+ stringE =<< runGit ["rev-parse", "HEAD"] "UNKNOWN"

140

141-- | Return the branch (or tag) name of the current git commit, or @UNKNOWN@

91-- | Return the branch (or tag) name of the current git commit, or @UNKNOWN@

142-- if not in a git repository. For detached heads, this will just be

92-- if not in a git repository. For detached heads, this will just be

143-- "HEAD"

93-- "HEAD"

144gitBranch :: ExpQ

94gitBranch :: ExpQ

145gitBranch =

95gitBranch =

146− stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN" IdxNotUsed

96+ stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN"

147−

148−-- | Return the long git description for the current git commit, or

149−-- @UNKNOWN@ if not in a git repository.

150−gitDescribe :: ExpQ

151−gitDescribe =

152− stringE =<< runGit ["describe", "--long", "--always"] "UNKNOWN" IdxNotUsed

153

154-- | Return @True@ if there are non-committed files present in the

98-- | Return @True@ if there are non-committed files present in the

155-- repository

99-- repository

156gitDirty :: ExpQ

100gitDirty :: ExpQ

157gitDirty = do

101gitDirty = do

158− output <- runGit ["status", "--porcelain"] "" IdxUsed

102+ output <- runGit ["status", "--porcelain"] ""

159− case output of

160− "" -> conE falseName

161− _ -> conE trueName

162−

163−-- | Return @True@ if there are non-commited changes to tracked files

164−-- present in the repository

165−gitDirtyTracked :: ExpQ

166−gitDirtyTracked = do

167− output <- runGit ["status", "--porcelain","--untracked-files=no"] "" IdxUsed

168 case output of

103 case output of

169− "" -> conE falseName

104+ "" -> conE $ mkName "Prelude.False"

170− _ -> conE trueName

105+ _ -> conE $ mkName "Prelude.True"

171−

172−-- | Return the number of commits in the current head

173−gitCommitCount :: ExpQ

174−gitCommitCount =

175− stringE =<< runGit ["rev-list", "HEAD", "--count"] "UNKNOWN" IdxNotUsed

176−

177−-- | Return the commit date of the current head

178−gitCommitDate :: ExpQ

179−gitCommitDate =

180− stringE =<< runGit ["log", "HEAD", "-1", "--format=%cd"] "UNKNOWN" IdxNotUsed