Add Handler.BuildVersion

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

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")
+                        ]
+    )

config/routes

@@ -54,3 +54,4 @@
 /older-releases OlderReleasesR GET
 
 /refresh-deprecated RefreshDeprecatedR GET
+/build-version BuildVersionR GET

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