gitrev (empty) → 1.0.0

raw patch · 4 files changed

+161/−0 lines, 4 filesdep +basedep +directorydep +filepathsetup-changed

Dependencies added: base, directory, filepath, process, template-haskell

Files

LICENSE +28/−0
Setup.hs +2/−0
gitrev.cabal +26/−0
src/Development/GitRev.hs +105/−0

+ LICENSE view

@@ -0,0 +1,28 @@+Copyright (c) 2015, Adam C. Foltzer+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++* Neither the name of gitrev nor the names of its+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ gitrev.cabal view

@@ -0,0 +1,26 @@+name:                gitrev+version:             1.0.0+synopsis:            Compile git revision info into Haskell projects+homepage:            https://github.com/acfoltzer/gitrev+license:             BSD3+license-file:        LICENSE+author:              Adam C. Foltzer+maintainer:          acfoltzer@galois.com+category:            Development+build-type:          Simple+cabal-version:       >=1.10+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+  type:     git+  location: https://github.com/acfoltzer/gitrev.git++library+  build-depends:       base >= 4.7 && < 5,+                       directory,+                       filepath,+                       template-haskell,+                       process+  hs-source-dirs:      src+  default-language:    Haskell2010+  exposed-modules:     Development.GitRev

+ src/Development/GitRev.hs view

@@ -0,0 +1,105 @@+-- |+-- Module      :  $Header$+-- Copyright   :  (c) 2015 Adam C. Foltzer+-- License     :  BSD3+-- Maintainer  :  acfoltzer@galois.com+-- Stability   :  provisional+-- Portability :  portable+--+-- 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.+--+-- > {-# LANGUAGE TemplateHaskell #-}+-- > import Development.GitRev+-- >+-- > panic :: String -> a+-- > panic msg = error panicMsg+-- >   where panicMsg =+-- >           concat [ "[panic ", $(gitBranch), "@", $(gitHash), dirty, "] ", msg ]+-- >         dirty | $(gitDirty) = " (uncommitted files present)"+-- >               | otherwise   = ""+-- >+-- > main = panic "oh no!"+--+-- > % cabal exec runhaskell Example.hs+-- > Example.hs: [panic master@4a0a592c37ad908889bd2a7a411923a903ed05a3 (uncommitted files present)] oh no!++module Development.GitRev (gitHash, gitBranch, gitDirty) 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.Exit+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 (ExitCode, String, String)+      oops _e = return (ExitFailure 1, 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 $ do+        (code, out, _err) <- readProcessWithExitCode "git" args "" `catch` oops+        case code of+          ExitSuccess   -> return (takeWhile (/= '\n') out)+          ExitFailure _ -> return def+    else return def++-- | Return the hash of the current git commit, or @UNKNOWN@ if not in+-- a git repository+gitHash :: ExpQ+gitHash =+  stringE =<< runGit ["rev-parse", "HEAD"] "UNKNOWN"++-- | Return the branch (or tag) name of the current git commit, or @UNKNOWN@+-- if not in a git repository. For detached heads, this will just be+-- "HEAD"+gitBranch :: ExpQ+gitBranch =+  stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN"++-- | Return @True@ if there are non-committed files present in the+-- repository+gitDirty :: ExpQ+gitDirty = do+  output <- runGit ["status", "--porcelain"] ""+  case output of+    "" -> conE $ mkName "Prelude.False"+    _  -> conE $ mkName "Prelude.True"