{-# 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 Data.Word (Word8)
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]
-- [Note: Current implementation's limitation]
-- the current implementation doesn't work right if:
-- 1. the current branch's name contains Non-ASCII character (due to @B8.unpack@),
-- 2. the current branch is only in .git/packed-refs, or
-- 3. the current branch is a symbolic ref to another reference.
-- In these cases, the file with the name `ref` in the following
-- code cannot be found in the filesystem (in the cases 1 & 2),
-- or can be found but will not be updated on commit (in the case 3).
-- As a result, if a module uses @tGitInfo@ as TH macro
-- and the target git repo is in one of the conditions 1--3
-- at the time of compilation, content-change-free commits will fail to
-- trigger recompilation.
--
-- [Note: reftable]
-- In the near future, the technology called reftable may replace the
-- Git's reference management. This function's implementation does not
-- work with reftable, and therefore will need to be updated.
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 -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
isSmallASCIIControl) 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
hd,String
ref] else [String
hd]
          -- 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]
  where
    -- This is to quickly strip newline characters
    -- from the content of .git/HEAD.
    -- Git references don't include ASCII control char bytes:
    -- 0x00 -- 0x1F and 0x7F.
    -- .git/HEAD may contain some ASCII control bytes LF (0xA) and
    -- CR (0xD) before EOF, which should be ignored.
    isSmallASCIIControl :: Word8 -> Bool
    isSmallASCIIControl :: Word8 -> Bool
isSmallASCIIControl = (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<Word8
0x20)

-- | 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
"."