{-# LANGUAGE QuantifiedConstraints #-}

-- | Utils module.
--
-- @since 0.1
module Development.GitRev.Internal.Utils
  ( -- * Either projections
    projectStringUnknown,
    Common.projectConst,
    Common.projectFalse,
    Common.projectError,
    Common.projectErrorMap,
    Common.projectLeft,

    -- * Composing errors
    GitRevError (..),

    -- ** Functions
    runGitInEnvDirQ,

    -- ** Mapping utilities
    embedGitError,
    embedEnvError,
    embedTextError,
    Common.joinFirst,
  )
where

import Control.Exception (Exception (displayException))
import Data.Bifunctor (Bifunctor (first))
import Data.Text (Text)
import Data.Text qualified as T
import Development.GitRev.Internal.Environment (EnvError)
import Development.GitRev.Internal.Environment qualified as Env
import Development.GitRev.Internal.Git (GitError)
import Development.GitRev.Internal.Utils.Common qualified as Common
import Language.Haskell.TH (Q)
import Language.Haskell.TH.Syntax (Lift)

-- $setup
-- >>> import Development.GitRev.Typed (qToCode)
-- >>> import Development.GitRev.Internal.Git (GitError (..), gitDirtyQ, gitHashQ)
-- >>> import Development.GitRev.Internal.Environment (EnvError (..))
-- >>> import Language.Haskell.TH (Q, runIO, runQ)
-- >>> import System.Environment (setEnv)

-- | Projects 'Left' to the string @UNKNOWN@.
--
-- ==== __Examples__
--
-- >>> $$(qToCode $ projectStringUnknown (pure $ Left ()))
-- "UNKNOWN"
--
-- @since 0.1
projectStringUnknown ::
  forall f e.
  (Functor f) =>
  f (Either e String) ->
  f String
projectStringUnknown :: forall (f :: * -> *) e.
Functor f =>
f (Either e String) -> f String
projectStringUnknown = String -> f (Either e String) -> f String
forall (f :: * -> *) e a. Functor f => a -> f (Either e a) -> f a
Common.projectConst String
"UNKNOWN"

-- | General error type for anything that can go wrong when running
-- @gitrev-typed@ splices.
--
-- @since 0.1
data GitRevError
  = -- | Git error.
    --
    -- @since 0.1
    GitRevErrorGit GitError
  | -- | Environment variable lookup error.
    --
    -- @since 0.1
    GitRevErrorEnv EnvError
  | -- | Catch-all for anything else that can go wrong.
    --
    -- @since 0.1
    GitRevErrorText Text
  deriving stock
    ( -- | @since 0.1
      GitRevError -> GitRevError -> Bool
(GitRevError -> GitRevError -> Bool)
-> (GitRevError -> GitRevError -> Bool) -> Eq GitRevError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitRevError -> GitRevError -> Bool
== :: GitRevError -> GitRevError -> Bool
$c/= :: GitRevError -> GitRevError -> Bool
/= :: GitRevError -> GitRevError -> Bool
Eq,
      -- | @since 0.1
      (forall (m :: * -> *). Quote m => GitRevError -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    GitRevError -> Code m GitRevError)
-> Lift GitRevError
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => GitRevError -> m Exp
forall (m :: * -> *). Quote m => GitRevError -> Code m GitRevError
$clift :: forall (m :: * -> *). Quote m => GitRevError -> m Exp
lift :: forall (m :: * -> *). Quote m => GitRevError -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => GitRevError -> Code m GitRevError
liftTyped :: forall (m :: * -> *). Quote m => GitRevError -> Code m GitRevError
Lift,
      -- | @since 0.1
      Int -> GitRevError -> String -> String
[GitRevError] -> String -> String
GitRevError -> String
(Int -> GitRevError -> String -> String)
-> (GitRevError -> String)
-> ([GitRevError] -> String -> String)
-> Show GitRevError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GitRevError -> String -> String
showsPrec :: Int -> GitRevError -> String -> String
$cshow :: GitRevError -> String
show :: GitRevError -> String
$cshowList :: [GitRevError] -> String -> String
showList :: [GitRevError] -> String -> String
Show
    )

-- | @since 0.1
instance Exception GitRevError where
  displayException :: GitRevError -> String
displayException (GitRevErrorGit GitError
ge) = GitError -> String
forall e. Exception e => e -> String
displayException GitError
ge
  displayException (GitRevErrorEnv EnvError
x) = EnvError -> String
forall e. Exception e => e -> String
displayException EnvError
x
  displayException (GitRevErrorText Text
txt) = Text -> String
T.unpack Text
txt

-- | Runs the git action under the directory @d@ pointed to by the
-- given environment variable.
--
-- ==== __Examples__
--
-- >>> setEnv "SOME_DIR" "./"
-- >>> $$(qToCode $ runGitInEnvDirQ "SOME_DIR" gitHashQ)
-- Right ...
--
-- @since 0.1
runGitInEnvDirQ ::
  forall a.
  -- | Environment variable pointing to a directory path, in which we run
  -- the git process.
  String ->
  -- | Git process to run.
  Q (Either GitError a) ->
  -- | The result.
  Q (Either GitRevError a)
runGitInEnvDirQ :: forall a.
String -> Q (Either GitError a) -> Q (Either GitRevError a)
runGitInEnvDirQ String
var =
  (Either EnvError (Either GitError a) -> Either GitRevError a)
-> Q (Either EnvError (Either GitError a))
-> Q (Either GitRevError a)
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((EnvError -> GitRevError)
-> (GitError -> GitRevError)
-> Either EnvError (Either GitError a)
-> Either GitRevError a
forall (p :: * -> * -> *) a1 a2 b c.
(Bifunctor p, forall a. Monad (p a)) =>
(a1 -> b) -> (a2 -> b) -> p a1 (p a2 c) -> p b c
Common.joinFirst EnvError -> GitRevError
GitRevErrorEnv GitError -> GitRevError
GitRevErrorGit)
    (Q (Either EnvError (Either GitError a))
 -> Q (Either GitRevError a))
-> (Q (Either GitError a)
    -> Q (Either EnvError (Either GitError a)))
-> Q (Either GitError a)
-> Q (Either GitRevError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Q (Either GitError a) -> Q (Either EnvError (Either GitError a))
forall a. String -> Q a -> Q (Either EnvError a)
Env.runInEnvDirQ String
var

-- | Embeds a 'GitError' in the larger 'GitRevError'.
--
-- ==== __Examples__
--
-- >>> :{
--   let q :: Q (Either GitError ())
--       q = pure (Left $ MkGitError "not found")
--   in runQ $ embedGitError q
-- :}
-- Left (GitRevErrorGit (MkGitError {reason = "not found"}))
--
-- @since 0.1
embedGitError ::
  forall f p a.
  ( Bifunctor p,
    Functor f
  ) =>
  -- | .
  f (p GitError a) ->
  f (p GitRevError a)
embedGitError :: forall (f :: * -> *) (p :: * -> * -> *) a.
(Bifunctor p, Functor f) =>
f (p GitError a) -> f (p GitRevError a)
embedGitError = (p GitError a -> p GitRevError a)
-> f (p GitError a) -> f (p GitRevError a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GitError -> GitRevError) -> p GitError a -> p GitRevError a
forall a b c. (a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first GitError -> GitRevError
GitRevErrorGit)

-- | Embeds an 'EnvError' in the larger 'GitRevError'.
--
-- ==== __Examples__
--
-- >>> :{
--   let q :: Q (Either EnvError ())
--       q = pure (Left $ MkEnvError "VAR" Nothing "VAR does not exist")
--   in runQ $ embedEnvError q
-- :}
-- Left (GitRevErrorEnv (MkEnvError {var = "VAR", value = Nothing, reason = "VAR does not exist"}))
--
-- @since 0.1
embedEnvError ::
  forall f p a.
  ( Bifunctor p,
    Functor f
  ) =>
  -- | .
  f (p EnvError a) ->
  f (p GitRevError a)
embedEnvError :: forall (f :: * -> *) (p :: * -> * -> *) a.
(Bifunctor p, Functor f) =>
f (p EnvError a) -> f (p GitRevError a)
embedEnvError = (p EnvError a -> p GitRevError a)
-> f (p EnvError a) -> f (p GitRevError a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((EnvError -> GitRevError) -> p EnvError a -> p GitRevError a
forall a b c. (a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first EnvError -> GitRevError
GitRevErrorEnv)

-- | Embeds a 'Text' in the larger 'GitRevError'.
--
-- ==== __Examples__
--
-- >>> :{
--   let q :: Q (Either Text ())
--       q = pure (Left "Something went wrong")
--   in runQ $ embedTextError q
-- :}
-- Left (GitRevErrorText "Something went wrong")
--
-- @since 0.1
embedTextError ::
  forall f p a.
  ( Bifunctor p,
    Functor f
  ) =>
  -- | .
  f (p Text a) ->
  f (p GitRevError a)
embedTextError :: forall (f :: * -> *) (p :: * -> * -> *) a.
(Bifunctor p, Functor f) =>
f (p Text a) -> f (p GitRevError a)
embedTextError = (p Text a -> p GitRevError a)
-> f (p Text a) -> f (p GitRevError a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> GitRevError) -> p Text a -> p GitRevError a
forall a b c. (a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> GitRevError
GitRevErrorText)