{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module      :  $Header$
-- Copyright   :  (c) 2018 Michael Snoyman, 2015 Adam C. Foltzer
-- License     :  BSD3
-- Maintainer  :  michael@snoyman.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 GitHash
-- >
-- > panic :: String -> a
-- > panic msg = error panicMsg
-- >   where panicMsg =
-- >           concat [ "[panic ", giBranch gi, "@", giHash gi
-- >                  , " (", giCommitDate gi, ")"
-- >                  , " (", show (giCommitCount gi), " commits in HEAD)"
-- >                  , dirty, "] ", msg ]
-- >         dirty | giDirty gi = " (uncommitted files present)"
-- >               | otherwise   = ""
-- >         gi = $$tGitInfoCwd
-- >
-- > main = panic "oh no!"
--
-- > % stack runghc Example.hs
-- > Example.hs: [panic master@2ae047ba5e4a6f0f3e705a43615363ac006099c1 (Mon Jan 11 11:50:59 2016 -0800) (14 commits in HEAD) (uncommitted files present)] oh no!
--
-- WARNING: None of this will work in a git repository without any commits.
--
-- @since 0.1.0.0
module GitHash
  ( -- * Types
    GitInfo
  , GitHashException (..)
    -- ** Getters
  , giHash
  , giBranch
  , giDirty
  , giCommitDate
  , giCommitCount
  , giCommitMessage
  , giDescribe
  , giTag
    -- * Creators
  , getGitInfo
  , getGitRoot
    -- * Template Haskell
  , tGitInfo
  , tGitInfoCwd
  , tGitInfoTry
  , tGitInfoCwdTry
  ) where

import Control.Exception
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.Typeable (Typeable)
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Syntax.Compat
import System.Directory
import System.Exit
import System.FilePath
import System.IO.Error (isDoesNotExistError)
import System.Process
import Text.Read (readMaybe)

-- | Various pieces of information about a Git repository.
--
-- @since 0.1.0.0
data GitInfo = GitInfo
  { GitInfo -> String
_giHash :: !String
  , GitInfo -> String
_giBranch :: !String
  , GitInfo -> Bool
_giDirty :: !Bool
  , GitInfo -> String
_giCommitDate :: !String
  , GitInfo -> Int
_giCommitCount :: !Int
  , GitInfo -> [String]
_giFiles :: ![FilePath]
  , GitInfo -> String
_giCommitMessage :: !String
  , GitInfo -> String
_giDescribe :: !String
  , GitInfo -> String
_giTag :: !String
  }
  deriving (GitInfo -> Q Exp
GitInfo -> Q (TExp GitInfo)
(GitInfo -> Q Exp) -> (GitInfo -> Q (TExp GitInfo)) -> Lift GitInfo
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: GitInfo -> Q (TExp GitInfo)
$cliftTyped :: GitInfo -> Q (TExp GitInfo)
lift :: GitInfo -> Q Exp
$clift :: GitInfo -> Q Exp
Lift, Int -> GitInfo -> ShowS
[GitInfo] -> ShowS
GitInfo -> String
(Int -> GitInfo -> ShowS)
-> (GitInfo -> String) -> ([GitInfo] -> ShowS) -> Show GitInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitInfo] -> ShowS
$cshowList :: [GitInfo] -> ShowS
show :: GitInfo -> String
$cshow :: GitInfo -> String
showsPrec :: Int -> GitInfo -> ShowS
$cshowsPrec :: Int -> GitInfo -> ShowS
Show)

-- | The hash of the most recent commit.
--
-- @since 0.1.0.0
giHash :: GitInfo -> String
giHash :: GitInfo -> String
giHash = GitInfo -> String
_giHash

-- | The hash of the most recent commit.
--
-- @since 0.1.0.0
giBranch :: GitInfo -> String
giBranch :: GitInfo -> String
giBranch = GitInfo -> String
_giBranch

giDirty :: GitInfo -> Bool
giDirty :: GitInfo -> Bool
giDirty = GitInfo -> Bool
_giDirty

giCommitDate :: GitInfo -> String
giCommitDate :: GitInfo -> String
giCommitDate = GitInfo -> String
_giCommitDate

giCommitCount :: GitInfo -> Int
giCommitCount :: GitInfo -> Int
giCommitCount = GitInfo -> Int
_giCommitCount

-- | The message of the most recent commit.
--
-- @since 0.1.1.0
giCommitMessage :: GitInfo -> String
giCommitMessage :: GitInfo -> String
giCommitMessage = GitInfo -> String
_giCommitMessage

-- | The output of @git describe --always@ for the most recent commit.
--
-- @since 0.1.4.0
giDescribe :: GitInfo -> String
giDescribe :: GitInfo -> String
giDescribe = GitInfo -> String
_giDescribe

-- | The output of @git describe --always --tags@ for the most recent commit.
--
-- @since 0.1.5.0
giTag :: GitInfo -> String
giTag :: GitInfo -> String
giTag = GitInfo -> String
_giTag

-- | Get a list of files from within a @.git@ directory.
getGitFilesRegular :: FilePath -> IO [FilePath]
getGitFilesRegular :: String -> IO [String]
getGitFilesRegular String
git = do
  -- a lot of bookkeeping to record the right dependencies
  let hd :: String
hd         = String
git String -> ShowS
</> String
"HEAD"
      index :: String
index      = String
git String -> ShowS
</> String
"index"
      packedRefs :: String
packedRefs = String
git String -> ShowS
</> String
"packed-refs"
  Either IOError ByteString
ehdRef <- IO ByteString -> IO (Either IOError ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either IOError ByteString))
-> IO ByteString -> IO (Either IOError ByteString)
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
B.readFile String
hd
  [String]
files1 <-
    case Either IOError ByteString
ehdRef of
      Left IOError
e
        | IOError -> Bool
isDoesNotExistError IOError
e -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        | Bool
otherwise -> GitHashException -> IO [String]
forall e a. Exception e => e -> IO a
throwIO (GitHashException -> IO [String])
-> GitHashException -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> IOError -> GitHashException
GHECouldn'tReadFile String
hd IOError
e
      Right ByteString
hdRef -> 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
        case Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
5 ByteString
hdRef of
          -- pointer to ref
          (ByteString
"ref: ", ByteString
relRef) -> do
            let ref :: String
ref = String
git String -> ShowS
</> ByteString -> String
B8.unpack ByteString
relRef
            Bool
refExists <- String -> IO Bool
doesFileExist String
ref
            [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ if Bool
refExists then [String
ref] else []
          -- detached head
          (ByteString, ByteString)
_hash -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
hd]
  -- add the index if it exists to set the dirty flag
  Bool
indexExists <- String -> IO Bool
doesFileExist String
index
  let files2 :: [String]
files2 = if Bool
indexExists then [String
index] else []
  -- 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
  Bool
packedExists <- String -> IO Bool
doesFileExist String
packedRefs
  let files3 :: [String]
files3 = if Bool
packedExists then [String
packedRefs] else []

  [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]
files1, [String]
files2, [String]
files3]

-- | Get a list of dependent files from a @.git@ file representing a
-- git-worktree.
getGitFilesForWorktree :: FilePath -> IO [FilePath]
getGitFilesForWorktree :: String -> IO [String]
getGitFilesForWorktree String
git = do
  Either IOError ByteString
gitPath <- IO ByteString -> IO (Either IOError ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either IOError ByteString))
-> IO ByteString -> IO (Either IOError ByteString)
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
B.readFile String
git
  case Either IOError ByteString
gitPath of
    Left IOError
e
      | Bool
otherwise -> GitHashException -> IO [String]
forall e a. Exception e => e -> IO a
throwIO (GitHashException -> IO [String])
-> GitHashException -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> IOError -> GitHashException
GHECouldn'tReadFile String
git IOError
e
    Right ByteString
rootPath ->
      -- the .git file contains the absolute path to the git
      -- directory's root.
      case Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
8 ByteString
rootPath of
        -- path to root
        (ByteString
"gitdir: ", ByteString
gitdir) -> do
          let path :: String
path = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') (ByteString -> String
B8.unpack ByteString
gitdir)
          -- The .git file points to a .git directory which we can just
          -- treat like a non git-worktree one.
          String -> IO [String]
getGitFilesRegular String
path
        (ByteString, ByteString)
_ -> GitHashException -> IO [String]
forall e a. Exception e => e -> IO a
throwIO (GitHashException -> IO [String])
-> GitHashException -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> GitHashException
GHEInvalidGitFile (ByteString -> String
B8.unpack ByteString
rootPath)


-- | Get a list of dependent git related files.
getGitFiles :: FilePath -> IO [FilePath]
getGitFiles :: String -> IO [String]
getGitFiles String
git = do
  Bool
isDir <- String -> IO Bool
doesDirectoryExist String
git
  if Bool
isDir then String -> IO [String]
getGitFilesRegular String
git else String -> IO [String]
getGitFilesForWorktree String
git

-- | Get the 'GitInfo' for the given root directory. Root directory
-- should be the directory containing the @.git@ directory.
--
-- @since 0.1.0.0
getGitInfo :: FilePath -> IO (Either GitHashException GitInfo)
getGitInfo :: String -> IO (Either GitHashException GitInfo)
getGitInfo String
root = IO GitInfo -> IO (Either GitHashException GitInfo)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO GitInfo -> IO (Either GitHashException GitInfo))
-> IO GitInfo -> IO (Either GitHashException GitInfo)
forall a b. (a -> b) -> a -> b
$ do
  let run :: [String] -> IO String
run [String]
args = do
        Either GitHashException String
eres <- String -> [String] -> IO (Either GitHashException String)
runGit String
root [String]
args
        case Either GitHashException String
eres of
          Left GitHashException
e -> GitHashException -> IO String
forall e a. Exception e => e -> IO a
throwIO GitHashException
e
          Right String
str -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
str

  [String]
_giFiles <- String -> IO [String]
getGitFiles (String
root String -> ShowS
</> String
".git")
  String
_giHash <- [String] -> IO String
run [String
"rev-parse", String
"HEAD"]
  String
_giBranch <- [String] -> IO String
run [String
"rev-parse", String
"--abbrev-ref", String
"HEAD"]

  String
dirtyString <- [String] -> IO String
run [String
"status", String
"--porcelain"]
  let _giDirty :: Bool
_giDirty = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String
dirtyString :: String)

  String
commitCount <- [String] -> IO String
run [String
"rev-list", String
"HEAD", String
"--count"]
  Int
_giCommitCount <-
    case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
commitCount of
      Maybe Int
Nothing -> GitHashException -> IO Int
forall e a. Exception e => e -> IO a
throwIO (GitHashException -> IO Int) -> GitHashException -> IO Int
forall a b. (a -> b) -> a -> b
$ String -> String -> GitHashException
GHEInvalidCommitCount String
root String
commitCount
      Just Int
x -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
x

  String
_giCommitDate <- [String] -> IO String
run [String
"log", String
"HEAD", String
"-1", String
"--format=%cd"]

  String
_giCommitMessage <- [String] -> IO String
run [String
"log", String
"-1", String
"--pretty=%B"]

  String
_giDescribe <- [String] -> IO String
run [String
"describe", String
"--always", String
"--long"]

  String
_giTag <- [String] -> IO String
run [String
"describe", String
"--always", String
"--tags"]

  GitInfo -> IO GitInfo
forall (m :: * -> *) a. Monad m => a -> m a
return GitInfo :: String
-> String
-> Bool
-> String
-> Int
-> [String]
-> String
-> String
-> String
-> GitInfo
GitInfo {Bool
Int
String
[String]
_giTag :: String
_giDescribe :: String
_giCommitMessage :: String
_giCommitDate :: String
_giCommitCount :: Int
_giDirty :: Bool
_giBranch :: String
_giHash :: String
_giFiles :: [String]
_giTag :: String
_giDescribe :: String
_giCommitMessage :: String
_giFiles :: [String]
_giCommitCount :: Int
_giCommitDate :: String
_giDirty :: Bool
_giBranch :: String
_giHash :: String
..}

-- | Get the root directory of the Git repo containing the given file
-- path.
--
-- @since 0.1.0.0
getGitRoot :: FilePath -> IO (Either GitHashException FilePath)
getGitRoot :: String -> IO (Either GitHashException String)
getGitRoot String
dir = ShowS
-> Either GitHashException String -> Either GitHashException String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS
normalise ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')) (Either GitHashException String -> Either GitHashException String)
-> IO (Either GitHashException String)
-> IO (Either GitHashException String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (String -> [String] -> IO (Either GitHashException String)
runGit String
dir [String
"rev-parse", String
"--show-toplevel"])

runGit :: FilePath -> [String] -> IO (Either GitHashException String)
runGit :: String -> [String] -> IO (Either GitHashException String)
runGit String
root [String]
args = do
  let cp :: CreateProcess
cp = (String -> [String] -> CreateProcess
proc String
"git" [String]
args) { cwd :: Maybe String
cwd = String -> Maybe String
forall a. a -> Maybe a
Just String
root }
  Either IOError (ExitCode, String, String)
eres <- IO (ExitCode, String, String)
-> IO (Either IOError (ExitCode, String, String))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (ExitCode, String, String)
 -> IO (Either IOError (ExitCode, String, String)))
-> IO (ExitCode, String, String)
-> IO (Either IOError (ExitCode, String, String))
forall a b. (a -> b) -> a -> b
$ CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode CreateProcess
cp String
""
  Either GitHashException String
-> IO (Either GitHashException String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either GitHashException String
 -> IO (Either GitHashException String))
-> Either GitHashException String
-> IO (Either GitHashException String)
forall a b. (a -> b) -> a -> b
$ case Either IOError (ExitCode, String, String)
eres of
    Left IOError
e -> GitHashException -> Either GitHashException String
forall a b. a -> Either a b
Left (GitHashException -> Either GitHashException String)
-> GitHashException -> Either GitHashException String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> IOError -> GitHashException
GHEGitRunException String
root [String]
args IOError
e
    Right (ExitCode
ExitSuccess, String
out, String
_) -> String -> Either GitHashException String
forall a b. b -> Either a b
Right String
out
    Right (ec :: ExitCode
ec@ExitFailure{}, String
out, String
err) -> GitHashException -> Either GitHashException String
forall a b. a -> Either a b
Left (GitHashException -> Either GitHashException String)
-> GitHashException -> Either GitHashException String
forall a b. (a -> b) -> a -> b
$ String
-> [String] -> ExitCode -> String -> String -> GitHashException
GHEGitRunFailed String
root [String]
args ExitCode
ec String
out String
err

-- | Exceptions which can occur when using this library's functions.
--
-- @since 0.1.0.0
data GitHashException
  = GHECouldn'tReadFile !FilePath !IOException
  | GHEInvalidCommitCount !FilePath !String
  | GHEInvalidGitFile !String
  | GHEGitRunFailed !FilePath ![String] !ExitCode !String !String
  | GHEGitRunException !FilePath ![String] !IOException
  deriving (Int -> GitHashException -> ShowS
[GitHashException] -> ShowS
GitHashException -> String
(Int -> GitHashException -> ShowS)
-> (GitHashException -> String)
-> ([GitHashException] -> ShowS)
-> Show GitHashException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitHashException] -> ShowS
$cshowList :: [GitHashException] -> ShowS
show :: GitHashException -> String
$cshow :: GitHashException -> String
showsPrec :: Int -> GitHashException -> ShowS
$cshowsPrec :: Int -> GitHashException -> ShowS
Show, GitHashException -> GitHashException -> Bool
(GitHashException -> GitHashException -> Bool)
-> (GitHashException -> GitHashException -> Bool)
-> Eq GitHashException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitHashException -> GitHashException -> Bool
$c/= :: GitHashException -> GitHashException -> Bool
== :: GitHashException -> GitHashException -> Bool
$c== :: GitHashException -> GitHashException -> Bool
Eq, Typeable)
instance Exception GitHashException

-- | Load up the 'GitInfo' value at compile time for the given
-- directory. Compilation fails if no info is available.
--
-- @since 0.1.0.0
tGitInfo :: FilePath -> SpliceQ GitInfo
tGitInfo :: String -> Q (TExp GitInfo)
tGitInfo String
fp = Q Exp -> Q (TExp GitInfo)
forall a (m :: * -> *). Quote m => m Exp -> Splice m a
unsafeSpliceCoerce (Q Exp -> Q (TExp GitInfo)) -> Q Exp -> Q (TExp GitInfo)
forall a b. (a -> b) -> a -> b
$ do
  GitInfo
gi <- IO GitInfo -> Q GitInfo
forall a. IO a -> Q a
runIO (IO GitInfo -> Q GitInfo) -> IO GitInfo -> Q GitInfo
forall a b. (a -> b) -> a -> b
$
    String -> IO (Either GitHashException String)
getGitRoot String
fp IO (Either GitHashException String)
-> (Either GitHashException String -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (GitHashException -> IO String)
-> (String -> IO String)
-> Either GitHashException String
-> IO String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either GitHashException -> IO String
forall e a. Exception e => e -> IO a
throwIO String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return IO String
-> (String -> IO (Either GitHashException GitInfo))
-> IO (Either GitHashException GitInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    String -> IO (Either GitHashException GitInfo)
getGitInfo IO (Either GitHashException GitInfo)
-> (Either GitHashException GitInfo -> IO GitInfo) -> IO GitInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (GitHashException -> IO GitInfo)
-> (GitInfo -> IO GitInfo)
-> Either GitHashException GitInfo
-> IO GitInfo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either GitHashException -> IO GitInfo
forall e a. Exception e => e -> IO a
throwIO GitInfo -> IO GitInfo
forall (m :: * -> *) a. Monad m => a -> m a
return
  (String -> Q ()) -> [String] -> Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Q ()
addDependentFile (GitInfo -> [String]
_giFiles GitInfo
gi)
  GitInfo -> Q Exp
forall t. Lift t => t -> Q Exp
lift (GitInfo
gi :: GitInfo) -- adding type sig to make the unsafe look slightly better

-- | Try to load up the 'GitInfo' value at compile time for the given
-- directory.
--
-- @since 0.1.2.0
tGitInfoTry :: FilePath -> SpliceQ (Either String GitInfo)
tGitInfoTry :: String -> SpliceQ (Either String GitInfo)
tGitInfoTry String
fp = Q Exp -> SpliceQ (Either String GitInfo)
forall a (m :: * -> *). Quote m => m Exp -> Splice m a
unsafeSpliceCoerce (Q Exp -> SpliceQ (Either String GitInfo))
-> Q Exp -> SpliceQ (Either String GitInfo)
forall a b. (a -> b) -> a -> b
$ do
  Either String GitInfo
egi <- IO (Either String GitInfo) -> Q (Either String GitInfo)
forall a. IO a -> Q a
runIO (IO (Either String GitInfo) -> Q (Either String GitInfo))
-> IO (Either String GitInfo) -> Q (Either String GitInfo)
forall a b. (a -> b) -> a -> b
$ do
    Either GitHashException String
eroot <- String -> IO (Either GitHashException String)
getGitRoot String
fp
    case Either GitHashException String
eroot of
      Left GitHashException
e -> Either String GitInfo -> IO (Either String GitInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String GitInfo -> IO (Either String GitInfo))
-> Either String GitInfo -> IO (Either String GitInfo)
forall a b. (a -> b) -> a -> b
$ String -> Either String GitInfo
forall a b. a -> Either a b
Left (String -> Either String GitInfo)
-> String -> Either String GitInfo
forall a b. (a -> b) -> a -> b
$ GitHashException -> String
forall a. Show a => a -> String
show GitHashException
e
      Right String
root -> do
        Either GitHashException GitInfo
einfo <- String -> IO (Either GitHashException GitInfo)
getGitInfo String
root
        case Either GitHashException GitInfo
einfo of
          Left GitHashException
e -> Either String GitInfo -> IO (Either String GitInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String GitInfo -> IO (Either String GitInfo))
-> Either String GitInfo -> IO (Either String GitInfo)
forall a b. (a -> b) -> a -> b
$ String -> Either String GitInfo
forall a b. a -> Either a b
Left (String -> Either String GitInfo)
-> String -> Either String GitInfo
forall a b. (a -> b) -> a -> b
$ GitHashException -> String
forall a. Show a => a -> String
show GitHashException
e
          Right GitInfo
info -> Either String GitInfo -> IO (Either String GitInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String GitInfo -> IO (Either String GitInfo))
-> Either String GitInfo -> IO (Either String GitInfo)
forall a b. (a -> b) -> a -> b
$ GitInfo -> Either String GitInfo
forall a b. b -> Either a b
Right GitInfo
info
  case Either String GitInfo
egi of
    Left String
_ -> () -> Q ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Right GitInfo
gi -> (String -> Q ()) -> [String] -> Q ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> Q ()
addDependentFile (GitInfo -> [String]
_giFiles GitInfo
gi)
  Either String GitInfo -> Q Exp
forall t. Lift t => t -> Q Exp
lift (Either String GitInfo
egi :: Either String GitInfo) -- adding type sig to make the unsafe look slightly better

-- | Load up the 'GitInfo' value at compile time for the current
-- working directory.
--
-- @since 0.1.0.0
tGitInfoCwd :: SpliceQ GitInfo
tGitInfoCwd :: Q (TExp GitInfo)
tGitInfoCwd = String -> Q (TExp GitInfo)
tGitInfo String
"."

-- | Try to load up the 'GitInfo' value at compile time for the current
-- working directory.
--
-- @since 0.1.2.0
tGitInfoCwdTry :: SpliceQ (Either String GitInfo)
tGitInfoCwdTry :: SpliceQ (Either String GitInfo)
tGitInfoCwdTry = String -> SpliceQ (Either String GitInfo)
tGitInfoTry String
"."