{-# LANGUAGE QuasiQuotes #-}
module Development.GitRev.Internal.Git.OsString
(
GitError (..),
gitBranchQ,
gitCommitCountQ,
gitCommitDateQ,
gitDescribeQ,
gitDiffQ,
gitDirtyQ,
gitDirtyTrackedQ,
gitHashQ,
gitShortHashQ,
gitTreeQ,
runGitQ,
runGitPostProcessQ,
IndexUsed (..),
)
where
import Control.Exception (Exception (displayException))
import Data.Bifunctor (Bifunctor (first))
import Development.GitRev.Internal.Git.Common
( GitProcessArgs
( MkGitProcessArgs,
fromStringTotal,
gitRootArgs,
runProcessGit,
toOsPath,
toStringTotal
),
IndexUsed (IdxNotUsed, IdxUsed),
)
import Development.GitRev.Internal.Git.Common qualified as Common
import Development.GitRev.Internal.OsString qualified as OsStringI
import Language.Haskell.TH (Q)
import Language.Haskell.TH.Syntax (Lift)
import System.OsString (OsString, osstr)
import System.Process qualified as Process
gitBranchQ :: Q (Either GitError OsString)
gitBranchQ :: Q (Either GitError OsString)
gitBranchQ =
[OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitQ [[osstr|rev-parse|], [osstr|--abbrev-ref|], [osstr|HEAD|]] IndexUsed
IdxNotUsed
gitCommitCountQ :: Q (Either GitError OsString)
gitCommitCountQ :: Q (Either GitError OsString)
gitCommitCountQ =
[OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitQ [[osstr|rev-list|], [osstr|HEAD|], [osstr|--count|]] IndexUsed
IdxNotUsed
gitCommitDateQ :: Q (Either GitError OsString)
gitCommitDateQ :: Q (Either GitError OsString)
gitCommitDateQ =
[OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitQ
[ [osstr|log|],
[osstr|HEAD|],
[osstr|-1|],
[osstr|--format=%cd|]
]
IndexUsed
IdxNotUsed
gitDescribeQ :: Q (Either GitError OsString)
gitDescribeQ :: Q (Either GitError OsString)
gitDescribeQ =
[OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitQ [[osstr|describe|], [osstr|--long|], [osstr|--always|]] IndexUsed
IdxNotUsed
gitDiffQ :: Q (Either GitError OsString)
gitDiffQ :: Q (Either GitError OsString)
gitDiffQ = (OsString -> OsString)
-> [OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitPostProcessQ OsString -> OsString
forall a. a -> a
id [[osstr|diff|], [osstr|HEAD|]] IndexUsed
IdxNotUsed
gitDirtyQ :: Q (Either GitError Bool)
gitDirtyQ :: Q (Either GitError Bool)
gitDirtyQ =
(OsString -> Bool)
-> Either GitError OsString -> Either GitError Bool
forall a b. (a -> b) -> Either GitError a -> Either GitError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OsString -> Bool
forall a. (Eq a, Monoid a) => a -> Bool
Common.nonEmpty
(Either GitError OsString -> Either GitError Bool)
-> Q (Either GitError OsString) -> Q (Either GitError Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitQ [[osstr|status|], [osstr|--porcelain|]] IndexUsed
IdxUsed
gitDirtyTrackedQ :: Q (Either GitError Bool)
gitDirtyTrackedQ :: Q (Either GitError Bool)
gitDirtyTrackedQ =
(OsString -> Bool)
-> Either GitError OsString -> Either GitError Bool
forall a b. (a -> b) -> Either GitError a -> Either GitError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OsString -> Bool
forall a. (Eq a, Monoid a) => a -> Bool
Common.nonEmpty
(Either GitError OsString -> Either GitError Bool)
-> Q (Either GitError OsString) -> Q (Either GitError Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitQ
[[osstr|status|], [osstr|--porcelain|], [osstr|--untracked-files=no|]]
IndexUsed
IdxUsed
gitHashQ :: Q (Either GitError OsString)
gitHashQ :: Q (Either GitError OsString)
gitHashQ = [OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitQ [[osstr|rev-parse|], [osstr|HEAD|]] IndexUsed
IdxNotUsed
gitShortHashQ :: Q (Either GitError OsString)
gitShortHashQ :: Q (Either GitError OsString)
gitShortHashQ =
[OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitQ [[osstr|rev-parse|], [osstr|--short|], [osstr|HEAD|]] IndexUsed
IdxNotUsed
gitTreeQ :: Q (Either GitError OsString)
gitTreeQ :: Q (Either GitError OsString)
gitTreeQ =
[OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitQ
[ [osstr|show|],
[osstr|HEAD|],
[osstr|--format=%T|],
[osstr|--no-patch|]
]
IndexUsed
IdxNotUsed
newtype GitError = MkGitError
{
GitError -> OsString
reason :: OsString
}
deriving stock
(
GitError -> GitError -> Bool
(GitError -> GitError -> Bool)
-> (GitError -> GitError -> Bool) -> Eq GitError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitError -> GitError -> Bool
== :: GitError -> GitError -> Bool
$c/= :: GitError -> GitError -> Bool
/= :: GitError -> GitError -> Bool
Eq,
(forall (m :: * -> *). Quote m => GitError -> m Exp)
-> (forall (m :: * -> *). Quote m => GitError -> Code m GitError)
-> Lift GitError
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => GitError -> m Exp
forall (m :: * -> *). Quote m => GitError -> Code m GitError
$clift :: forall (m :: * -> *). Quote m => GitError -> m Exp
lift :: forall (m :: * -> *). Quote m => GitError -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => GitError -> Code m GitError
liftTyped :: forall (m :: * -> *). Quote m => GitError -> Code m GitError
Lift,
Int -> GitError -> ShowS
[GitError] -> ShowS
GitError -> String
(Int -> GitError -> ShowS)
-> (GitError -> String) -> ([GitError] -> ShowS) -> Show GitError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitError -> ShowS
showsPrec :: Int -> GitError -> ShowS
$cshow :: GitError -> String
show :: GitError -> String
$cshowList :: [GitError] -> ShowS
showList :: [GitError] -> ShowS
Show
)
instance Exception GitError where
displayException :: GitError -> String
displayException (MkGitError OsString
s) = String
"Git error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ OsString -> String
OsStringI.decodeLenient OsString
s
runGitQ ::
[OsString] ->
IndexUsed ->
Q (Either GitError OsString)
runGitQ :: [OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitQ = (OsString -> OsString)
-> [OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitPostProcessQ OsString -> OsString
Common.tillNewLineOsPath
runGitPostProcessQ ::
(OsString -> OsString) ->
[OsString] ->
IndexUsed ->
Q (Either GitError OsString)
runGitPostProcessQ :: (OsString -> OsString)
-> [OsString] -> IndexUsed -> Q (Either GitError OsString)
runGitPostProcessQ OsString -> OsString
postProcess [OsString]
args IndexUsed
idxUsed =
(GitError OsString -> GitError)
-> Either (GitError OsString) OsString -> Either GitError OsString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first GitError OsString -> GitError
mapGitError
(Either (GitError OsString) OsString -> Either GitError OsString)
-> Q (Either (GitError OsString) OsString)
-> Q (Either GitError OsString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GitProcessArgs OsString
-> (OsString -> OsString)
-> [OsString]
-> IndexUsed
-> Q (Either (GitError OsString) OsString)
forall str.
GitProcessArgs str
-> (str -> str)
-> [str]
-> IndexUsed
-> Q (Either (GitError str) str)
Common.runGitPostprocess
GitProcessArgs OsString
gitProcessArgs
OsString -> OsString
postProcess
[OsString]
args
IndexUsed
idxUsed
mapGitError :: Common.GitError OsString -> GitError
mapGitError :: GitError OsString -> GitError
mapGitError (Common.MkGitError OsString
s) = OsString -> GitError
MkGitError OsString
s
gitProcessArgs :: GitProcessArgs OsString
gitProcessArgs :: GitProcessArgs OsString
gitProcessArgs =
MkGitProcessArgs
{ fromStringTotal :: String -> OsString
fromStringTotal = String -> OsString
OsStringI.encodeLenient,
gitRootArgs :: [OsString]
gitRootArgs = [[osstr|rev-parse|], [osstr|--show-toplevel|]],
runProcessGit :: [OsString] -> IO (ExitCode, OsString, OsString)
runProcessGit = \[OsString]
args -> do
args' <- (OsString -> IO String) -> [OsString] -> IO [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse OsString -> IO String
forall (m :: * -> *). MonadThrow m => OsString -> m String
OsStringI.decodeThrowM [OsString]
args
(ec, out, err) <- Process.readProcessWithExitCode "git" args' ""
(ec,,OsStringI.encodeLenient err) <$> OsStringI.encodeThrowM out,
toOsPath :: OsString -> IO OsString
toOsPath = OsString -> IO OsString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure,
toStringTotal :: OsString -> String
toStringTotal = OsString -> String
OsStringI.decodeLenient
}