-- |
-- Module      :  $Header$
-- Copyright   :  (c) 2025 Thomas Bidne
-- License     :  BSD3
-- Maintainer  :  tbidne@protonmail.com
--
-- "Development.GitRev.Typed" for 'OsString'.
--
-- @since 0.1
module Development.GitRev.Typed.OsString
  ( -- * Basic functions
    -- $basic
    gitBranch,
    gitCommitCount,
    gitCommitDate,
    gitDescribe,
    gitDiff,
    gitDirty,
    gitDirtyTracked,
    gitHash,
    gitShortHash,
    gitTree,

    -- * Custom behavior
    -- $custom

    -- ** "Out-of-tree" builds
    -- $out-of-tree

    -- ** Multiple queries
    -- $multiple

    -- ** Git Primitives
    Git.gitBranchQ,
    Git.gitCommitCountQ,
    Git.gitCommitDateQ,
    Git.gitDescribeQ,
    Git.gitDiffQ,
    Git.gitDirtyQ,
    Git.gitDirtyTrackedQ,
    Git.gitHashQ,
    Git.gitShortHashQ,
    Git.gitTreeQ,

    -- *** Running your own git actions
    Git.runGitQ,
    Git.runGitPostProcessQ,
    IndexUsed (..),

    -- ** Environment lookup
    -- $environment
    Env.envValQ,
    Env.runInEnvDirQ,
    Utils.runGitInEnvDirQ,
    Env.withEnvValQ,

    -- ** Q to Code
    qToCode,

    -- ** Q Combinators

    -- *** Laziness
    -- $laziness
    QFirst,
    QFirst.mkQFirst,
    QFirst.unQFirst,
    QFirst.firstSuccessQ,
    Errors,
    QFirst.mkErrors,
    QFirst.unErrors,

    -- *** Eliminating Either
    Utils.projectStringUnknown,
    Utils.projectConst,
    Utils.projectFalse,
    Utils.projectError,
    Utils.projectErrorMap,
    Utils.projectLeft,

    -- ** Errors
    GitRevError (..),
    GitError (..),
    EnvError (..),

    -- *** Utilities
    Utils.embedGitError,
    Utils.embedEnvError,
    Utils.embedTextError,
    Utils.joinFirst,
  )
where

import Development.GitRev.Internal.Environment.OsString
  ( EnvError (MkEnvError),
  )
import Development.GitRev.Internal.Environment.OsString qualified as Env
import Development.GitRev.Internal.Git.OsString
  ( GitError (MkGitError),
    IndexUsed (IdxNotUsed, IdxUsed),
  )
import Development.GitRev.Internal.Git.OsString qualified as Git
import Development.GitRev.Internal.QFirst (Errors, QFirst)
import Development.GitRev.Internal.QFirst qualified as QFirst
import Development.GitRev.Internal.Utils.OsString
  ( GitRevError
      ( GitRevErrorEnv,
        GitRevErrorGit
      ),
  )
import Development.GitRev.Internal.Utils.OsString qualified as Utils
import Language.Haskell.TH (Code, Q)
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Syntax (Lift (lift), TExp (TExp))
import System.OsString (OsString)

-- $setup
-- >>> :set -XOverloadedLists
-- >>> :set -XQuasiQuotes
-- >>> import Data.Functor (($>))
-- >>> import Development.GitRev.Typed.OsString
-- >>> import Language.Haskell.TH (Code, Q, runIO)
-- >>> import System.OsString (OsString, osstr)

-- $basic
--
-- These functions are simple, merely a typed version of "Development.GitRev"'s
-- API.
--
-- __NOTE:__ These functions do /not/ error if git fails to run, opting
-- instead to return some default value (e.g. string @UNKNOWN@, boolean @False@).

-- $custom
--
-- These functions allow defining custom behavior. For instance, using
-- the primitive 'Development.GitRev.Typed.OsString.gitHashQ' and combinator
-- 'Development.GitRev.Typed.OsString.projectError', we can define a variant
-- of 'gitHash' that instead fails to compile if there are any problems with
-- git:
--
-- @
-- -- simplified type signatures
-- 'qToCode'      :: 'Q' a -> 'Code' 'Q' a
-- 'Development.GitRev.Typed.OsString.projectError' :: 'Q' ('Either' e a) -> 'Q' a
-- 'Development.GitRev.Typed.OsString.gitHashQ'     :: 'Q' ('Either' 'GitError' 'OsString')
-- @
--
-- >>> :{
--   let gitHashOrDie :: Code Q OsString
--       gitHashOrDie = qToCode $ projectError gitHashQ
-- :}
--
-- We can also define a function that falls back to an environment variable,
-- in case the git command fails.
-- 'Development.GitRev.Typed.OsString.firstSuccessQ' takes the first action
-- that returns 'Development.GitRev.Typed.OsString.Right'.
--
-- @
-- 'Development.GitRev.Typed.OsString.firstSuccessQ' :: 'Data.List.NonEmpty' ('Q' ('Either' e a)) -> 'Q' ('Either' ('Errors' e) a)
--
-- -- unifying errors
-- 'Development.GitRev.Typed.OsString.embedGitError' :: 'Q' ('Either' 'GitError' a) -> 'Q' ('Either' 'GitRevError' a)
-- 'Development.GitRev.Typed.OsString.embedEnvError' :: 'Q' ('Either' 'EnvError' a) -> 'Q' ('Either' 'GitRevError' a)
--
-- -- look up environment variable
-- 'Development.GitRev.Typed.OsString.envValQ' :: 'OsString' -> 'Q' ('Either' 'EnvError' 'OsString')
-- @
--
-- >>> :{
--   let gitHashEnv :: OsString -> Code Q (Either (Errors GitRevError) OsString)
--       gitHashEnv var =
--         qToCode $
--           firstSuccessQ
--             -- using -XOverloadedLists to make this a little nicer
--             -- syntactically.
--             [ embedGitError gitHashQ,
--               embedEnvError $ envValQ var
--             ]
-- :}
--
-- Naturally, these can be combined:
--
-- >>> :{
--   let gitHashEnvOrDie :: OsString -> Code Q OsString
--       gitHashEnvOrDie var =
--         qToCode
--           . projectError
--           $ firstSuccessQ
--             [ embedGitError gitHashQ,
--               embedEnvError $ envValQ var
--             ]
-- :}

-- $out-of-tree
--
-- Custom definitions are particularly useful for \"out-of-tree\" builds,
-- where the build takes place outside of the normal git tree.
--
-- These builds present a problem, as we normally rely on building in the
-- project directory where the @.git@ directory is easy to locate. For
-- example, while 'gitHash' will work for @\'cabal build\'@, it will not work
-- for @\'nix build\'@ or @\'cabal install\'@. Fortunately, there are
-- workarounds, both relying on passing the right data via environment
-- variables.
--
-- 1. Passing the git directory.
--
--     For situations where we can pass the current directory during
--     installation e.g.
--
--     > $ export EXAMPLE_HOME=$(pwd); cabal install example
--
--     We can use
--
--     @
--     'Development.GitRev.Typed.OsString.runGitInEnvDirQ' :: 'OsString' -> 'Q' ('Either' 'GitError' a) -> 'Q' ('Either' 'GitRevError' a)
--     @
--
--     to define
--
--     >>> :{
--       let gitHashSrcDir :: Code Q OsString
--           gitHashSrcDir =
--             qToCode
--             . projectStringUnknown
--             $ firstSuccessQ
--               [ -- 1. We first try normal gitHashQ.
--                 embedGitError gitHashQ,
--                 -- 2. If that fails, we try again in the directory pointed
--                 --    to by "EXAMPLE_HOME".
--                 runGitInEnvDirQ [osstr|EXAMPLE_HOME|] gitHashQ
--               ]
--     :}
--
--     If the initial call to 'Development.GitRev.Typed.OsString.gitHashQ'
--     fails, then we will try again, running the command from the directory
--     pointed to by @EXAMPLE_HOME@.
--
-- 2. Passing the value itself.
--
--     This approach can work well with nix, as nix flakes provides
--     a variety of revisions via its @self@ interface. For example:
--
--     @
--       # Injecting the git hash via EXAMPLE_HASH where drv is the normal
--       # derivation.
--       drv.overrideAttrs (oldAttrs: {
--         # Also: self.shortRev, self.dirtyShortRev
--         EXAMPLE_HASH = \"${self.rev or self.dirtyRev}\";
--       });
--     @
--
--     Then we can define
--
--     >>> :{
--       let gitHashVal :: Code Q OsString
--           gitHashVal =
--             qToCode
--             . projectStringUnknown
--             $ firstSuccessQ
--               [ -- 1. We first try normal gitHashQ.
--                 embedGitError gitHashQ,
--                 -- 2. If that fails, get the value directly from
--                 --    "EXAMPLE_HASH".
--                 embedEnvError $ envValQ [osstr|EXAMPLE_HASH|]
--               ]
--     :}
--
--     Once again, if the first attempt fails, we will run the second action,
--     looking for the value of @EXAMPLE_HASH@.
--
-- Finally, we can compose these together to make a function that works for all
-- three cases:
--
-- >>> :{
--   let gitHashValSrc :: Code Q OsString
--       gitHashValSrc =
--         qToCode
--           . projectStringUnknown
--           $ firstSuccessQ
--             [ embedGitError gitHashQ,
--               runGitInEnvDirQ [osstr|EXAMPLE_HOME|] gitHashQ,
--               embedEnvError $ envValQ [osstr|EXAMPLE_HASH|]
--             ]
-- :}

-- $multiple
--
-- Using the typed interfaced, it is easy to combine multiple queries in
-- a safe way.
--
-- >>> :{
--   import Control.Applicative (liftA3)
--   -- | Returns (date, hash, short hash)
--   gitComplexData :: Code Q (OsString, OsString, OsString)
--   gitComplexData = toCode qs
--     where
--       toCode = qToCode . projectError
--       qs =
--         firstSuccessQ
--           [ embedGitError gitComplexDataFromGitQ,
--             runGitInEnvDirQ [osstr|EXAMPLE_HOME|] gitComplexDataFromGitQ
--           ]
--   gitComplexDataFromGitQ :: Q (Either GitError (OsString, OsString, OsString))
--   gitComplexDataFromGitQ = do
--     -- custom command for commit YYYY-MM-DD
--     d <-
--       runGitQ
--         [[osstr|log|], [osstr|HEAD|], [osstr|-1|], [osstr|--format=%cs|]]
--         IdxNotUsed
--     h <- gitHashQ
--     sh <- gitShortHashQ
--     pure $ liftA3 (,,) d h sh
-- :}

-- $laziness
--
-- As alluded to above, 'Q'\'s default semigroup instance is not lazy enough:
--
-- >>> :{
--   $$( qToCode $
--       (runIO (putStrLn "in q1") $> (Right "q1") :: Q (Either () String))
--         <> (runIO (putStrLn "in q2") $> Left ())
--     )
-- :}
-- in q1
-- in q2
-- Right "q1"
--
-- For this reason, we introduce 'QFirst':
--
-- @
-- 'Development.GitRev.Typed.OsString.mkQFirst' :: 'Q' ('Either' e a) -> 'QFirst' e a
-- 'Development.GitRev.Typed.OsString.unQFirst' :: 'QFirst' e a -> 'Q' ('Either' ('Errors' e) a)
-- @
--
-- >>> :{
--   $$( qToCode $ unQFirst $
--       (mkQFirst $ runIO (putStrLn "in q1") $> (Right "q1") :: QFirst () String)
--         <> (mkQFirst $ runIO (putStrLn "in q2") $> Left ())
--     )
-- :}
-- in q1
-- Right "q1"
--
-- The function
--
-- @
--   'Development.GitRev.Typed.OsString.firstSuccessQ' :: 'Data.List.NonEmpty' ('Q' ('Either' e a)) -> 'Q' ('Either' ('Errors' e) a)
-- @
--
-- utilizes 'QFirst' for sequencing a series of 'Q' actions, stopping after the
-- first success.

-- $environment
--
-- This section allows looking up data via environment variables.
--
-- === Warning: caching
--
-- Suppose we install an executable @example-exe@, that depends on
-- @example-lib@, where the latter contains a TH splice for env var @FOO@.
-- We first install via:
--
-- > export FOO=A; cabal install example-exe --installdir=build --overwrite-policy=always
--
-- This will build @example-lib@ with @A@ in the splice.
--
-- Now suppose we run @cabal clean@ (or delete the build directory e.g.
-- @dist-newstyle@) and run:
--
-- > export FOO=B; cabal install example-exe --installdir=build --overwrite-policy=always
--
-- What will the result of the splice be? Probably still @A@! The problem is
-- that cabal does not know that the environment has changed, hence it detects
-- no changes, and @example-lib@ is not re-installed.
--
-- The solution is to manually delete the library @example-lib@, which
-- probably exists in the state directory e.g.
-- @~\/.local\/state\/cabal\/store\/ghc-9.8.4-inplace@.

-- | Return the branch (or tag) name of the current git commit, or @UNKNOWN@
-- if not in a git repository. For detached heads, this will just be
-- "HEAD".
--
-- ==== __Examples__
--
-- > λ. $$gitBranch
-- > "main"
--
-- @since 0.1
gitBranch :: Code Q OsString
gitBranch :: Code Q OsString
gitBranch = Q OsString -> Code Q OsString
forall a. Lift a => Q a -> Code Q a
qToCode (Q OsString -> Code Q OsString) -> Q OsString -> Code Q OsString
forall a b. (a -> b) -> a -> b
$ Q (Either GitError OsString) -> Q OsString
forall (f :: * -> *) e.
Functor f =>
f (Either e OsString) -> f OsString
Utils.projectStringUnknown Q (Either GitError OsString)
Git.gitBranchQ

-- | Return the number of commits in the current head.
--
-- ==== __Examples__
--
-- > λ. $$gitCommitCount
-- > "47"
--
-- @since 0.1
gitCommitCount :: Code Q OsString
gitCommitCount :: Code Q OsString
gitCommitCount = Q OsString -> Code Q OsString
forall a. Lift a => Q a -> Code Q a
qToCode (Q OsString -> Code Q OsString) -> Q OsString -> Code Q OsString
forall a b. (a -> b) -> a -> b
$ Q (Either GitError OsString) -> Q OsString
forall (f :: * -> *) e.
Functor f =>
f (Either e OsString) -> f OsString
Utils.projectStringUnknown Q (Either GitError OsString)
Git.gitCommitCountQ

-- | Return the commit date of the current head.
--
-- ==== __Examples__
--
-- > λ. $$gitCommitDate
-- > "Mon Apr 14 22:14:44 2025 +1200"
--
-- @since 0.1
gitCommitDate :: Code Q OsString
gitCommitDate :: Code Q OsString
gitCommitDate = Q OsString -> Code Q OsString
forall a. Lift a => Q a -> Code Q a
qToCode (Q OsString -> Code Q OsString) -> Q OsString -> Code Q OsString
forall a b. (a -> b) -> a -> b
$ Q (Either GitError OsString) -> Q OsString
forall (f :: * -> *) e.
Functor f =>
f (Either e OsString) -> f OsString
Utils.projectStringUnknown Q (Either GitError OsString)
Git.gitCommitDateQ

-- | Return the long git description for the current git commit, or
-- @UNKNOWN@ if not in a git repository.
--
-- ==== __Examples__
--
-- > λ. $$gitDescribe
-- > "1.2.0-14-g40b5d7b"
--
-- @since 0.1
gitDescribe :: Code Q OsString
gitDescribe :: Code Q OsString
gitDescribe = Q OsString -> Code Q OsString
forall a. Lift a => Q a -> Code Q a
qToCode (Q OsString -> Code Q OsString) -> Q OsString -> Code Q OsString
forall a b. (a -> b) -> a -> b
$ Q (Either GitError OsString) -> Q OsString
forall (f :: * -> *) e.
Functor f =>
f (Either e OsString) -> f OsString
Utils.projectStringUnknown Q (Either GitError OsString)
Git.gitDescribeQ

-- | Return the diff of the working copy with HEAD.
--
-- ==== __Examples__
--
-- > λ. $$gitDiff
-- > "diff ..."
--
-- @since 0.1
gitDiff :: Code Q OsString
gitDiff :: Code Q OsString
gitDiff = Q OsString -> Code Q OsString
forall a. Lift a => Q a -> Code Q a
qToCode (Q OsString -> Code Q OsString) -> Q OsString -> Code Q OsString
forall a b. (a -> b) -> a -> b
$ Q (Either GitError OsString) -> Q OsString
forall (f :: * -> *) e.
Functor f =>
f (Either e OsString) -> f OsString
Utils.projectStringUnknown Q (Either GitError OsString)
Git.gitDiffQ

-- | Return @True@ if there are non-committed files present in the
-- repository.
--
-- ==== __Examples__
--
-- > λ. $$gitDirty
-- > False
--
-- @since 0.1
gitDirty :: Code Q Bool
gitDirty :: Code Q Bool
gitDirty = Q Bool -> Code Q Bool
forall a. Lift a => Q a -> Code Q a
qToCode (Q Bool -> Code Q Bool) -> Q Bool -> Code Q Bool
forall a b. (a -> b) -> a -> b
$ Q (Either GitError Bool) -> Q Bool
forall (f :: * -> *) e. Functor f => f (Either e Bool) -> f Bool
Utils.projectFalse Q (Either GitError Bool)
Git.gitDirtyQ

-- | Return @True@ if there are non-commited changes to tracked files
-- present in the repository.
--
-- ==== __Examples__
--
-- > λ. $$gitDirtyTracked
-- > False
--
-- @since 0.1
gitDirtyTracked :: Code Q Bool
gitDirtyTracked :: Code Q Bool
gitDirtyTracked = Q Bool -> Code Q Bool
forall a. Lift a => Q a -> Code Q a
qToCode (Q Bool -> Code Q Bool) -> Q Bool -> Code Q Bool
forall a b. (a -> b) -> a -> b
$ Q (Either GitError Bool) -> Q Bool
forall (f :: * -> *) e. Functor f => f (Either e Bool) -> f Bool
Utils.projectFalse Q (Either GitError Bool)
Git.gitDirtyTrackedQ

-- | Return the hash of the current git commit, or @UNKNOWN@ if not in
-- a git repository.
--
-- ==== __Examples__
--
-- > λ. $$gitHash
-- > "e67e943dd03744d3f93c21f84e127744e6a04543"
--
-- @since 0.1
gitHash :: Code Q OsString
gitHash :: Code Q OsString
gitHash = Q OsString -> Code Q OsString
forall a. Lift a => Q a -> Code Q a
qToCode (Q OsString -> Code Q OsString) -> Q OsString -> Code Q OsString
forall a b. (a -> b) -> a -> b
$ Q (Either GitError OsString) -> Q OsString
forall (f :: * -> *) e.
Functor f =>
f (Either e OsString) -> f OsString
Utils.projectStringUnknown Q (Either GitError OsString)
Git.gitHashQ

-- | Return the short hash of the current git commit, or @UNKNOWN@ if not in
-- a git repository.
--
-- ==== __Examples__
--
-- > λ. $$gitShortHash
-- > "e67e943"
--
-- @since 0.1
gitShortHash :: Code Q OsString
gitShortHash :: Code Q OsString
gitShortHash = Q OsString -> Code Q OsString
forall a. Lift a => Q a -> Code Q a
qToCode (Q OsString -> Code Q OsString) -> Q OsString -> Code Q OsString
forall a b. (a -> b) -> a -> b
$ Q (Either GitError OsString) -> Q OsString
forall (f :: * -> *) e.
Functor f =>
f (Either e OsString) -> f OsString
Utils.projectStringUnknown Q (Either GitError OsString)
Git.gitShortHashQ

-- | Return the hash of the current tree.
--
-- ==== __Examples__
--
-- > λ. $$gitTree
-- > "b718a493773568bbf920a4710b5b83bd1762dbb9"
--
-- @since 0.1
gitTree :: Code Q OsString
gitTree :: Code Q OsString
gitTree = Q OsString -> Code Q OsString
forall a. Lift a => Q a -> Code Q a
qToCode (Q OsString -> Code Q OsString) -> Q OsString -> Code Q OsString
forall a b. (a -> b) -> a -> b
$ Q (Either GitError OsString) -> Q OsString
forall (f :: * -> *) e.
Functor f =>
f (Either e OsString) -> f OsString
Utils.projectStringUnknown Q (Either GitError OsString)
Git.gitTreeQ

-- | Lifts a 'Q' computation to 'Code', for usage with typed TH.
--
-- @since 0.1
qToCode :: forall a. (Lift a) => Q a -> Code Q a
qToCode :: forall a. Lift a => Q a -> Code Q a
qToCode = Q (TExp a) -> Code Q a
forall a (m :: * -> *). m (TExp a) -> Code m a
TH.liftCode (Q (TExp a) -> Code Q a) -> (Q a -> Q (TExp a)) -> Q a -> Code Q a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp -> TExp a) -> Q Exp -> Q (TExp a)
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> TExp a
forall a. Exp -> TExp a
TExp (Q Exp -> Q (TExp a)) -> (Q a -> Q Exp) -> Q a -> Q (TExp a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Q a -> (a -> Q Exp) -> Q Exp
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => a -> m Exp
lift)