@@ -32,7 +32,15 @@
32-- > % cabal exec runhaskell Example.hs
32-- > % 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!
33-- > 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 (gitHash, gitBranch, gitDirty, gitDirtyTracked, gitCommitCount, gitCommitDate) where
35+module Development.GitRev
37import Control.Exception
45import Control.Exception
38import Control.Monad
46import Control.Monad
@@ -58,7 +66,7 @@ runGit args def useIdx = do
58 if gitFound
66 if gitFound
60 -- a lot of bookkeeping to record the right dependencies
68 -- a lot of bookkeeping to record the right dependencies
61− pwd <- runIO getGitDirectory
69+ pwd <- runIO getDotGit
62 let hd = pwd </> ".git" </> "HEAD"
70 let hd = pwd </> ".git" </> "HEAD"
63 index = pwd </> ".git" </> "index"
71 index = pwd </> ".git" </> "index"
64 packedRefs = pwd </> ".git" </> "packed-refs"
72 packedRefs = pwd </> ".git" </> "packed-refs"
@@ -89,11 +97,11 @@ runGit args def useIdx = do
89 ExitFailure _ -> return def
97 ExitFailure _ -> return def
90 else return def
98 else return def
92−-- | Determine where our git directory is, in case we're in a
100+-- | Determine where our @.git@ directory is, in case we're in a
93-- submodule.
101-- submodule.
94−getGitDirectory :: IO FilePath
102+getDotGit :: IO FilePath
95−getGitDirectory = do
103+getDotGit = do
96− pwd <- getCurrentDirectory
104+ pwd <- getGitRoot
97 let dotGit = pwd </> ".git"
105 let dotGit = pwd </> ".git"
98 oops = return dotGit -- it's gonna fail, that's fine
106 oops = return dotGit -- it's gonna fail, that's fine
99 isDir <- doesDirectoryExist dotGit
107 isDir <- doesDirectoryExist dotGit
@@ -109,6 +117,16 @@ getGitDirectory = do
109 else oops
117 else oops
110 _ -> oops
118 _ -> oops
120+-- | Get the root directory of the Git repo.
121+getGitRoot :: IO FilePath
123+ pwd <- getCurrentDirectory
125+ readProcessWithExitCode "git" ["rev-parse", "--show-toplevel"] ""
127+ ExitSuccess -> return $ takeWhile (/= '\n') out
128+ ExitFailure _ -> return pwd -- later steps will fail, that's fine
112-- | Type to flag if the git index is used or not in a call to runGit
130-- | Type to flag if the git index is used or not in a call to runGit
113data IndexUsed = IdxUsed -- ^ The git index is used
131data IndexUsed = IdxUsed -- ^ The git index is used
114 | IdxNotUsed -- ^ The git index is /not/ used
132 | IdxNotUsed -- ^ The git index is /not/ used
@@ -127,6 +145,12 @@ gitBranch :: ExpQ
127gitBranch =
145gitBranch =
128 stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN" IdxNotUsed
146 stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN" IdxNotUsed
148+-- | Return the long git description for the current git commit, or
149+-- @UNKNOWN@ if not in a git repository.
152+ stringE =<< runGit ["describe", "--long", "--always"] "UNKNOWN" IdxNotUsed
130-- | Return @True@ if there are non-committed files present in the
154-- | Return @True@ if there are non-committed files present in the
131-- repository
155-- repository
132gitDirty :: ExpQ
156gitDirty :: ExpQ