master..9145019 · typeable/gitrev

git.iko.soy/typeable/gitrev

on 9145019 help sign in

README.md+5−5

since splitsnapshots

unifiedsplit

@@ -11,13 +11,13 @@ places the current git hash might be stored:

111. Detached HEAD: the hash is in `.git/HEAD`

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

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

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

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

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

15+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

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

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

20so the module should be rebuilt automatically whenever these files

18so the module should be rebuilt automatically whenever these files

21change.

19change.

21+These situations all arise under normal development workflows, but

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

22+there might be further scenarios that cause problems. Let me know if

23+you run into them!

gitrev.cabal+1−4

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

1name: gitrev

2−version: 1.3.1

2+version: 1.2.0

3synopsis: Compile git revision info into Haskell projects

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

5license: BSD3

@@ -9,7 +9,6 @@ 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

13description: 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.

12description: 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

14source-repository head

@@ -18,12 +17,10 @@ source-repository head

19library

18library

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

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

21− base-compat >= 0.6.0,

22 directory,

20 directory,

23 filepath,

21 filepath,

24 template-haskell,

22 template-haskell,

25 process

23 process

26 hs-source-dirs: src

24 hs-source-dirs: src

27− ghc-options: -Wall

28 default-language: Haskell2010

25 default-language: Haskell2010

29 exposed-modules: Development.GitRev

26 exposed-modules: Development.GitRev

src/Development/GitRev.hs+5−62

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

1−{-# LANGUAGE LambdaCase #-}

2−{-# LANGUAGE MultiWayIf #-}

3−

4-- |

1-- |

5-- Module : $Header$

2-- Module : $Header$

@@ -32,16 +29,9 @@

32-- > % cabal exec runhaskell Example.hs

29-- > % 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!

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

35−module Development.GitRev

32+module Development.GitRev (gitHash, gitBranch, gitDirty, gitCommitCount, gitCommitDate) where

36− ( gitBranch

37− , gitCommitCount

38− , gitCommitDate

39− , gitDescribe

40− , gitDirty

41− , gitDirtyTracked

42− , gitHash

43− ) where

34+import Control.Applicative

45import Control.Exception

35import Control.Exception

46import Control.Monad

36import Control.Monad

47import Data.Maybe

37import Data.Maybe

@@ -52,9 +42,6 @@ import System.Exit

52import System.FilePath

42import System.FilePath

53import System.Process

43import System.Process

55−import Prelude ()

56−import Prelude.Compat

57−

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

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

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

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

60-- return the second argument.

47-- return the second argument.

@@ -66,7 +53,7 @@ runGit args def useIdx = do

66 if gitFound

53 if gitFound

67 then do

54 then do

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

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

69− pwd <- runIO getDotGit

56+ pwd <- runIO getCurrentDirectory

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

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

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

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

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

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

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

74 when hdExists $ do

61 when hdExists $ do

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

62 -- 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

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

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

64+ hdRef <- runIO $ readFile hd

65+ case splitAt 5 hdRef of

78 -- pointer to ref

66 -- pointer to ref

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

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

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

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

@@ -97,36 +85,6 @@ runGit args def useIdx = do

97 ExitFailure _ -> return def

85 ExitFailure _ -> return def

98 else return def

86 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

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

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

89data IndexUsed = IdxUsed -- ^ The git index is used

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

90 | IdxNotUsed -- ^ The git index is /not/ used

@@ -145,12 +103,6 @@ gitBranch :: ExpQ

145gitBranch =

103gitBranch =

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

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

147

105

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

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

155-- repository

107-- repository

156gitDirty :: ExpQ

108gitDirty :: ExpQ

@@ -160,15 +112,6 @@ gitDirty = do

160 "" -> conE falseName

112 "" -> conE falseName

161 _ -> conE trueName

113 _ -> conE trueName

162

114

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

169− "" -> conE falseName

170− _ -> conE trueName

171−

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

115-- | Return the number of commits in the current head

173gitCommitCount :: ExpQ

116gitCommitCount :: ExpQ

174gitCommitCount =

117gitCommitCount =