@@ -1,6 +1,3 @@
1−{-# LANGUAGE LambdaCase #-}
2−{-# LANGUAGE MultiWayIf #-}
3−
41-- |
52-- Module : $Header$
63-- Copyright : (c) 2015 Adam C. Foltzer
@@ -21,7 +18,6 @@
2118-- > panic msg = error panicMsg
2219-- > where panicMsg =
2320-- > concat [ "[panic ", $(gitBranch), "@", $(gitHash)
24−-- > , " (", $(gitCommitDate), ")"
2521-- > , " (", $(gitCommitCount), " commits in HEAD)"
2622-- > , dirty, "] ", msg ]
2723-- > dirty | $(gitDirty) = " (uncommitted files present)"
@@ -30,18 +26,11 @@
3026-- > main = panic "oh no!"
3127--
3228-- > % 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!
29+-- > Example.hs: [panic master@2702e69355c978805064543489c351b61ac6760b (6 commits in HEAD) (uncommitted files present)] oh no!
3430
35−module Development.GitRev
36− ( gitBranch
37− , gitCommitCount
38− , gitCommitDate
39− , gitDescribe
40− , gitDirty
41− , gitDirtyTracked
42− , gitHash
43− ) where
31+module Development.GitRev (gitHash, gitBranch, gitDirty, gitCommitCount) where
4432
33+import Control.Applicative
4534import Control.Exception
4635import Control.Monad
4736import Data.Maybe
@@ -52,9 +41,6 @@ import System.Exit
5241import System.FilePath
5342import System.Process
5443
55−import Prelude ()
56−import Prelude.Compat
57−
5844-- | Run git with the given arguments and no stdin, returning the
5945-- stdout output. If git isn't available or something goes wrong,
6046-- return the second argument.
@@ -66,7 +52,7 @@ runGit args def useIdx = do
6652 if gitFound
6753 then do
6854 -- a lot of bookkeeping to record the right dependencies
69− pwd <- runIO getDotGit
55+ pwd <- runIO getCurrentDirectory
7056 let hd = pwd </> ".git" </> "HEAD"
7157 index = pwd </> ".git" </> "index"
7258 packedRefs = pwd </> ".git" </> "packed-refs"
@@ -74,7 +60,8 @@ runGit args def useIdx = do
7460 when hdExists $ do
7561 -- the HEAD file either contains the hash of a detached head
7662 -- or a pointer to the file that contains the hash of the head
77− splitAt 5 `fmap` runIO (readFile hd) >>= \case
63+ hdRef <- runIO $ readFile hd
64+ case splitAt 5 hdRef of
7865 -- pointer to ref
7966 ("ref: ", relRef) -> do
8067 let ref = pwd </> ".git" </> relRef
@@ -97,36 +84,6 @@ runGit args def useIdx = do
9784 ExitFailure _ -> return def
9885 else return def
9986
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−
13087-- | Type to flag if the git index is used or not in a call to runGit
13188data IndexUsed = IdxUsed -- ^ The git index is used
13289 | IdxNotUsed -- ^ The git index is /not/ used
@@ -145,36 +102,16 @@ gitBranch :: ExpQ
145102gitBranch =
146103 stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN" IdxNotUsed
147104
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−
154105-- | Return @True@ if there are non-committed files present in the
155106-- repository
156107gitDirty :: ExpQ
157108gitDirty = do
158109 output <- runGit ["status", "--porcelain"] "" IdxUsed
159110 case output of
160− "" -> conE falseName
161− _ -> conE trueName
162−
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
111+ "" -> conE $ mkName "Prelude.False"
112+ _ -> conE $ mkName "Prelude.True"
171113
172114-- | Return the number of commits in the current head
173115gitCommitCount :: ExpQ
174116gitCommitCount =
175117 stringE =<< runGit ["rev-list", "HEAD", "--count"] "UNKNOWN" IdxNotUsed
176−
177−-- | Return the commit date of the current head
178−gitCommitDate :: ExpQ
179−gitCommitDate =
180− stringE =<< runGit ["log", "HEAD", "-1", "--format=%cd"] "UNKNOWN" IdxNotUsed