support git repos checked out as submodules

Fixes acfoltzer#13

Author: Adam C. Foltzer

README.md

@@ -11,13 +11,13 @@ places the current git hash might be stored:
 1. Detached HEAD: the hash is in `.git/HEAD`
 2. On a branch or tag: the hash is in a file pointed to by `.git/HEAD`
 in a location like `.git/refs/heads`
-3. On a branch or tag but in a repository with packed refs: the hash is
-in `.git/packed-refs`
+3. On a branch or tag but in a repository with packed refs: the hash
+is in `.git/packed-refs`
+4. In any of the above situations, if the current repo is checked out
+as a submodule, follow the reference to its `.git` directory first
 
 These files are added as dependencies to modules that use `GitRev`, and
 so the module should be rebuilt automatically whenever these files
 change.
 
-These situations all arise under normal development workflows, but
-there might be further scenarios that cause problems. Let me know if
-you run into them!
+If you run into further scenarios that cause problems, let me know!

gitrev.cabal

@@ -9,6 +9,7 @@ maintainer:          [email protected]
 category:            Development
 build-type:          Simple
 cabal-version:       >=1.10
+tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2
 description:         Some handy Template Haskell splices for including the current git hash and branch in the code of your project. Useful for including in panic messages, @--version@ output, or diagnostic info for more informative bug reports.
 
 source-repository head
@@ -17,10 +18,12 @@ source-repository head
 
 library
   build-depends:       base >= 4.6 && < 5,
+                       base-compat >= 0.6.0,
                        directory,
                        filepath,
                        template-haskell,
                        process
   hs-source-dirs:      src
+  ghc-options:         -Wall
   default-language:    Haskell2010
   exposed-modules:     Development.GitRev

src/Development/GitRev.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+
 -- |
 -- Module      :  $Header$
 -- Copyright   :  (c) 2015 Adam C. Foltzer
@@ -31,7 +34,6 @@
 
 module Development.GitRev (gitHash, gitBranch, gitDirty, gitCommitCount, gitCommitDate) where
 
-import Control.Applicative
 import Control.Exception
 import Control.Monad
 import Data.Maybe
@@ -42,6 +44,9 @@ import System.Exit
 import System.FilePath
 import System.Process
 
+import Prelude ()
+import Prelude.Compat
+
 -- | Run git with the given arguments and no stdin, returning the
 -- stdout output. If git isn't available or something goes wrong,
 -- return the second argument.
@@ -53,16 +58,15 @@ runGit args def useIdx = do
   if gitFound
     then do
       -- a lot of bookkeeping to record the right dependencies
-      pwd <- runIO getCurrentDirectory
+      pwd <- runIO getGitDirectory
       let hd         = pwd </> ".git" </> "HEAD"
           index      = pwd </> ".git" </> "index"
           packedRefs = pwd </> ".git" </> "packed-refs"
       hdExists  <- runIO $ doesFileExist hd
       when hdExists $ do
         -- the HEAD file either contains the hash of a detached head
         -- or a pointer to the file that contains the hash of the head
-        hdRef <- runIO $ readFile hd
-        case splitAt 5 hdRef of
+        splitAt 5 `fmap` runIO (readFile hd) >>= \case
           -- pointer to ref
           ("ref: ", relRef) -> do
             let ref = pwd </> ".git" </> relRef
@@ -85,6 +89,26 @@ runGit args def useIdx = do
           ExitFailure _ -> return def
     else return def
 
+-- | Determine where our git directory is, in case we're in a
+-- submodule.
+getGitDirectory :: IO FilePath
+getGitDirectory = do
+  pwd <- getCurrentDirectory
+  let dotGit = pwd </> ".git"
+      oops = return dotGit -- it's gonna fail, that's fine
+  isDir <- doesDirectoryExist dotGit
+  isFile <- doesFileExist dotGit
+  if | isDir -> return dotGit
+     | not isFile -> oops
+     | isFile ->
+         splitAt 8 `fmap` readFile dotGit >>= \case
+           ("gitdir: ", relDir) -> do
+             isRelDir <- doesDirectoryExist relDir
+             if isRelDir
+               then return relDir
+               else oops
+           _ -> oops
+
 -- | Type to flag if the git index is used or not in a call to runGit
 data IndexUsed = IdxUsed -- ^ The git index is used
                | IdxNotUsed -- ^ The git index is /not/ used