{-# LANGUAGE QuasiQuotes #-}

-- |
-- Module      :  $Header$
-- Copyright   :  (c) 2015 Adam C. Foltzer, 2025 Thomas Bidne
-- License     :  BSD3
-- Maintainer  :  tbidne@protonmail.com
--
-- Provides utilities for querying git for String' and
-- 'System.OsString.OsString'.
--
-- @since 0.1
module Development.GitRev.Internal.Git.Common
  ( GitError (..),
    IndexUsed (..),
    GitProcessArgs (..),
    runGitPostprocess,

    -- * Misc
    tillNewLineOsPath,
    nonEmpty,
    trySync,
  )
where

import Control.Exception
  ( Exception (displayException, fromException),
    SomeAsyncException (SomeAsyncException),
    SomeException,
    throwIO,
    toException,
    tryJust,
  )
import Control.Monad (unless, (>=>))
import Data.Foldable (traverse_)
import Data.Functor ((<&>))
import Data.Maybe (catMaybes, isJust)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TEnc
import Development.GitRev.Internal.OsString qualified as OsStringI
import Language.Haskell.TH (Q, runIO)
import Language.Haskell.TH.Syntax (Lift, addDependentFile)
import System.Directory.OsPath
  ( doesDirectoryExist,
    doesFileExist,
    findExecutable,
    getCurrentDirectory,
  )
import System.Exit (ExitCode (ExitFailure, ExitSuccess))
import System.File.OsPath qualified as FileIO
import System.OsPath (OsPath, osp, (</>))
import System.OsString qualified as OsString

-- | Parameters for running our git process below. Allows us to parameterize
-- over String and OsString.
data GitProcessArgs str = MkGitProcessArgs
  { -- | Conversion from String. Used in error reporting hence should be
    -- total i.e. lenient encodes, if necessary.
    forall str. GitProcessArgs str -> String -> str
fromStringTotal :: String -> str,
    -- | Args for acquiring git root i.e. ["rev-parse", "--show-toplevel"].
    forall str. GitProcessArgs str -> [str]
gitRootArgs :: [str],
    -- | Runs git with parameter args.
    forall str. GitProcessArgs str -> [str] -> IO (ExitCode, str, str)
runProcessGit :: [str] -> IO (ExitCode, str, str),
    -- | Encode p to OsPath. IO due to possibility of failure i.e. we want
    -- errors to throw.
    forall str. GitProcessArgs str -> str -> IO OsPath
toOsPath :: str -> IO OsPath,
    -- | Conversion to String. Used in error reporting hence should be
    -- total i.e. lenient encodes, if necessary.
    forall str. GitProcessArgs str -> str -> String
toStringTotal :: str -> String
  }

-- | Run git with the given arguments and no stdin, returning the
-- stdout output.
runGitPostprocess ::
  forall str.
  GitProcessArgs str ->
  -- | Post-processing on the result.
  (str -> str) ->
  -- | Args to run with git.
  [str] ->
  -- | Whether the index is used.
  IndexUsed ->
  Q (Either (GitError str) str)
runGitPostprocess :: forall str.
GitProcessArgs str
-> (str -> str)
-> [str]
-> IndexUsed
-> Q (Either (GitError str) str)
runGitPostprocess
  gpArgs :: GitProcessArgs str
gpArgs@MkGitProcessArgs {[str] -> IO (ExitCode, str, str)
runProcessGit :: forall str. GitProcessArgs str -> [str] -> IO (ExitCode, str, str)
runProcessGit :: [str] -> IO (ExitCode, str, str)
runProcessGit, String -> str
fromStringTotal :: forall str. GitProcessArgs str -> String -> str
fromStringTotal :: String -> str
fromStringTotal}
  str -> str
postProcess
  [str]
args
  IndexUsed
useIdx = do
    IO (Either SomeException ([OsPath], (ExitCode, str, str)))
-> Q (Either SomeException ([OsPath], (ExitCode, str, str)))
forall a. IO a -> Q a
runIO (IO ([OsPath], (ExitCode, str, str))
-> IO (Either SomeException ([OsPath], (ExitCode, str, str)))
forall a. IO a -> IO (Either SomeException a)
trySync IO ([OsPath], (ExitCode, str, str))
getFilesAndGitResult) Q (Either SomeException ([OsPath], (ExitCode, str, str)))
-> (Either SomeException ([OsPath], (ExitCode, str, str))
    -> Q (Either (GitError str) str))
-> Q (Either (GitError str) str)
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left SomeException
ex -> Either (GitError str) str -> Q (Either (GitError str) str)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (GitError str) str -> Q (Either (GitError str) str))
-> Either (GitError str) str -> Q (Either (GitError str) str)
forall a b. (a -> b) -> a -> b
$ GitError str -> Either (GitError str) str
forall a b. a -> Either a b
Left (GitError str -> Either (GitError str) str)
-> GitError str -> Either (GitError str) str
forall a b. (a -> b) -> a -> b
$ str -> GitError str
forall str. str -> GitError str
MkGitError (String -> str
fromStringTotal (String -> str) -> String -> str
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
ex)
      Right ([OsPath]
filesToTrack, (ExitCode
ec, str
out, str
err)) -> do
        -- REVIEW: Do we want to add these even if git fails? Doing it for now
        -- because that was the previous behavior...
        --
        -- Also, note that if addDependentOsPath fails (i.e. a bug), it will
        -- cause everything to fail.
        (OsPath -> Q ()) -> [OsPath] -> Q ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ OsPath -> Q ()
addDependentOsPath [OsPath]
filesToTrack
        case ExitCode
ec of
          ExitFailure Int
_ -> Either (GitError str) str -> Q (Either (GitError str) str)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (GitError str) str -> Q (Either (GitError str) str))
-> Either (GitError str) str -> Q (Either (GitError str) str)
forall a b. (a -> b) -> a -> b
$ GitError str -> Either (GitError str) str
forall a b. a -> Either a b
Left (GitError str -> Either (GitError str) str)
-> GitError str -> Either (GitError str) str
forall a b. (a -> b) -> a -> b
$ str -> GitError str
forall str. str -> GitError str
MkGitError str
err
          ExitCode
ExitSuccess -> Either (GitError str) str -> Q (Either (GitError str) str)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (GitError str) str -> Q (Either (GitError str) str))
-> Either (GitError str) str -> Q (Either (GitError str) str)
forall a b. (a -> b) -> a -> b
$ str -> Either (GitError str) str
forall a b. b -> Either a b
Right (str -> str
postProcess str
out)
    where
      -- Try to do as much IO in here as possible so it is easy to prevent
      -- exceptions from slipping later on by surrounding this with trySync.
      --
      -- This is why we return the list of dependent files to track, rather
      -- than handling them in-place. addDependentFile cannot be called
      -- inside IO, but we want all IO logic in one-place, if possible.
      -- Hence we do all the IO things here, return the files we want to
      -- track, then add them once we are in Q.
      getFilesAndGitResult :: IO ([OsPath], (ExitCode, str, str))
      getFilesAndGitResult :: IO ([OsPath], (ExitCode, str, str))
getFilesAndGitResult = do
        gitFound <- Maybe OsPath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe OsPath -> Bool) -> IO (Maybe OsPath) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> IO (Maybe OsPath)
findExecutable [osp|git|]

        unless gitFound $ throwIO GitExeNotFound

        filesToTrack <- getGitFiles

        result <- runProcessGit args
        pure (filesToTrack, result)

      -- Return the files to track later with addDependentFile. We split this
      -- up so that we can stuff all the IO logic behind try, then later use
      -- addDependentFile once we are in Q.
      getGitFiles :: IO [OsPath]
      getGitFiles :: IO [OsPath]
getGitFiles = do
        -- a lot of bookkeeping to record the right dependencies
        pwd <- GitProcessArgs str -> IO OsPath
forall str. GitProcessArgs str -> IO OsPath
getDotGit GitProcessArgs str
gpArgs
        let hd = OsPath
pwd OsPath -> OsPath -> OsPath
</> [osp|HEAD|]
            index = OsPath
pwd OsPath -> OsPath -> OsPath
</> [osp|index|]
            packedRefs = OsPath
pwd OsPath -> OsPath -> OsPath
</> [osp|packed-refs|]
        hdExists <- doesFileExist hd
        headAndRefs <- whenList 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
          contents <- readFileUtf8 hd
          case T.splitAt 5 contents of
            -- pointer to ref
            (Text
"ref: ", Text
relRef) -> do
              relRefOs <- String -> IO OsPath
forall (m :: * -> *). MonadThrow m => String -> m OsPath
OsStringI.encodeThrowM (String -> IO OsPath) -> String -> IO OsPath
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
relRef
              let ref = OsPath
pwd OsPath -> OsPath -> OsPath
</> OsPath -> OsPath
tillNewLineOsPath OsPath
relRefOs
              refExists <- doesFileExist ref
              pure $
                if refExists
                  then [Just hd, Just ref]
                  else [Just hd]
            -- detached head
            (Text, Text)
_hash -> [Maybe OsPath] -> IO [Maybe OsPath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [OsPath -> Maybe OsPath
forall a. a -> Maybe a
Just OsPath
hd]
        -- add the index if it exists to set the dirty flag
        indexExists <- doesFileExist index
        packedExists <- doesFileExist packedRefs
        let mIdxFile = Bool -> OsPath -> Maybe OsPath
forall a. Bool -> a -> Maybe a
whenJust (Bool
indexExists Bool -> Bool -> Bool
&& IndexUsed
useIdx IndexUsed -> IndexUsed -> Bool
forall a. Eq a => a -> a -> Bool
== IndexUsed
IdxUsed) OsPath
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
            mPackedRefFiles = Bool -> OsPath -> Maybe OsPath
forall a. Bool -> a -> Maybe a
whenJust Bool
packedExists OsPath
packedRefs
        pure (catMaybes $ mIdxFile : mPackedRefFiles : headAndRefs)

-- | @since 0.1
tillNewLineOsPath :: OsPath -> OsPath
tillNewLineOsPath :: OsPath -> OsPath
tillNewLineOsPath = (OsChar -> Bool) -> OsPath -> OsPath
OsString.takeWhile (\OsChar
c -> OsChar
c OsChar -> OsChar -> Bool
forall a. Eq a => a -> a -> Bool
/= OsChar
nl Bool -> Bool -> Bool
&& OsChar
c OsChar -> OsChar -> Bool
forall a. Eq a => a -> a -> Bool
/= OsChar
cr)
  where
    nl :: OsChar
nl = Char -> OsChar
OsString.unsafeFromChar Char
'\n'
    cr :: OsChar
cr = Char -> OsChar
OsString.unsafeFromChar Char
'\r'

-- | Determine where our @.git@ directory is, in case we're in a
-- submodule.
getDotGit :: forall str. GitProcessArgs str -> IO OsPath
getDotGit :: forall str. GitProcessArgs str -> IO OsPath
getDotGit GitProcessArgs str
gpArgs = do
  pwd <- GitProcessArgs str -> IO OsPath
forall str. GitProcessArgs str -> IO OsPath
getGitRoot GitProcessArgs str
gpArgs
  let dotGit = OsPath
pwd OsPath -> OsPath -> OsPath
</> [osp|.git|]
  isDir <- doesDirectoryExist dotGit

  if isDir
    then pure dotGit
    else do
      isFile <- doesFileExist dotGit

      unless isFile $ throwIO $ DotGitNotFound dotGit

      contents <- readFileUtf8 dotGit
      case T.splitAt 8 contents of
        (Text
"gitdir: ", Text
relDir) -> do
          relDirOs <- String -> IO OsPath
forall (m :: * -> *). MonadThrow m => String -> m OsPath
OsStringI.encodeThrowM (String -> IO OsPath) -> String -> IO OsPath
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
relDir
          isRelDir <- doesDirectoryExist relDirOs
          if isRelDir
            then pure relDirOs
            else throwIO $ DotGitFileNotDir dotGit relDirOs
        (Text, Text)
_ -> InternalError -> IO OsPath
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (InternalError -> IO OsPath) -> InternalError -> IO OsPath
forall a b. (a -> b) -> a -> b
$ OsPath -> Text -> InternalError
DotGitFileBadPrefix OsPath
dotGit Text
contents

readFileUtf8 :: OsPath -> IO Text
readFileUtf8 :: OsPath -> IO Text
readFileUtf8 = OsPath -> IO ByteString
FileIO.readFile' (OsPath -> IO ByteString)
-> (ByteString -> IO Text) -> OsPath -> IO Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (UnicodeException -> IO Text)
-> (Text -> IO Text) -> Either UnicodeException Text -> IO Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either UnicodeException -> IO Text
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UnicodeException Text -> IO Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
TEnc.decodeUtf8'

-- | Get the root directory of the Git repo.
getGitRoot :: forall str. GitProcessArgs str -> IO OsPath
getGitRoot :: forall str. GitProcessArgs str -> IO OsPath
getGitRoot
  MkGitProcessArgs
    { [str]
gitRootArgs :: forall str. GitProcessArgs str -> [str]
gitRootArgs :: [str]
gitRootArgs,
      str -> IO OsPath
toOsPath :: forall str. GitProcessArgs str -> str -> IO OsPath
toOsPath :: str -> IO OsPath
toOsPath,
      str -> String
toStringTotal :: forall str. GitProcessArgs str -> str -> String
toStringTotal :: str -> String
toStringTotal,
      [str] -> IO (ExitCode, str, str)
runProcessGit :: forall str. GitProcessArgs str -> [str] -> IO (ExitCode, str, str)
runProcessGit :: [str] -> IO (ExitCode, str, str)
runProcessGit
    } = do
    (code, out, _) <- [str] -> IO (ExitCode, str, str)
runProcessGit [str]
gitRootArgs
    case code of
      ExitCode
ExitSuccess -> OsPath -> OsPath
tillNewLineOsPath (OsPath -> OsPath) -> IO OsPath -> IO OsPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> str -> IO OsPath
toOsPath str
out
      ExitFailure Int
_ -> do
        mCwd <-
          IO OsPath -> IO (Either SomeException OsPath)
forall a. IO a -> IO (Either SomeException a)
trySync IO OsPath
getCurrentDirectory IO (Either SomeException OsPath)
-> (Either SomeException OsPath -> Maybe OsPath)
-> IO (Maybe OsPath)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Left SomeException
_ -> Maybe OsPath
forall a. Maybe a
Nothing
            Right OsPath
cwd -> OsPath -> Maybe OsPath
forall a. a -> Maybe a
Just OsPath
cwd
        throwIO $ GitRootNotFound mCwd (toStringTotal <$> gitRootArgs)

-- | Like when, except returns the empty list rather than unit. Monomorphic
-- on list (rather than e.g. Monoid) for clarity.
whenList :: forall f a. (Applicative f) => Bool -> f [a] -> f [a]
whenList :: forall (f :: * -> *) a. Applicative f => Bool -> f [a] -> f [a]
whenList Bool
False f [a]
_ = [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
whenList Bool
True f [a]
xs = f [a]
xs

-- | Similar to when, excepts lifts the param to Maybe. Monomorphic
-- on Maybe (rather than e.g. Alternative) for clarity.
whenJust :: forall a. Bool -> a -> Maybe a
whenJust :: forall a. Bool -> a -> Maybe a
whenJust Bool
False a
_ = Maybe a
forall a. Maybe a
Nothing
whenJust Bool
True a
x = a -> Maybe a
forall a. a -> Maybe a
Just a
x

nonEmpty :: forall a. (Eq a, Monoid a) => a -> Bool
nonEmpty :: forall a. (Eq a, Monoid a) => a -> Bool
nonEmpty = (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall a. Monoid a => a
mempty)

-- | Type to flag if the git index is used or not in a call to @runGitQ@.
--
-- @since 0.1
data IndexUsed
  = -- | The git index is used.
    --
    -- @since 0.1
    IdxUsed
  | -- | The git index is /not/ used.
    --
    -- @since 0.1
    IdxNotUsed
  deriving stock
    ( -- | @since 0.1
      IndexUsed -> IndexUsed -> Bool
(IndexUsed -> IndexUsed -> Bool)
-> (IndexUsed -> IndexUsed -> Bool) -> Eq IndexUsed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexUsed -> IndexUsed -> Bool
== :: IndexUsed -> IndexUsed -> Bool
$c/= :: IndexUsed -> IndexUsed -> Bool
/= :: IndexUsed -> IndexUsed -> Bool
Eq,
      -- | @since 0.1
      Int -> IndexUsed -> ShowS
[IndexUsed] -> ShowS
IndexUsed -> String
(Int -> IndexUsed -> ShowS)
-> (IndexUsed -> String)
-> ([IndexUsed] -> ShowS)
-> Show IndexUsed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexUsed -> ShowS
showsPrec :: Int -> IndexUsed -> ShowS
$cshow :: IndexUsed -> String
show :: IndexUsed -> String
$cshowList :: [IndexUsed] -> ShowS
showList :: [IndexUsed] -> ShowS
Show
    )

-- | Errors that can be encountered with git. The argument is a string-like
-- message.
--
-- @since 0.1
newtype GitError str = MkGitError str
  deriving stock
    ( -- | @since 0.1
      GitError str -> GitError str -> Bool
(GitError str -> GitError str -> Bool)
-> (GitError str -> GitError str -> Bool) -> Eq (GitError str)
forall str. Eq str => GitError str -> GitError str -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall str. Eq str => GitError str -> GitError str -> Bool
== :: GitError str -> GitError str -> Bool
$c/= :: forall str. Eq str => GitError str -> GitError str -> Bool
/= :: GitError str -> GitError str -> Bool
Eq,
      -- | @since 0.1
      (forall (m :: * -> *). Quote m => GitError str -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    GitError str -> Code m (GitError str))
-> Lift (GitError str)
forall str (m :: * -> *).
(Lift str, Quote m) =>
GitError str -> m Exp
forall str (m :: * -> *).
(Lift str, Quote m) =>
GitError str -> Code m (GitError str)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => GitError str -> m Exp
forall (m :: * -> *).
Quote m =>
GitError str -> Code m (GitError str)
$clift :: forall str (m :: * -> *).
(Lift str, Quote m) =>
GitError str -> m Exp
lift :: forall (m :: * -> *). Quote m => GitError str -> m Exp
$cliftTyped :: forall str (m :: * -> *).
(Lift str, Quote m) =>
GitError str -> Code m (GitError str)
liftTyped :: forall (m :: * -> *).
Quote m =>
GitError str -> Code m (GitError str)
Lift,
      -- | @since 0.1
      Int -> GitError str -> ShowS
[GitError str] -> ShowS
GitError str -> String
(Int -> GitError str -> ShowS)
-> (GitError str -> String)
-> ([GitError str] -> ShowS)
-> Show (GitError str)
forall str. Show str => Int -> GitError str -> ShowS
forall str. Show str => [GitError str] -> ShowS
forall str. Show str => GitError str -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall str. Show str => Int -> GitError str -> ShowS
showsPrec :: Int -> GitError str -> ShowS
$cshow :: forall str. Show str => GitError str -> String
show :: GitError str -> String
$cshowList :: forall str. Show str => [GitError str] -> ShowS
showList :: [GitError str] -> ShowS
Show
    )

-- | Internal error. If this is thrown, it will be turned into its string
-- representation then wrapped in GitError. This exists entirely to improve
-- error messages / make some code here clearer.
data InternalError
  = -- | .git file started with unexpected prefix.
    DotGitFileBadPrefix OsPath Text
  | -- | directory pointed to by .git file was not found.
    DotGitFileNotDir OsPath OsPath
  | -- | .git dir/file not found.
    DotGitNotFound OsPath
  | -- | Git exe not found.
    GitExeNotFound
  | -- | Git root not found.
    GitRootNotFound (Maybe OsPath) [String]
  deriving stock (Int -> InternalError -> ShowS
[InternalError] -> ShowS
InternalError -> String
(Int -> InternalError -> ShowS)
-> (InternalError -> String)
-> ([InternalError] -> ShowS)
-> Show InternalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InternalError -> ShowS
showsPrec :: Int -> InternalError -> ShowS
$cshow :: InternalError -> String
show :: InternalError -> String
$cshowList :: [InternalError] -> ShowS
showList :: [InternalError] -> ShowS
Show)

instance Exception InternalError where
  displayException :: InternalError -> String
displayException = \case
    DotGitFileBadPrefix OsPath
dotGit Text
txt ->
      Text -> String
T.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> String) -> [Text] -> String
forall a b. (a -> b) -> a -> b
$
        [ Text
"Expected .git file '",
          String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ OsPath -> String
OsStringI.decodeLenient OsPath
dotGit,
          Text
"' to start with prefix 'gitdir: ', received: '",
          Text
txt,
          Text
"'"
        ]
    DotGitFileNotDir OsPath
dotGit OsPath
path ->
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"Directory listed in .git file '",
          OsPath -> String
OsStringI.decodeLenient OsPath
dotGit,
          String
"' does not exist: '",
          OsPath -> String
OsStringI.decodeLenient OsPath
path,
          String
"'"
        ]
    DotGitNotFound OsPath
dotGit ->
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"File or directory does not exist: '",
          OsPath -> String
OsStringI.decodeLenient OsPath
dotGit,
          String
"'"
        ]
    InternalError
GitExeNotFound -> String
"Git exe not found"
    GitRootNotFound Maybe OsPath
mCurrDir [String]
args ->
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"Failed running git with args: ",
          [String] -> String
forall a. Show a => a -> String
show [String]
args,
          String
", when trying to find git root",
          String
currDirTxt
        ]
      where
        currDirTxt :: String
currDirTxt = case Maybe OsPath
mCurrDir of
          Maybe OsPath
Nothing -> String
"."
          Just OsPath
cwd ->
            [String] -> String
forall a. Monoid a => [a] -> a
mconcat
              [ String
" in directory '",
                OsPath -> String
OsStringI.decodeLenient OsPath
cwd,
                String
"'"
              ]

trySync :: forall a. IO a -> IO (Either SomeException a)
trySync :: forall a. IO a -> IO (Either SomeException a)
trySync = (SomeException -> Bool) -> IO a -> IO (Either SomeException a)
forall e a. Exception e => (e -> Bool) -> IO a -> IO (Either e a)
tryIf SomeException -> Bool
forall e. Exception e => e -> Bool
isSyncException

tryIf :: forall e a. (Exception e) => (e -> Bool) -> IO a -> IO (Either e a)
tryIf :: forall e a. Exception e => (e -> Bool) -> IO a -> IO (Either e a)
tryIf e -> Bool
p = (e -> Maybe e) -> IO a -> IO (Either e a)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust (\e
e -> if e -> Bool
p e
e then e -> Maybe e
forall a. a -> Maybe a
Just e
e else Maybe e
forall a. Maybe a
Nothing)

isSyncException :: forall e. (Exception e) => e -> Bool
isSyncException :: forall e. Exception e => e -> Bool
isSyncException e
e = case SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException (e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e) of
  Just SomeAsyncException {} -> Bool
False
  Maybe SomeAsyncException
Nothing -> Bool
True

addDependentOsPath :: OsPath -> Q ()
addDependentOsPath :: OsPath -> Q ()
addDependentOsPath = OsPath -> Q String
forall (m :: * -> *). MonadThrow m => OsPath -> m String
OsStringI.decodeThrowM (OsPath -> Q String) -> (String -> Q ()) -> OsPath -> Q ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> Q ()
addDependentFile