808943b · typeable/gitrev

git.iko.soy/typeable/gitrev

on master help sign in

support git repos checked out as submodules

808943bAdam C. Foltzer10 years ago

README.md+5−5

compare with master

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 is

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

15−in `.git/packed-refs`

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

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

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

18so the module should be rebuilt automatically whenever these files

20so the module should be rebuilt automatically whenever these files

19change.

21change.

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

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

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

23−you run into them!

gitrev.cabal+3

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

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.

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.

14source-repository head

15source-repository head

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

18library

19library

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

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

21+ base-compat >= 0.6.0,

20 directory,

22 directory,

21 filepath,

23 filepath,

22 template-haskell,

24 template-haskell,

23 process

25 process

24 hs-source-dirs: src

26 hs-source-dirs: src

27+ ghc-options: -Wall

25 default-language: Haskell2010

28 default-language: Haskell2010

26 exposed-modules: Development.GitRev

29 exposed-modules: Development.GitRev

src/Development/GitRev.hs+28−4

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

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE MultiWayIf #-}

1-- |

4-- |

2-- Module : $Header$

5-- Module : $Header$

@@ -31,7 +34,6 @@

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

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

34−import Control.Applicative

35import Control.Exception

37import Control.Exception

36import Control.Monad

38import Control.Monad

37import Data.Maybe

39import Data.Maybe

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

42import System.FilePath

44import System.FilePath

43import System.Process

45import System.Process

47+import Prelude ()

48+import Prelude.Compat

49+

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

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

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

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

47-- return the second argument.

52-- return the second argument.

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

53 if gitFound

58 if gitFound

54 then do

59 then do

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

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

56− pwd <- runIO getCurrentDirectory

61+ pwd <- runIO getGitDirectory

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

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

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

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

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

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

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

61 when hdExists $ do

66 when hdExists $ do

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

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

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

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

64− hdRef <- runIO $ readFile hd

69+ splitAt 5 `fmap` runIO (readFile hd) >>= \case

65− case splitAt 5 hdRef of

66 -- pointer to ref

70 -- pointer to ref

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

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

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

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

@@ -85,6 +89,26 @@ runGit args def useIdx = do

85 ExitFailure _ -> return def

89 ExitFailure _ -> return def

86 else return def

90 else return def

92+-- | Determine where our git directory is, in case we're in a

93+-- submodule.

94+getGitDirectory :: IO FilePath

95+getGitDirectory = do

96+ pwd <- getCurrentDirectory

97+ let dotGit = pwd </> ".git"

98+ oops = return dotGit -- it's gonna fail, that's fine

99+ isDir <- doesDirectoryExist dotGit

100+ isFile <- doesFileExist dotGit

101+ if | isDir -> return dotGit

102+ | not isFile -> oops

103+ | isFile ->

104+ splitAt 8 `fmap` readFile dotGit >>= \case

105+ ("gitdir: ", relDir) -> do

106+ isRelDir <- doesDirectoryExist relDir

107+ if isRelDir

108+ then return relDir

109+ else oops

110+ _ -> oops

111+

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

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

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

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

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

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