@@ -32,7 +32,15 @@
3232-- > % cabal exec runhaskell Example.hs
3333-- > Example.hs: [panic master@2ae047ba5e4a6f0f3e705a43615363ac006099c1 (Mon Jan 11 11:50:59 2016 -0800) (14 commits in HEAD) (uncommitted files present)] oh no!
3434
35−module Development.GitRev (gitHash, gitBranch, gitDirty, gitCommitCount, gitCommitDate) where
35+module Development.GitRev
36+ ( gitBranch
37+ , gitCommitCount
38+ , gitCommitDate
39+ , gitDescribe
40+ , gitDirty
41+ , gitDirtyTracked
42+ , gitHash
43+ ) where
3644
3745import Control.Exception
3846import Control.Monad
@@ -58,7 +66,7 @@ runGit args def useIdx = do
5866 if gitFound
5967 then do
6068 -- a lot of bookkeeping to record the right dependencies
61− pwd <- runIO getGitDirectory
69+ pwd <- runIO getDotGit
6270 let hd = pwd </> ".git" </> "HEAD"
6371 index = pwd </> ".git" </> "index"
6472 packedRefs = pwd </> ".git" </> "packed-refs"
@@ -89,11 +97,11 @@ runGit args def useIdx = do
8997 ExitFailure _ -> return def
9098 else return def
9199
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
93101-- submodule.
94−getGitDirectory :: IO FilePath
95−getGitDirectory = do
96− pwd <- getCurrentDirectory
102+getDotGit :: IO FilePath
103+getDotGit = do
104+ pwd <- getGitRoot
97105 let dotGit = pwd </> ".git"
98106 oops = return dotGit -- it's gonna fail, that's fine
99107 isDir <- doesDirectoryExist dotGit
@@ -109,6 +117,16 @@ getGitDirectory = do
109117 else oops
110118 _ -> oops
111119
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+
112130-- | Type to flag if the git index is used or not in a call to runGit
113131data IndexUsed = IdxUsed -- ^ The git index is used
114132 | IdxNotUsed -- ^ The git index is /not/ used
@@ -127,6 +145,12 @@ gitBranch :: ExpQ
127145gitBranch =
128146 stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN" IdxNotUsed
129147
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+
130154-- | Return @True@ if there are non-committed files present in the
131155-- repository
132156gitDirty :: ExpQ
@@ -136,6 +160,15 @@ gitDirty = do
136160 "" -> conE falseName
137161 _ -> conE trueName
138162
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+
139172-- | Return the number of commits in the current head
140173gitCommitCount :: ExpQ
141174gitCommitCount =