switch to TH solution for GitRev

This helps with #18 and should also reduce the number of unnecessary
recompiles that were triggered by the Makefile and/or cabal. The cabal
build type is now Simple.

Most of the complication in the TH.hs module is due to the various
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`

These situations all arise under normal development workflows and on the
Jenkins build machines, but there might be further scenarios that cause
problems. The tradeoff seems worthwhile though as now projects that
build Cryptol as a dependency wind up having to rebuild Cryptol far less
frequently.

Makefile

@@ -96,14 +96,23 @@ ${CS_BIN}/alex: | ${CS}
 ${CS_BIN}/happy: | ${CS} ${CS_BIN}/alex
 	$(CABAL_INSTALL) happy
 
+GIT_INFO_FILES :=
+ifneq ("$(wildcard .git/index)","")
+GIT_INFO_FILES := ${GIT_INFO_FILES} .git/index
+endif
+ifneq ("$(wildcard .git/HEAD)","")
+GIT_INFO_FILES := ${GIT_INFO_FILES} .git/HEAD
+endif
+ifneq ("$(wildcard .git/packed-refs)","")
+GIT_INFO_FILES := ${GIT_INFO_FILES} .git/packed-refs
+endif
+
 CRYPTOL_SRC := \
   $(shell find src cryptol \
             \( -name \*.hs -or -name \*.x -or -name \*.y \) \
             -and \( -not -name \*\#\* \) -print) \
-  $(shell find lib -name \*.cry)
+  $(shell find lib -name \*.cry) \
-
+  ${GIT_INFO_FILES}
-src/GitRev.hs:
-	sh configure
 
 print-%:
 	@echo $* = $($*)
@@ -131,7 +140,7 @@ dist/setup-config: cryptol.cabal Makefile | ${CS_BIN}/alex ${CS_BIN}/happy
 	$(CABAL) configure ${PREFIX_ARG} --datasubdir=cryptol \
           ${CONFIGURE_ARGS}
 
-${CRYPTOL_EXE}: $(CRYPTOL_SRC) src/GitRev.hs dist/setup-config
+${CRYPTOL_EXE}: $(CRYPTOL_SRC) dist/setup-config
 	$(CABAL_BUILD)
 
 

configure

@@ -1,32 +0,0 @@
-#!/bin/sh
-
-has_git=`which git 2>/dev/null`
-if test -d .git -a -n "$has_git"; then
-    HASH=`git rev-parse HEAD`
-    BRANCH=`git rev-parse --abbrev-ref HEAD`
-
-    # Checks if there are any lines in git status
-    if test -z "`git status --porcelain`"; then
-        DIRTY=False
-    else
-        DIRTY=True
-    fi
-else
-    HASH="UNKNOWN"
-    BRANCH="UNKNOWN"
-    # well, we're not building from any git...
-    DIRTY="False"
-fi
-
-cat > src/GitRev.hs <<EOF
-module GitRev (hash, branch, dirty) where
-
-hash :: String
-hash = "$HASH"
-
-branch :: String
-branch = "$BRANCH"
-
-dirty :: Bool
-dirty = $DIRTY
-EOF

cryptol.cabal

@@ -10,15 +10,12 @@ Homepage:            http://www.cryptol.net/
 Bug-reports:         https://github.com/GaloisInc/cryptol/issues
 Copyright:           2013-2015 Galois Inc.
 Category:            Language
-Build-type:          Configure
+Build-type:          Simple
 Cabal-version:       >= 1.18
 
 data-files:          *.cry
 data-dir:            lib
 
-extra-source-files:  configure
-extra-tmp-files:     src/GitRev.hs
-
 source-repository head
   type:     git
   location: https://github.com/GaloisInc/cryptol.git
@@ -62,6 +59,7 @@ library
                        smtLib          >= 1.0.7,
                        syb             >= 0.4,
                        text            >= 1.1,
+                       template-haskell,
                        tf-random       >= 0.5,
                        transformers    >= 0.3,
                        utf8-string     >= 0.3
@@ -150,7 +148,8 @@ library
                        Cryptol.Parser.ParserUtils,
                        Cryptol.Prelude,
                        Paths_cryptol,
-                       GitRev
+                       GitRev,
+                       GitRev.TH
 
   GHC-options:         -Wall -O2
   ghc-prof-options: -fprof-auto -prof

src/.gitignore

@@ -1 +0,0 @@
-GitRev.hs

src/GitRev.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE Trustworthy #-}
+
+module GitRev (hash, branch, dirty) where
+
+import GitRev.TH
+
+hash :: String
+hash = $(getHash)
+
+branch :: String
+branch = $(getBranch)
+
+dirty :: Bool
+dirty = $(getDirty)

src/GitRev/TH.hs

@@ -0,0 +1,65 @@
+module GitRev.TH where
+
+import Control.Applicative
+import Control.Exception
+import Control.Monad
+import Data.Maybe
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import System.Directory
+import System.FilePath
+import System.Process
+
+-- | 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.
+runGit :: [String] -> String -> Q String
+runGit args def = do
+  let oops :: SomeException -> IO String
+      oops _e = return def
+  gitFound <- runIO $ isJust <$> findExecutable "git"
+  if gitFound
+    then do
+      -- a lot of bookkeeping to record the right dependencies
+      pwd <- runIO $ getCurrentDirectory
+      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
+          -- pointer to ref
+          ("ref: ", relRef) -> do
+            let ref = pwd </> ".git" </> relRef
+            refExists <- runIO $ doesFileExist ref
+            when refExists $ addDependentFile ref
+          -- detached head
+          _hash -> addDependentFile hd
+      -- add the index if it exists to set the dirty flag
+      indexExists <- runIO $ doesFileExist index
+      when indexExists $ addDependentFile index
+      -- if the refs have been packed, the info we're looking for
+      -- might be in that file rather than the one-file-per-ref case
+      -- handled above
+      packedExists <- runIO $ doesFileExist packedRefs
+      when packedExists $ addDependentFile packedRefs
+      runIO $ (takeWhile (/= '\n') <$> readProcess "git" args "") `catch` oops
+    else return def
+
+getHash :: ExpQ
+getHash =
+  stringE =<< runGit ["rev-parse", "HEAD"] "UNKNOWN"
+
+getBranch :: ExpQ
+getBranch =
+  stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN"
+
+getDirty :: ExpQ
+getDirty = do
+  output <- runGit ["status", "--porcelain"] ""
+  case output of
+    "" -> conE $ mkName "Prelude.False"
+    _  -> conE $ mkName "Prelude.True"