@@ -1,3 +1,6 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE MultiWayIf #-}
3+
14-- |
25-- Module : $Header$
36-- Copyright : (c) 2015 Adam C. Foltzer
@@ -29,9 +32,16 @@
2932-- > % cabal exec runhaskell Example.hs
3033-- > Example.hs: [panic master@2ae047ba5e4a6f0f3e705a43615363ac006099c1 (Mon Jan 11 11:50:59 2016 -0800) (14 commits in HEAD) (uncommitted files present)] oh no!
3134
32−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
3344
34−import Control.Applicative
3545import Control.Exception
3646import Control.Monad
3747import Data.Maybe
@@ -42,6 +52,9 @@ import System.Exit
4252import System.FilePath
4353import System.Process
4454
55+import Prelude ()
56+import Prelude.Compat
57+
4558-- | Run git with the given arguments and no stdin, returning the
4659-- stdout output. If git isn't available or something goes wrong,
4760-- return the second argument.
@@ -53,7 +66,7 @@ runGit args def useIdx = do
5366 if gitFound
5467 then do
5568 -- a lot of bookkeeping to record the right dependencies
56− pwd <- runIO getCurrentDirectory
69+ pwd <- runIO getDotGit
5770 let hd = pwd </> ".git" </> "HEAD"
5871 index = pwd </> ".git" </> "index"
5972 packedRefs = pwd </> ".git" </> "packed-refs"
@@ -61,8 +74,7 @@ runGit args def useIdx = do
6174 when hdExists $ do
6275 -- the HEAD file either contains the hash of a detached head
6376 -- or a pointer to the file that contains the hash of the head
64− hdRef <- runIO $ readFile hd
65− case splitAt 5 hdRef of
77+ splitAt 5 `fmap` runIO (readFile hd) >>= \case
6678 -- pointer to ref
6779 ("ref: ", relRef) -> do
6880 let ref = pwd </> ".git" </> relRef
@@ -85,6 +97,36 @@ runGit args def useIdx = do
8597 ExitFailure _ -> return def
8698 else return def
8799
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+
88130-- | Type to flag if the git index is used or not in a call to runGit
89131data IndexUsed = IdxUsed -- ^ The git index is used
90132 | IdxNotUsed -- ^ The git index is /not/ used
@@ -103,6 +145,12 @@ gitBranch :: ExpQ
103145gitBranch =
104146 stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN" IdxNotUsed
105147
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+
106154-- | Return @True@ if there are non-committed files present in the
107155-- repository
108156gitDirty :: ExpQ
@@ -112,6 +160,15 @@ gitDirty = do
112160 "" -> conE falseName
113161 _ -> conE trueName
114162
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+
115172-- | Return the number of commits in the current head
116173gitCommitCount :: ExpQ
117174gitCommitCount =