gitrev 1.2.0 → 1.3.1

raw patch · 2 files changed

Files

• gitrev.cabal +4/−1
• src/Development/GitRev.hs +62/−5

@@ -1,5 +1,5 @@ name:                gitrev-version:             1.2.0+version:             1.3.1 synopsis:            Compile git revision info into Haskell projects homepage:            https://github.com/acfoltzer/gitrev license:             BSD3@@ -9,6 +9,7 @@ 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 @@  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

@@ -1,3 +1,6 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+ -- | -- Module      :  $Header$ -- Copyright   :  (c) 2015 Adam C. Foltzer@@ -29,9 +32,16 @@ -- > % cabal exec runhaskell Example.hs -- > Example.hs: [panic master@2ae047ba5e4a6f0f3e705a43615363ac006099c1 (Mon Jan 11 11:50:59 2016 -0800) (14 commits in HEAD) (uncommitted files present)] oh no! -module Development.GitRev (gitHash, gitBranch, gitDirty, gitCommitCount, gitCommitDate) where+module Development.GitRev+  ( gitBranch+  , gitCommitCount+  , gitCommitDate+  , gitDescribe+  , gitDirty+  , gitDirtyTracked+  , gitHash+  ) where -import Control.Applicative import Control.Exception import Control.Monad import Data.Maybe@@ -42,6 +52,9 @@ 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,7 +66,7 @@   if gitFound     then do       -- a lot of bookkeeping to record the right dependencies-      pwd <- runIO getCurrentDirectory+      pwd <- runIO getDotGit       let hd         = pwd </> ".git" </> "HEAD"           index      = pwd </> ".git" </> "index"           packedRefs = pwd </> ".git" </> "packed-refs"@@ -61,8 +74,7 @@       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 +97,36 @@           ExitFailure _ -> return def     else return def +-- | Determine where our @.git@ directory is, in case we're in a+-- submodule.+getDotGit :: IO FilePath+getDotGit = do+  pwd <- getGitRoot+  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++-- | Get the root directory of the Git repo.+getGitRoot :: IO FilePath+getGitRoot = do+  pwd <- getCurrentDirectory+  (code, out, _) <-+    readProcessWithExitCode "git" ["rev-parse", "--show-toplevel"] ""+  case code of+    ExitSuccess   -> return $ takeWhile (/= '\n') out+    ExitFailure _ -> return pwd -- later steps will fail, that's fine+ -- | 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@@ -103,11 +145,26 @@ gitBranch =   stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN" IdxNotUsed +-- | Return the long git description for the current git commit, or+-- @UNKNOWN@ if not in a git repository.+gitDescribe :: ExpQ+gitDescribe =+  stringE =<< runGit ["describe", "--long", "--always"] "UNKNOWN" IdxNotUsed+ -- | Return @True@ if there are non-committed files present in the -- repository gitDirty :: ExpQ gitDirty = do   output <- runGit ["status", "--porcelain"] "" IdxUsed+  case output of+    "" -> conE falseName+    _  -> conE trueName++-- | Return @True@ if there are non-commited changes to tracked files+-- present in the repository+gitDirtyTracked :: ExpQ+gitDirtyTracked = do+  output <- runGit ["status", "--porcelain","--untracked-files=no"] "" IdxUsed   case output of     "" -> conE falseName     _  -> conE trueName