@@ -1,3 +1,6 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE MultiWayIf #-}
3+
14-- |
25-- Module : $Header$
36-- Copyright : (c) 2015 Adam C. Foltzer
@@ -31,7 +34,6 @@
3134
3235module Development.GitRev (gitHash, gitBranch, gitDirty, gitCommitCount, gitCommitDate) where
3336
34−import Control.Applicative
3537import Control.Exception
3638import Control.Monad
3739import Data.Maybe
@@ -42,6 +44,9 @@ import System.Exit
4244import System.FilePath
4345import System.Process
4446
47+import Prelude ()
48+import Prelude.Compat
49+
4550-- | Run git with the given arguments and no stdin, returning the
4651-- stdout output. If git isn't available or something goes wrong,
4752-- return the second argument.
@@ -53,7 +58,7 @@ runGit args def useIdx = do
5358 if gitFound
5459 then do
5560 -- a lot of bookkeeping to record the right dependencies
56− pwd <- runIO getCurrentDirectory
61+ pwd <- runIO getGitDirectory
5762 let hd = pwd </> ".git" </> "HEAD"
5863 index = pwd </> ".git" </> "index"
5964 packedRefs = pwd </> ".git" </> "packed-refs"
@@ -61,8 +66,7 @@ runGit args def useIdx = do
6166 when hdExists $ do
6267 -- the HEAD file either contains the hash of a detached head
6368 -- or a pointer to the file that contains the hash of the head
64− hdRef <- runIO $ readFile hd
65− case splitAt 5 hdRef of
69+ splitAt 5 `fmap` runIO (readFile hd) >>= \case
6670 -- pointer to ref
6771 ("ref: ", relRef) -> do
6872 let ref = pwd </> ".git" </> relRef
@@ -85,6 +89,26 @@ runGit args def useIdx = do
8589 ExitFailure _ -> return def
8690 else return def
8791
92+-- | Determine where our git directory is, in case we're in a
93+-- submodule.
94+getGitDirectory :: IO FilePath
95+getGitDirectory = do
96+ pwd <- getCurrentDirectory
97+ let dotGit = pwd </> ".git"
98+ oops = return dotGit -- it's gonna fail, that's fine
99+ isDir <- doesDirectoryExist dotGit
100+ isFile <- doesFileExist dotGit
101+ if | isDir -> return dotGit
102+ | not isFile -> oops
103+ | isFile ->
104+ splitAt 8 `fmap` readFile dotGit >>= \case
105+ ("gitdir: ", relDir) -> do
106+ isRelDir <- doesDirectoryExist relDir
107+ if isRelDir
108+ then return relDir
109+ else oops
110+ _ -> oops
111+
88112-- | Type to flag if the git index is used or not in a call to runGit
89113data IndexUsed = IdxUsed -- ^ The git index is used
90114 | IdxNotUsed -- ^ The git index is /not/ used