-- | 'Q' primitives for git actions.
--
-- @since 0.1
module Development.GitRev.Internal.Git
  ( -- * Built-in
    GitError (..),
    gitBranchQ,
    gitCommitCountQ,
    gitCommitDateQ,
    gitDescribeQ,
    gitDiffQ,
    gitDirtyQ,
    gitDirtyTrackedQ,
    gitHashQ,
    gitShortHashQ,
    gitTreeQ,

    -- * Git primitives
    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.Process qualified as Process

-- $setup
-- >>> import Development.GitRev.Typed (qToCode)

-- | Returns the current git branch.
--
-- ==== __Examples__
--
-- >>> $$(qToCode gitBranchQ)
-- Right ...
--
-- @since 0.1
gitBranchQ :: Q (Either GitError String)
gitBranchQ :: Q (Either GitError String)
gitBranchQ = [String] -> IndexUsed -> Q (Either GitError String)
runGitQ [String
"rev-parse", String
"--abbrev-ref", String
"HEAD"] IndexUsed
IdxNotUsed

-- | Returns the git commit count.
--
-- ==== __Examples__
--
-- >>> $$(qToCode gitCommitCountQ)
-- Right ...
--
-- @since 0.1
gitCommitCountQ :: Q (Either GitError String)
gitCommitCountQ :: Q (Either GitError String)
gitCommitCountQ = [String] -> IndexUsed -> Q (Either GitError String)
runGitQ [String
"rev-list", String
"HEAD", String
"--count"] IndexUsed
IdxNotUsed

-- | Returns the latest git commit date.
--
-- ==== __Examples__
--
-- >>> $$(qToCode gitCommitDateQ)
-- Right ...
--
-- @since 0.1
gitCommitDateQ :: Q (Either GitError String)
gitCommitDateQ :: Q (Either GitError String)
gitCommitDateQ = [String] -> IndexUsed -> Q (Either GitError String)
runGitQ [String
"log", String
"HEAD", String
"-1", String
"--format=%cd"] IndexUsed
IdxNotUsed

-- | Returns the git description.
--
-- ==== __Examples__
--
-- >>> $$(qToCode gitDescribeQ)
-- Right ...
--
-- @since 0.1
gitDescribeQ :: Q (Either GitError String)
gitDescribeQ :: Q (Either GitError String)
gitDescribeQ = [String] -> IndexUsed -> Q (Either GitError String)
runGitQ [String
"describe", String
"--long", String
"--always"] IndexUsed
IdxNotUsed

-- | Return the diff of the working copy with HEAD.
--
-- ==== __Examples__
--
-- >>> $$(qToCode gitDiffQ)
-- Right ...
--
-- @since 0.1
gitDiffQ :: Q (Either GitError String)
gitDiffQ :: Q (Either GitError String)
gitDiffQ = (String -> String)
-> [String] -> IndexUsed -> Q (Either GitError String)
runGitPostProcessQ String -> String
forall a. a -> a
id [String
"diff", String
"HEAD"] IndexUsed
IdxNotUsed

-- | Returns the git dirty status.
--
-- ==== __Examples__
--
-- >>> $$(qToCode gitDirtyQ)
-- Right ...
--
-- @since 0.1
gitDirtyQ :: Q (Either GitError Bool)
gitDirtyQ :: Q (Either GitError Bool)
gitDirtyQ = (String -> Bool) -> Either GitError String -> 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 String -> Bool
forall a. (Eq a, Monoid a) => a -> Bool
Common.nonEmpty (Either GitError String -> Either GitError Bool)
-> Q (Either GitError String) -> Q (Either GitError Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> IndexUsed -> Q (Either GitError String)
runGitQ [String
"status", String
"--porcelain"] IndexUsed
IdxUsed

-- | Returns the git dirty status, ignoring untracked files.
--
-- ==== __Examples__
--
-- >>> $$(qToCode gitDirtyTrackedQ)
-- Right ...
--
-- @since 0.1
gitDirtyTrackedQ :: Q (Either GitError Bool)
gitDirtyTrackedQ :: Q (Either GitError Bool)
gitDirtyTrackedQ =
  (String -> Bool) -> Either GitError String -> 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 String -> Bool
forall a. (Eq a, Monoid a) => a -> Bool
Common.nonEmpty
    (Either GitError String -> Either GitError Bool)
-> Q (Either GitError String) -> Q (Either GitError Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> IndexUsed -> Q (Either GitError String)
runGitQ [String
"status", String
"--porcelain", String
"--untracked-files=no"] IndexUsed
IdxUsed

-- | Returns the latest git hash.
--
-- ==== __Examples__
--
-- >>> $$(qToCode gitHashQ)
-- Right ...
--
-- @since 0.1
gitHashQ :: Q (Either GitError String)
gitHashQ :: Q (Either GitError String)
gitHashQ = [String] -> IndexUsed -> Q (Either GitError String)
runGitQ [String
"rev-parse", String
"HEAD"] IndexUsed
IdxNotUsed

-- | Returns the latest git short hash.
--
-- ==== __Examples__
--
-- >>> $$(qToCode gitShortHashQ)
-- Right ...
--
-- @since 0.1
gitShortHashQ :: Q (Either GitError String)
gitShortHashQ :: Q (Either GitError String)
gitShortHashQ = [String] -> IndexUsed -> Q (Either GitError String)
runGitQ [String
"rev-parse", String
"--short", String
"HEAD"] IndexUsed
IdxNotUsed

-- | Returns the hash of the current tree.
--
-- ==== __Examples__
--
-- >>> $$(qToCode gitTreeQ)
-- Right ...
--
-- @since 0.1
gitTreeQ :: Q (Either GitError String)
gitTreeQ :: Q (Either GitError String)
gitTreeQ = [String] -> IndexUsed -> Q (Either GitError String)
runGitQ [String
"show", String
"HEAD", String
"--format=%T", String
"--no-patch"] IndexUsed
IdxNotUsed

-- | Errors that can be encountered with git.
--
-- @since 0.1
newtype GitError = MkGitError
  { -- | @since 0.1
    GitError -> String
reason :: String
  }
  deriving stock
    ( -- | @since 0.1
      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,
      -- | @since 0.1
      (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,
      -- | @since 0.1
      Int -> GitError -> String -> String
[GitError] -> String -> String
GitError -> String
(Int -> GitError -> String -> String)
-> (GitError -> String)
-> ([GitError] -> String -> String)
-> Show GitError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GitError -> String -> String
showsPrec :: Int -> GitError -> String -> String
$cshow :: GitError -> String
show :: GitError -> String
$cshowList :: [GitError] -> String -> String
showList :: [GitError] -> String -> String
Show
    )

-- | @since 0.1
instance Exception GitError where
  displayException :: GitError -> String
displayException (MkGitError String
s) = String
"Git error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

-- | Runs git with the arguments. If 'IdxUsed' is passed, it is tracked for
-- recompliation purposes.
--
-- ==== __Examples__
--
-- >>> :{
--   -- Returns 'YYYY-MM-DD' rather than e.g. gitCommitDateQ's
--   -- 'Fri May 2 13:29:59 2025 +1200'.
--   gitCommitDateShortQ :: Q (Either GitError String)
--   gitCommitDateShortQ = runGitQ ["log", "HEAD", "-1", "--format=%cs"] IdxNotUsed
-- :}
--
-- @since 0.1
runGitQ ::
  -- | Arguments to git.
  [String] ->
  -- | Whether the index is used.
  IndexUsed ->
  Q (Either GitError String)
runGitQ :: [String] -> IndexUsed -> Q (Either GitError String)
runGitQ = (String -> String)
-> [String] -> IndexUsed -> Q (Either GitError String)
runGitPostProcessQ String -> String
tillNewLineStr

-- | Like 'runGitQ', except it applies the given function to the result.
-- Normal 'runGitQ' takes everything up until the first new line or carriage
-- return.
--
-- ==== __Examples__
--
-- >>> :{
--   runGitNoProcessQ :: [String] -> IndexUsed -> Q (Either GitError String)
--   runGitNoProcessQ = runGitPostProcessQ id
-- :}
--
-- @since 0.1
runGitPostProcessQ ::
  -- | Function to run on the result.
  (String -> String) ->
  -- | Arguments to git.
  [String] ->
  -- | Whether the index is used.
  IndexUsed ->
  Q (Either GitError String)
runGitPostProcessQ :: (String -> String)
-> [String] -> IndexUsed -> Q (Either GitError String)
runGitPostProcessQ String -> String
postProcess [String]
args IndexUsed
idxUsed =
  (GitError String -> GitError)
-> Either (GitError String) String -> Either GitError String
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 String -> GitError
mapGitError
    (Either (GitError String) String -> Either GitError String)
-> Q (Either (GitError String) String)
-> Q (Either GitError String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GitProcessArgs String
-> (String -> String)
-> [String]
-> IndexUsed
-> Q (Either (GitError String) String)
forall str.
GitProcessArgs str
-> (str -> str)
-> [str]
-> IndexUsed
-> Q (Either (GitError str) str)
Common.runGitPostprocess
      GitProcessArgs String
gitProcessArgs
      String -> String
postProcess
      [String]
args
      IndexUsed
idxUsed

mapGitError :: Common.GitError String -> GitError
mapGitError :: GitError String -> GitError
mapGitError (Common.MkGitError String
s) = String -> GitError
MkGitError String
s

gitProcessArgs :: GitProcessArgs String
gitProcessArgs :: GitProcessArgs String
gitProcessArgs =
  MkGitProcessArgs
    { fromStringTotal :: String -> String
fromStringTotal = String -> String
forall a. a -> a
id,
      gitRootArgs :: [String]
gitRootArgs = [String
"rev-parse", String
"--show-toplevel"],
      runProcessGit :: [String] -> IO (ExitCode, String, String)
runProcessGit = \[String]
args -> String -> [String] -> String -> IO (ExitCode, String, String)
Process.readProcessWithExitCode String
"git" [String]
args String
"",
      toOsPath :: String -> IO OsPath
toOsPath = String -> IO OsPath
forall (m :: * -> *). MonadThrow m => String -> m OsPath
OsStringI.encodeThrowM,
      toStringTotal :: String -> String
toStringTotal = String -> String
forall a. a -> a
id
    }

tillNewLineStr :: String -> String
tillNewLineStr :: String -> String
tillNewLineStr = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r')