From 2f0b328614bccf19db457fcf46ff919198aa30a2 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 6 Jan 2015 10:10:47 +0200
Subject: [PATCH] Add Handler.BuildVersion

---
 Application.hs          |  1 +
 Handler/BuildVersion.hs | 29 +++++++++++++++++++++++++++++
 config/routes           |  1 +
 stackage-server.cabal   |  1 +
 4 files changed, 32 insertions(+)
 create mode 100644 Handler/BuildVersion.hs

diff --git a/Application.hs b/Application.hs
index b589c06..70ec6a5 100644
--- a/Application.hs
+++ b/Application.hs
@@ -70,6 +70,7 @@ import           Handler.Tag
 import           Handler.BannedTags
 import           Handler.RefreshDeprecated
 import           Handler.Hoogle
+import           Handler.BuildVersion
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
diff --git a/Handler/BuildVersion.hs b/Handler/BuildVersion.hs
new file mode 100644
index 0000000..9e302a8
--- /dev/null
+++ b/Handler/BuildVersion.hs
@@ -0,0 +1,29 @@
+module Handler.BuildVersion where
+
+import Import hiding (lift)
+import Language.Haskell.TH.Syntax
+import System.Process (rawSystem)
+import System.Exit
+
+getBuildVersionR :: Handler Text
+getBuildVersionR = return $ pack $(do
+    let headFile = ".git/HEAD"
+    qAddDependentFile headFile
+    ehead <- qRunIO $ tryIO $ readFile $ fpFromString headFile
+    case decodeUtf8 <$> ehead of
+        Left e -> lift $ ".git/HEAD not read: " ++ show e
+        Right raw ->
+            case takeWhile (/= '\n') <$> stripPrefix "ref: " raw of
+                Nothing -> lift $ ".git/HEAD not in expected format: " ++ show raw
+                Just fp' -> do
+                    let fp = ".git" </> fpFromText fp'
+                    qAddDependentFile $ fpToString fp
+                    bs <- qRunIO $ readFile fp
+                    isDirty <- qRunIO
+                             $ (/= ExitSuccess)
+                           <$> rawSystem "git" ["diff-files", "--quiet"]
+                    lift $ unpack $ unlines
+                        [ "Most recent commit: " ++ asText (decodeUtf8 bs)
+                        , "Working tree is " ++ (if isDirty then "dirty" else "clean")
+                        ]
+    )
diff --git a/config/routes b/config/routes
index fbb6d36..41a1980 100644
--- a/config/routes
+++ b/config/routes
@@ -54,3 +54,4 @@
 /older-releases OlderReleasesR GET
 
 /refresh-deprecated RefreshDeprecatedR GET
+/build-version BuildVersionR GET
diff --git a/stackage-server.cabal b/stackage-server.cabal
index 90b0714..269ff8c 100644
--- a/stackage-server.cabal
+++ b/stackage-server.cabal
@@ -53,6 +53,7 @@ library
                      Handler.Tag
                      Handler.BannedTags
                      Handler.RefreshDeprecated
+                     Handler.BuildVersion
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT