@@ -1,6 +1,3 @@
1−{-# LANGUAGE LambdaCase #-}
2−{-# LANGUAGE MultiWayIf #-}
3−
41-- |
52-- Module : $Header$
63-- Copyright : (c) 2015 Adam C. Foltzer
@@ -32,16 +29,9 @@
3229-- > % cabal exec runhaskell Example.hs
3330-- > Example.hs: [panic master@2ae047ba5e4a6f0f3e705a43615363ac006099c1 (Mon Jan 11 11:50:59 2016 -0800) (14 commits in HEAD) (uncommitted files present)] oh no!
3431
35−module Development.GitRev
36− ( gitBranch
37− , gitCommitCount
38− , gitCommitDate
39− , gitDescribe
40− , gitDirty
41− , gitDirtyTracked
42− , gitHash
43− ) where
32+module Development.GitRev (gitHash, gitBranch, gitDirty, gitCommitCount, gitCommitDate) where
4433
34+import Control.Applicative
4535import Control.Exception
4636import Control.Monad
4737import Data.Maybe
@@ -52,9 +42,6 @@ import System.Exit
5242import System.FilePath
5343import System.Process
5444
55−import Prelude ()
56−import Prelude.Compat
57−
5845-- | Run git with the given arguments and no stdin, returning the
5946-- stdout output. If git isn't available or something goes wrong,
6047-- return the second argument.
@@ -66,7 +53,7 @@ runGit args def useIdx = do
6653 if gitFound
6754 then do
6855 -- a lot of bookkeeping to record the right dependencies
69− pwd <- runIO getDotGit
56+ pwd <- runIO getCurrentDirectory
7057 let hd = pwd </> ".git" </> "HEAD"
7158 index = pwd </> ".git" </> "index"
7259 packedRefs = pwd </> ".git" </> "packed-refs"
@@ -74,7 +61,8 @@ runGit args def useIdx = do
7461 when hdExists $ do
7562 -- the HEAD file either contains the hash of a detached head
7663 -- or a pointer to the file that contains the hash of the head
77− splitAt 5 `fmap` runIO (readFile hd) >>= \case
64+ hdRef <- runIO $ readFile hd
65+ case splitAt 5 hdRef of
7866 -- pointer to ref
7967 ("ref: ", relRef) -> do
8068 let ref = pwd </> ".git" </> relRef
@@ -97,36 +85,6 @@ runGit args def useIdx = do
9785 ExitFailure _ -> return def
9886 else return def
9987
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−
13088-- | Type to flag if the git index is used or not in a call to runGit
13189data IndexUsed = IdxUsed -- ^ The git index is used
13290 | IdxNotUsed -- ^ The git index is /not/ used
@@ -145,12 +103,6 @@ gitBranch :: ExpQ
145103gitBranch =
146104 stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN" IdxNotUsed
147105
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−
154106-- | Return @True@ if there are non-committed files present in the
155107-- repository
156108gitDirty :: ExpQ
@@ -160,15 +112,6 @@ gitDirty = do
160112 "" -> conE falseName
161113 _ -> conE trueName
162114
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−
172115-- | Return the number of commits in the current head
173116gitCommitCount :: ExpQ
174117gitCommitCount =