├── .gitignore ├── .travis.yml ├── Example.hs ├── LICENSE ├── README.md ├── Setup.hs ├── gitrev.cabal └── src └── Development └── GitRev.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | .virtualenv 8 | .hsenv 9 | .cabal-sandbox/ 10 | cabal.sandbox.config 11 | cabal.config 12 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This file has been generated -- see https://github.com/hvr/multi-ghc-travis 2 | language: c 3 | sudo: false 4 | 5 | cache: 6 | directories: 7 | - $HOME/.cabsnap 8 | - $HOME/.cabal/packages 9 | 10 | before_cache: 11 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log 12 | - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar 13 | 14 | matrix: 15 | include: 16 | - env: CABALVER=1.16 GHCVER=7.6.3 17 | compiler: ": #GHC 7.6.3" 18 | addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}} 19 | - env: CABALVER=1.18 GHCVER=7.8.4 20 | compiler: ": #GHC 7.8.4" 21 | addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} 22 | - env: CABALVER=1.22 GHCVER=7.10.3 23 | compiler: ": #GHC 7.10.3" 24 | addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} 25 | - env: CABALVER=1.24 GHCVER=8.0.2 26 | compiler: ": #GHC 8.0.2" 27 | addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2], sources: [hvr-ghc]}} 28 | 29 | before_install: 30 | - unset CC 31 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH 32 | 33 | install: 34 | - cabal --version 35 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" 36 | - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; 37 | then 38 | zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > 39 | $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; 40 | fi 41 | - travis_retry cabal update -v 42 | - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config 43 | - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt 44 | - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt 45 | 46 | # check whether current requested install-plan matches cached package-db snapshot 47 | - if diff -u $HOME/.cabsnap/installplan.txt installplan.txt; 48 | then 49 | echo "cabal build-cache HIT"; 50 | rm -rfv .ghc; 51 | cp -a $HOME/.cabsnap/ghc $HOME/.ghc; 52 | cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; 53 | else 54 | echo "cabal build-cache MISS"; 55 | rm -rf $HOME/.cabsnap; 56 | mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; 57 | cabal install --only-dependencies --enable-tests --enable-benchmarks; 58 | fi 59 | 60 | # snapshot package-db on cache miss 61 | - if [ ! -d $HOME/.cabsnap ]; 62 | then 63 | echo "snapshotting package-db to build-cache"; 64 | mkdir $HOME/.cabsnap; 65 | cp -a $HOME/.ghc $HOME/.cabsnap/ghc; 66 | cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; 67 | fi 68 | 69 | # Here starts the actual work to be performed for the package under test; 70 | # any command which exits with a non-zero exit code causes the build to fail. 71 | script: 72 | - if [ -f configure.ac ]; then autoreconf -i; fi 73 | - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging 74 | - cabal build # this builds all libraries and executables (including tests/benchmarks) 75 | - cabal test 76 | - cabal check 77 | - cabal sdist # tests that a source-distribution can be generated 78 | 79 | # Check that the resulting source distribution can be built & installed. 80 | # If there are no other `.tar.gz` files in `dist`, this can be even simpler: 81 | # `cabal install --force-reinstalls dist/*-*.tar.gz` 82 | - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && 83 | (cd dist && cabal install --force-reinstalls "$SRC_TGZ") 84 | 85 | # EOF 86 | -------------------------------------------------------------------------------- /Example.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoImplicitPrelude #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | module Example where 4 | import Prelude (String, concat, error, otherwise) 5 | import Development.GitRev 6 | 7 | panic :: String -> a 8 | panic msg = error panicMsg 9 | where panicMsg = 10 | concat [ "[panic ", $(gitBranch), "@", $(gitHash) 11 | , " (", $(gitCommitDate), ")" 12 | , " (", $(gitCommitCount), " commits in HEAD)" 13 | , dirty, "] ", msg ] 14 | dirty | $(gitDirty) = " (uncommitted files present)" 15 | | otherwise = "" 16 | 17 | main = panic "oh no!" 18 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2015, Adam C. Foltzer 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | * Neither the name of gitrev nor the names of its 15 | contributors may be used to endorse or promote products derived from 16 | this software without specific prior written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 19 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 20 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 22 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 23 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 24 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 25 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 26 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 27 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Unmaintained project 2 | 3 | This repository is no longer maintained. Please consider forking if 4 | further development is required. 5 | 6 | [![Build Status](https://travis-ci.org/acfoltzer/gitrev.svg?branch=master)](https://travis-ci.org/acfoltzer/gitrev) 7 | 8 | Some handy Template Haskell splices for including the current git hash 9 | and branch in the code of your project. Useful for including in panic 10 | messages, `--version` output, or diagnostic info for more informative 11 | bug reports. 12 | 13 | Most of the complication in the `GitRev` module is due to the various 14 | places the current git hash might be stored: 15 | 16 | 1. Detached HEAD: the hash is in `.git/HEAD` 17 | 2. On a branch or tag: the hash is in a file pointed to by `.git/HEAD` 18 | in a location like `.git/refs/heads` 19 | 3. On a branch or tag but in a repository with packed refs: the hash 20 | is in `.git/packed-refs` 21 | 4. In any of the above situations, if the current repo is checked out 22 | as a submodule, follow the reference to its `.git` directory first 23 | 24 | These files are added as dependencies to modules that use `GitRev`, and 25 | so the module should be rebuilt automatically whenever these files 26 | change. 27 | 28 | If you run into further scenarios that cause problems, let me know! 29 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /gitrev.cabal: -------------------------------------------------------------------------------- 1 | name: gitrev 2 | version: 1.3.1 3 | synopsis: Compile git revision info into Haskell projects 4 | homepage: https://github.com/acfoltzer/gitrev 5 | license: BSD3 6 | license-file: LICENSE 7 | author: Adam C. Foltzer 8 | maintainer: acfoltzer@galois.com 9 | category: Development 10 | build-type: Simple 11 | cabal-version: >=1.10 12 | tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2 13 | 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. 14 | 15 | source-repository head 16 | type: git 17 | location: https://github.com/acfoltzer/gitrev.git 18 | 19 | library 20 | build-depends: base >= 4.6 && < 5, 21 | base-compat >= 0.6.0, 22 | directory, 23 | filepath, 24 | template-haskell, 25 | process 26 | hs-source-dirs: src 27 | ghc-options: -Wall 28 | default-language: Haskell2010 29 | exposed-modules: Development.GitRev -------------------------------------------------------------------------------- /src/Development/GitRev.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE MultiWayIf #-} 3 | 4 | -- | 5 | -- Module : $Header$ 6 | -- Copyright : (c) 2015 Adam C. Foltzer 7 | -- License : BSD3 8 | -- Maintainer : acfoltzer@galois.com 9 | -- Stability : provisional 10 | -- Portability : portable 11 | -- 12 | -- Some handy Template Haskell splices for including the current git 13 | -- hash and branch in the code of your project. Useful for including 14 | -- in panic messages, @--version@ output, or diagnostic info for more 15 | -- informative bug reports. 16 | -- 17 | -- > {-# LANGUAGE TemplateHaskell #-} 18 | -- > import Development.GitRev 19 | -- > 20 | -- > panic :: String -> a 21 | -- > panic msg = error panicMsg 22 | -- > where panicMsg = 23 | -- > concat [ "[panic ", $(gitBranch), "@", $(gitHash) 24 | -- > , " (", $(gitCommitDate), ")" 25 | -- > , " (", $(gitCommitCount), " commits in HEAD)" 26 | -- > , dirty, "] ", msg ] 27 | -- > dirty | $(gitDirty) = " (uncommitted files present)" 28 | -- > | otherwise = "" 29 | -- > 30 | -- > main = panic "oh no!" 31 | -- 32 | -- > % cabal exec runhaskell Example.hs 33 | -- > Example.hs: [panic master@2ae047ba5e4a6f0f3e705a43615363ac006099c1 (Mon Jan 11 11:50:59 2016 -0800) (14 commits in HEAD) (uncommitted files present)] oh no! 34 | 35 | module Development.GitRev 36 | ( gitBranch 37 | , gitCommitCount 38 | , gitCommitDate 39 | , gitDescribe 40 | , gitDirty 41 | , gitDirtyTracked 42 | , gitHash 43 | ) where 44 | 45 | import Control.Exception 46 | import Control.Monad 47 | import Data.Maybe 48 | import Language.Haskell.TH 49 | import Language.Haskell.TH.Syntax 50 | import System.Directory 51 | import System.Exit 52 | import System.FilePath 53 | import System.Process 54 | 55 | import Prelude () 56 | import Prelude.Compat 57 | 58 | -- | Run git with the given arguments and no stdin, returning the 59 | -- stdout output. If git isn't available or something goes wrong, 60 | -- return the second argument. 61 | runGit :: [String] -> String -> IndexUsed -> Q String 62 | runGit args def useIdx = do 63 | let oops :: SomeException -> IO (ExitCode, String, String) 64 | oops _e = return (ExitFailure 1, def, "") 65 | gitFound <- runIO $ isJust <$> findExecutable "git" 66 | if gitFound 67 | then do 68 | -- a lot of bookkeeping to record the right dependencies 69 | pwd <- runIO getDotGit 70 | let hd = pwd "HEAD" 71 | index = pwd "index" 72 | packedRefs = pwd "packed-refs" 73 | hdExists <- runIO $ doesFileExist hd 74 | when hdExists $ do 75 | addDependentFile hd 76 | -- the HEAD file either contains the hash of a detached head 77 | -- or a pointer to the file that contains the hash of the head 78 | splitAt 5 `fmap` runIO (readFile hd) >>= \case 79 | -- pointer to ref 80 | ("ref: ", relRef) -> do 81 | let ref = pwd tillNewLine relRef 82 | refExists <- runIO $ doesFileExist ref 83 | when refExists $ addDependentFile ref 84 | -- detached head 85 | _hash -> return () 86 | -- add the index if it exists to set the dirty flag 87 | indexExists <- runIO $ doesFileExist index 88 | when (indexExists && useIdx == IdxUsed) $ addDependentFile index 89 | -- if the refs have been packed, the info we're looking for 90 | -- might be in that file rather than the one-file-per-ref case 91 | -- handled above 92 | packedExists <- runIO $ doesFileExist packedRefs 93 | when packedExists $ addDependentFile packedRefs 94 | runIO $ do 95 | (code, out, _err) <- readProcessWithExitCode "git" args "" `catch` oops 96 | case code of 97 | ExitSuccess -> return (tillNewLine out) 98 | ExitFailure _ -> return def 99 | else return def 100 | 101 | tillNewLine :: String -> String 102 | tillNewLine = takeWhile (\c -> c /= '\n' && c /= '\r') 103 | 104 | -- | Determine where our @.git@ directory is, in case we're in a 105 | -- submodule. 106 | getDotGit :: IO FilePath 107 | getDotGit = do 108 | pwd <- getGitRoot 109 | let dotGit = pwd ".git" 110 | oops = return dotGit -- it's gonna fail, that's fine 111 | isDir <- doesDirectoryExist dotGit 112 | isFile <- doesFileExist dotGit 113 | if | isDir -> return dotGit 114 | | not isFile -> oops 115 | | isFile -> 116 | splitAt 8 `fmap` readFile dotGit >>= \case 117 | ("gitdir: ", relDir) -> do 118 | isRelDir <- doesDirectoryExist relDir 119 | if isRelDir 120 | then return relDir 121 | else oops 122 | _ -> oops 123 | 124 | -- | Get the root directory of the Git repo. 125 | getGitRoot :: IO FilePath 126 | getGitRoot = do 127 | pwd <- getCurrentDirectory 128 | (code, out, _) <- 129 | readProcessWithExitCode "git" ["rev-parse", "--show-toplevel"] "" 130 | case code of 131 | ExitSuccess -> return $ tillNewLine out 132 | ExitFailure _ -> return pwd -- later steps will fail, that's fine 133 | 134 | -- | Type to flag if the git index is used or not in a call to runGit 135 | data IndexUsed = IdxUsed -- ^ The git index is used 136 | | IdxNotUsed -- ^ The git index is /not/ used 137 | deriving (Eq) 138 | 139 | -- | Return the hash of the current git commit, or @UNKNOWN@ if not in 140 | -- a git repository 141 | gitHash :: ExpQ 142 | gitHash = 143 | stringE =<< runGit ["rev-parse", "HEAD"] "UNKNOWN" IdxNotUsed 144 | 145 | -- | Return the branch (or tag) name of the current git commit, or @UNKNOWN@ 146 | -- if not in a git repository. For detached heads, this will just be 147 | -- "HEAD" 148 | gitBranch :: ExpQ 149 | gitBranch = 150 | stringE =<< runGit ["rev-parse", "--abbrev-ref", "HEAD"] "UNKNOWN" IdxNotUsed 151 | 152 | -- | Return the long git description for the current git commit, or 153 | -- @UNKNOWN@ if not in a git repository. 154 | gitDescribe :: ExpQ 155 | gitDescribe = 156 | stringE =<< runGit ["describe", "--long", "--always"] "UNKNOWN" IdxNotUsed 157 | 158 | -- | Return @True@ if there are non-committed files present in the 159 | -- repository 160 | gitDirty :: ExpQ 161 | gitDirty = do 162 | output <- runGit ["status", "--porcelain"] "" IdxUsed 163 | case output of 164 | "" -> conE falseName 165 | _ -> conE trueName 166 | 167 | -- | Return @True@ if there are non-commited changes to tracked files 168 | -- present in the repository 169 | gitDirtyTracked :: ExpQ 170 | gitDirtyTracked = do 171 | output <- runGit ["status", "--porcelain","--untracked-files=no"] "" IdxUsed 172 | case output of 173 | "" -> conE falseName 174 | _ -> conE trueName 175 | 176 | -- | Return the number of commits in the current head 177 | gitCommitCount :: ExpQ 178 | gitCommitCount = 179 | stringE =<< runGit ["rev-list", "HEAD", "--count"] "UNKNOWN" IdxNotUsed 180 | 181 | -- | Return the commit date of the current head 182 | gitCommitDate :: ExpQ 183 | gitCommitDate = 184 | stringE =<< runGit ["log", "HEAD", "-1", "--format=%cd"] "UNKNOWN" IdxNotUsed 185 | --------------------------------------------------------------------------------