{-# LANGUAGE CPP #-}
{-# LANGUAGE QuantifiedConstraints #-}

-- | Utils module.
--
-- @since 0.1
module Development.GitRev.Utils
  ( -- * Combining Q actions lazily
    QFirst (..),
    mkQFirst,
    firstSuccessQ,
    Exceptions (..),
    mkExceptions,

    -- * Either projections
    projectStringUnknown,
    projectString,
    projectFalse,
    projectError,
    projectErrorMap,

    -- * Composing errors
    GitOrLookupEnvError (..),

    -- ** Functions
    runGitInEnvDirQ,

    -- ** Mapping utilities
    embedGitError,
    embedLookupEnvError,
    joinLookupEnvGitErrors,
    joinGitLookupEnvErrors,
  )
where

import Control.Exception (Exception (displayException))
import Control.Monad (join)
import Data.Bifunctor (Bifunctor (bimap, first))
import Data.Foldable (Foldable (fold))
#if MIN_VERSION_base(4, 18, 0)
import Data.Foldable1 (Foldable1 (foldMap1))
#endif
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as NE
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder qualified as TLB
import Development.GitRev.Utils.Environment (LookupEnvError)
import Development.GitRev.Utils.Environment qualified as Env
import Development.GitRev.Utils.Git (GitError)
import Language.Haskell.TH (Q)
import Language.Haskell.TH.Syntax (Lift)

-- $setup
-- >>> :set -XTemplateHaskell
-- >>> import Development.GitRev.Typed (qToCode)
-- >>> import Development.GitRev.Utils.Git (GitError (..), gitDirtyQ, gitHashQ)
-- >>> import Development.GitRev.Utils.Environment (LookupEnvError (..))
-- >>> import Language.Haskell.TH (Q, runIO, runQ)
-- >>> import System.Environment (setEnv)

-- | Collects multiple exceptions.
--
-- @since 0.1
newtype Exceptions e = MkExceptions {forall e. Exceptions e -> NonEmpty e
unExceptions :: (NonEmpty e)}
  deriving stock
    ( -- | @since 0.1
      Exceptions e -> Exceptions e -> Bool
(Exceptions e -> Exceptions e -> Bool)
-> (Exceptions e -> Exceptions e -> Bool) -> Eq (Exceptions e)
forall e. Eq e => Exceptions e -> Exceptions e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => Exceptions e -> Exceptions e -> Bool
== :: Exceptions e -> Exceptions e -> Bool
$c/= :: forall e. Eq e => Exceptions e -> Exceptions e -> Bool
/= :: Exceptions e -> Exceptions e -> Bool
Eq,
      -- | @since 0.1
      (forall a b. (a -> b) -> Exceptions a -> Exceptions b)
-> (forall a b. a -> Exceptions b -> Exceptions a)
-> Functor Exceptions
forall a b. a -> Exceptions b -> Exceptions a
forall a b. (a -> b) -> Exceptions a -> Exceptions b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Exceptions a -> Exceptions b
fmap :: forall a b. (a -> b) -> Exceptions a -> Exceptions b
$c<$ :: forall a b. a -> Exceptions b -> Exceptions a
<$ :: forall a b. a -> Exceptions b -> Exceptions a
Functor,
      -- | @since 0.1
      (forall (m :: * -> *). Quote m => Exceptions e -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Exceptions e -> Code m (Exceptions e))
-> Lift (Exceptions e)
forall e (m :: * -> *). (Lift e, Quote m) => Exceptions e -> m Exp
forall e (m :: * -> *).
(Lift e, Quote m) =>
Exceptions e -> Code m (Exceptions e)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Exceptions e -> m Exp
forall (m :: * -> *).
Quote m =>
Exceptions e -> Code m (Exceptions e)
$clift :: forall e (m :: * -> *). (Lift e, Quote m) => Exceptions e -> m Exp
lift :: forall (m :: * -> *). Quote m => Exceptions e -> m Exp
$cliftTyped :: forall e (m :: * -> *).
(Lift e, Quote m) =>
Exceptions e -> Code m (Exceptions e)
liftTyped :: forall (m :: * -> *).
Quote m =>
Exceptions e -> Code m (Exceptions e)
Lift,
      -- | @since 0.1
      Int -> Exceptions e -> ShowS
[Exceptions e] -> ShowS
Exceptions e -> String
(Int -> Exceptions e -> ShowS)
-> (Exceptions e -> String)
-> ([Exceptions e] -> ShowS)
-> Show (Exceptions e)
forall e. Show e => Int -> Exceptions e -> ShowS
forall e. Show e => [Exceptions e] -> ShowS
forall e. Show e => Exceptions e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> Exceptions e -> ShowS
showsPrec :: Int -> Exceptions e -> ShowS
$cshow :: forall e. Show e => Exceptions e -> String
show :: Exceptions e -> String
$cshowList :: forall e. Show e => [Exceptions e] -> ShowS
showList :: [Exceptions e] -> ShowS
Show
    )
  deriving newtype
    ( -- | @since 0.1
      Functor Exceptions
Functor Exceptions =>
(forall a. a -> Exceptions a)
-> (forall a b.
    Exceptions (a -> b) -> Exceptions a -> Exceptions b)
-> (forall a b c.
    (a -> b -> c) -> Exceptions a -> Exceptions b -> Exceptions c)
-> (forall a b. Exceptions a -> Exceptions b -> Exceptions b)
-> (forall a b. Exceptions a -> Exceptions b -> Exceptions a)
-> Applicative Exceptions
forall a. a -> Exceptions a
forall a b. Exceptions a -> Exceptions b -> Exceptions a
forall a b. Exceptions a -> Exceptions b -> Exceptions b
forall a b. Exceptions (a -> b) -> Exceptions a -> Exceptions b
forall a b c.
(a -> b -> c) -> Exceptions a -> Exceptions b -> Exceptions c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Exceptions a
pure :: forall a. a -> Exceptions a
$c<*> :: forall a b. Exceptions (a -> b) -> Exceptions a -> Exceptions b
<*> :: forall a b. Exceptions (a -> b) -> Exceptions a -> Exceptions b
$cliftA2 :: forall a b c.
(a -> b -> c) -> Exceptions a -> Exceptions b -> Exceptions c
liftA2 :: forall a b c.
(a -> b -> c) -> Exceptions a -> Exceptions b -> Exceptions c
$c*> :: forall a b. Exceptions a -> Exceptions b -> Exceptions b
*> :: forall a b. Exceptions a -> Exceptions b -> Exceptions b
$c<* :: forall a b. Exceptions a -> Exceptions b -> Exceptions a
<* :: forall a b. Exceptions a -> Exceptions b -> Exceptions a
Applicative,
      -- | @since 0.1
      Applicative Exceptions
Applicative Exceptions =>
(forall a b. Exceptions a -> (a -> Exceptions b) -> Exceptions b)
-> (forall a b. Exceptions a -> Exceptions b -> Exceptions b)
-> (forall a. a -> Exceptions a)
-> Monad Exceptions
forall a. a -> Exceptions a
forall a b. Exceptions a -> Exceptions b -> Exceptions b
forall a b. Exceptions a -> (a -> Exceptions b) -> Exceptions b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Exceptions a -> (a -> Exceptions b) -> Exceptions b
>>= :: forall a b. Exceptions a -> (a -> Exceptions b) -> Exceptions b
$c>> :: forall a b. Exceptions a -> Exceptions b -> Exceptions b
>> :: forall a b. Exceptions a -> Exceptions b -> Exceptions b
$creturn :: forall a. a -> Exceptions a
return :: forall a. a -> Exceptions a
Monad,
      -- | @since 0.1
      NonEmpty (Exceptions e) -> Exceptions e
Exceptions e -> Exceptions e -> Exceptions e
(Exceptions e -> Exceptions e -> Exceptions e)
-> (NonEmpty (Exceptions e) -> Exceptions e)
-> (forall b. Integral b => b -> Exceptions e -> Exceptions e)
-> Semigroup (Exceptions e)
forall b. Integral b => b -> Exceptions e -> Exceptions e
forall e. NonEmpty (Exceptions e) -> Exceptions e
forall e. Exceptions e -> Exceptions e -> Exceptions e
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall e b. Integral b => b -> Exceptions e -> Exceptions e
$c<> :: forall e. Exceptions e -> Exceptions e -> Exceptions e
<> :: Exceptions e -> Exceptions e -> Exceptions e
$csconcat :: forall e. NonEmpty (Exceptions e) -> Exceptions e
sconcat :: NonEmpty (Exceptions e) -> Exceptions e
$cstimes :: forall e b. Integral b => b -> Exceptions e -> Exceptions e
stimes :: forall b. Integral b => b -> Exceptions e -> Exceptions e
Semigroup
    )

-- | @since 0.1
instance (Exception e) => Exception (Exceptions e) where
  displayException :: Exceptions e -> String
displayException (MkExceptions NonEmpty e
errs) =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"Exception(s):",
        NonEmpty e -> String
renderErrs NonEmpty e
errs
      ]
    where
      renderErrs :: NonEmpty e -> String
renderErrs =
        Text -> String
T.unpack
          (Text -> String) -> (NonEmpty e -> Text) -> NonEmpty e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyText -> Text
TL.toStrict
          (LazyText -> Text)
-> (NonEmpty e -> LazyText) -> NonEmpty e -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TLB.toLazyText
          (Builder -> LazyText)
-> (NonEmpty e -> Builder) -> NonEmpty e -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Builder -> Builder
forall m. Monoid m => NonEmpty m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
          (NonEmpty Builder -> Builder)
-> (NonEmpty e -> NonEmpty Builder) -> NonEmpty e -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, e) -> Builder) -> NonEmpty (Int, e) -> NonEmpty Builder
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, e) -> Builder
forall {b} {a}. (Exception b, Show a) => (a, b) -> Builder
renderErr
          (NonEmpty (Int, e) -> NonEmpty Builder)
-> (NonEmpty e -> NonEmpty (Int, e))
-> NonEmpty e
-> NonEmpty Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip @Int (Int
1 Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [Int
2 ..])

      renderErr :: (a, b) -> Builder
renderErr (a
idx, b
e) =
        (\Builder
b -> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TLB.fromString (a -> String
forall a. Show a => a -> String
show a
idx) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
". " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b)
          (Builder -> Builder) -> (b -> Builder) -> b -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
TLB.fromString
          (String -> Builder) -> (b -> String) -> b -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> String
forall e. Exception e => e -> String
displayException
          (b -> Builder) -> b -> Builder
forall a b. (a -> b) -> a -> b
$ b
e

-- | @since 0.1
mkExceptions :: forall e. e -> Exceptions e
mkExceptions :: forall a. a -> Exceptions a
mkExceptions = NonEmpty e -> Exceptions e
forall e. NonEmpty e -> Exceptions e
MkExceptions (NonEmpty e -> Exceptions e)
-> (e -> NonEmpty e) -> e -> Exceptions e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> NonEmpty e
forall a. a -> NonEmpty a
NE.singleton

-- | Wrapper for 'Q' over 'Either' with a lazier 'Semigroup'. With this, we
-- can run:
--
-- @
--   MkQFirst q1 <> MkQFirst q2
-- @
--
-- This will only execute @q2@ if @q1@ returns 'Left', unlike 'Q'\'s normal
-- 'Semigroup' instance.
--
-- 'QFirst' also collects all errors in 'Exceptions'.
--
-- @since 0.1
newtype QFirst e a = MkQFirst {forall e a. QFirst e a -> Q (Either (Exceptions e) a)
unQFirst :: Q (Either (Exceptions e) a)}
  deriving stock
    ( -- | @since 0.1
      (forall a b. (a -> b) -> QFirst e a -> QFirst e b)
-> (forall a b. a -> QFirst e b -> QFirst e a)
-> Functor (QFirst e)
forall a b. a -> QFirst e b -> QFirst e a
forall a b. (a -> b) -> QFirst e a -> QFirst e b
forall e a b. a -> QFirst e b -> QFirst e a
forall e a b. (a -> b) -> QFirst e a -> QFirst e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall e a b. (a -> b) -> QFirst e a -> QFirst e b
fmap :: forall a b. (a -> b) -> QFirst e a -> QFirst e b
$c<$ :: forall e a b. a -> QFirst e b -> QFirst e a
<$ :: forall a b. a -> QFirst e b -> QFirst e a
Functor
    )

-- | @since 0.1
instance Bifunctor QFirst where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> QFirst a c -> QFirst b d
bimap a -> b
f c -> d
g (MkQFirst Q (Either (Exceptions a) c)
q) = Q (Either (Exceptions b) d) -> QFirst b d
forall e a. Q (Either (Exceptions e) a) -> QFirst e a
MkQFirst (Q (Either (Exceptions b) d) -> QFirst b d)
-> Q (Either (Exceptions b) d) -> QFirst b d
forall a b. (a -> b) -> a -> b
$ (Either (Exceptions a) c -> Either (Exceptions b) d)
-> Q (Either (Exceptions a) c) -> Q (Either (Exceptions b) d)
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Exceptions a -> Exceptions b)
-> (c -> d) -> Either (Exceptions a) c -> Either (Exceptions b) d
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((a -> b) -> Exceptions a -> Exceptions b
forall a b. (a -> b) -> Exceptions a -> Exceptions b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) c -> d
g) Q (Either (Exceptions a) c)
q

-- | @since 0.1
instance Semigroup (QFirst e a) where
  MkQFirst Q (Either (Exceptions e) a)
q1 <> :: QFirst e a -> QFirst e a -> QFirst e a
<> QFirst e a
q2 =
    Q (Either (Exceptions e) a) -> QFirst e a
forall e a. Q (Either (Exceptions e) a) -> QFirst e a
MkQFirst (Q (Either (Exceptions e) a) -> QFirst e a)
-> Q (Either (Exceptions e) a) -> QFirst e a
forall a b. (a -> b) -> a -> b
$
      Q (Either (Exceptions e) a)
q1 Q (Either (Exceptions e) a)
-> (Either (Exceptions e) a -> Q (Either (Exceptions e) a))
-> Q (Either (Exceptions e) a)
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right a
x -> Either (Exceptions e) a -> Q (Either (Exceptions e) a)
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Exceptions e) a -> Q (Either (Exceptions e) a))
-> Either (Exceptions e) a -> Q (Either (Exceptions e) a)
forall a b. (a -> b) -> a -> b
$ a -> Either (Exceptions e) a
forall a b. b -> Either a b
Right a
x
        Left Exceptions e
errs -> (Exceptions e -> Exceptions e)
-> Either (Exceptions e) a -> Either (Exceptions e) a
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 (Exceptions e
errs Exceptions e -> Exceptions e -> Exceptions e
forall a. Semigroup a => a -> a -> a
<>) (Either (Exceptions e) a -> Either (Exceptions e) a)
-> Q (Either (Exceptions e) a) -> Q (Either (Exceptions e) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QFirst e a -> Q (Either (Exceptions e) a)
forall e a. QFirst e a -> Q (Either (Exceptions e) a)
unQFirst QFirst e a
q2

-- | @since 0.1
mkQFirst :: forall e a. Q (Either e a) -> QFirst e a
mkQFirst :: forall e a. Q (Either e a) -> QFirst e a
mkQFirst = Q (Either (Exceptions e) a) -> QFirst e a
forall e a. Q (Either (Exceptions e) a) -> QFirst e a
MkQFirst (Q (Either (Exceptions e) a) -> QFirst e a)
-> (Q (Either e a) -> Q (Either (Exceptions e) a))
-> Q (Either e a)
-> QFirst e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either e a -> Either (Exceptions e) a)
-> Q (Either e a) -> Q (Either (Exceptions e) a)
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> Exceptions e) -> Either e a -> Either (Exceptions e) a
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 e -> Exceptions e
forall a. a -> Exceptions a
mkExceptions)

-- | @firstSuccessQ q qs@ takes the first @qi@ in @q : qs@ that returns
-- 'Right', without executing any @qj@ for @j > i@. If there are no
-- 'Right'\'s, returns the final result.
--
-- ==== __Examples__
--
-- >>> :{
--    $$( qToCode $
--          firstSuccessQ
--            (pure (Left GitNotFound))
--            [ gitHashQ,
--              error "oh no"
--            ]
--      )
-- :}
-- Right ...
--
-- @since 0.1
firstSuccessQ ::
  forall e a.
  Q (Either e a) ->
  [Q (Either e a)] ->
  Q (Either (Exceptions e) a)
firstSuccessQ :: forall e a.
Q (Either e a) -> [Q (Either e a)] -> Q (Either (Exceptions e) a)
firstSuccessQ Q (Either e a)
q [Q (Either e a)]
qs = QFirst e a -> Q (Either (Exceptions e) a)
forall e a. QFirst e a -> Q (Either (Exceptions e) a)
unQFirst (QFirst e a -> Q (Either (Exceptions e) a))
-> QFirst e a -> Q (Either (Exceptions e) a)
forall a b. (a -> b) -> a -> b
$ (Q (Either e a) -> QFirst e a)
-> NonEmpty (Q (Either e a)) -> QFirst e a
forall m a. Semigroup m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 Q (Either e a) -> QFirst e a
forall e a. Q (Either e a) -> QFirst e a
mkQFirst (Q (Either e a)
q Q (Either e a) -> [Q (Either e a)] -> NonEmpty (Q (Either e a))
forall a. a -> [a] -> NonEmpty a
:| [Q (Either e a)]
qs)

-- | Projects 'Left' to the string @UNKNOWN@.
--
-- ==== __Examples__
--
-- >>> :{
--   let gitHashUnknownQ :: Q String
--       gitHashUnknownQ = projectStringUnknown gitHashQ
--   -- inling gitHashUnknownQ here due to stage restriction
--   in $$(qToCode $ projectStringUnknown gitHashQ)
-- :}
-- ...
--
-- >>> $$(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.
Functor f =>
String -> f (Either e String) -> f String
projectString String
"UNKNOWN"

-- | Projects 'Left' to the given string.
--
-- ==== __Examples__
--
-- >>> :{
--   let gitHashDefStringQ :: Q String
--       gitHashDefStringQ = projectString "FAILURE" gitHashQ
--   in $$(qToCode $ projectString "FAILURE" gitHashQ)
-- :}
-- ...
--
-- >>> $$(qToCode $ projectString "FAILURE" (pure $ Left ()))
-- "FAILURE"
--
-- @since 0.1
projectString ::
  forall f e.
  (Functor f) =>
  String ->
  f (Either e String) ->
  f String
projectString :: forall (f :: * -> *) e.
Functor f =>
String -> f (Either e String) -> f String
projectString = (e -> String) -> f (Either e String) -> f String
forall (f :: * -> *) e a.
Functor f =>
(e -> a) -> f (Either e a) -> f a
projectLeft ((e -> String) -> f (Either e String) -> f String)
-> (String -> e -> String)
-> String
-> f (Either e String)
-> f String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> e -> String
forall a b. a -> b -> a
const

-- | Projects 'Left' to 'False'.
--
-- ==== __Examples__
--
-- >>> :{
--   let gitDirtyDefFalseQ :: Q Bool
--       gitDirtyDefFalseQ = projectFalse gitDirtyQ
--   in $$(qToCode $ projectFalse gitDirtyQ)
-- :}
-- ...
--
-- >>> $$(qToCode $ projectFalse (pure $ Left ()))
-- False
--
-- @since 0.1
projectFalse :: forall f e. (Functor f) => f (Either e Bool) -> f Bool
projectFalse :: forall (f :: * -> *) e. Functor f => f (Either e Bool) -> f Bool
projectFalse = (e -> Bool) -> f (Either e Bool) -> f Bool
forall (f :: * -> *) e a.
Functor f =>
(e -> a) -> f (Either e a) -> f a
projectLeft (Bool -> e -> Bool
forall a b. a -> b -> a
const Bool
False)

-- | Projects 'Left' via 'error', rendering via 'displayException'. Hence
-- an error will cause a compilation failure.
--
-- ==== __Examples__
--
-- >>> :{
--   let gitHashOrDieQ :: Q String
--       gitHashOrDieQ = projectError gitHashQ
--   in $$(qToCode $ projectError gitHashQ)
-- :}
-- ...
--
-- @since 0.1
projectError :: forall f e a. (Exception e, Functor f) => f (Either e a) -> f a
projectError :: forall (f :: * -> *) e a.
(Exception e, Functor f) =>
f (Either e a) -> f a
projectError = (e -> String) -> f (Either e a) -> f a
forall (f :: * -> *) e a.
Functor f =>
(e -> String) -> f (Either e a) -> f a
projectErrorMap e -> String
forall e. Exception e => e -> String
displayException

-- | Projects 'Left' via 'error', rendering via the given function. Hence
-- an error will cause a compilation failure.
--
-- ==== __Examples__
--
-- >>> :{
--   let gitHashOrDieQ :: Q String
--       gitHashOrDieQ = (projectErrorMap show) gitHashQ
--   in $$(qToCode $ (projectErrorMap show) gitHashQ)
-- :}
-- ...
--
-- @since 0.1
projectErrorMap ::
  forall f e a.
  (Functor f) =>
  (e -> String) ->
  f (Either e a) ->
  f a
projectErrorMap :: forall (f :: * -> *) e a.
Functor f =>
(e -> String) -> f (Either e a) -> f a
projectErrorMap e -> String
onErr = (e -> a) -> f (Either e a) -> f a
forall (f :: * -> *) e a.
Functor f =>
(e -> a) -> f (Either e a) -> f a
projectLeft (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (e -> String) -> e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
onErr)

projectLeft :: forall f e a. (Functor f) => (e -> a) -> f (Either e a) -> f a
projectLeft :: forall (f :: * -> *) e a.
Functor f =>
(e -> a) -> f (Either e a) -> f a
projectLeft e -> a
f = (Either e a -> a) -> f (Either e a) -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((e -> a) -> (a -> a) -> Either e a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> a
f a -> a
forall a. a -> a
id)

-- | Git or env lookup error.
--
-- @since 0.1
data GitOrLookupEnvError
  = -- | @since 0.1
    GitOrLookupEnvGit GitError
  | -- | @since 0.1
    GitOrLookupEnvLookupEnv LookupEnvError
  deriving stock
    ( -- | @since 0.1
      GitOrLookupEnvError -> GitOrLookupEnvError -> Bool
(GitOrLookupEnvError -> GitOrLookupEnvError -> Bool)
-> (GitOrLookupEnvError -> GitOrLookupEnvError -> Bool)
-> Eq GitOrLookupEnvError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitOrLookupEnvError -> GitOrLookupEnvError -> Bool
== :: GitOrLookupEnvError -> GitOrLookupEnvError -> Bool
$c/= :: GitOrLookupEnvError -> GitOrLookupEnvError -> Bool
/= :: GitOrLookupEnvError -> GitOrLookupEnvError -> Bool
Eq,
      -- | @since 0.1
      (forall (m :: * -> *). Quote m => GitOrLookupEnvError -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    GitOrLookupEnvError -> Code m GitOrLookupEnvError)
-> Lift GitOrLookupEnvError
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => GitOrLookupEnvError -> m Exp
forall (m :: * -> *).
Quote m =>
GitOrLookupEnvError -> Code m GitOrLookupEnvError
$clift :: forall (m :: * -> *). Quote m => GitOrLookupEnvError -> m Exp
lift :: forall (m :: * -> *). Quote m => GitOrLookupEnvError -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
GitOrLookupEnvError -> Code m GitOrLookupEnvError
liftTyped :: forall (m :: * -> *).
Quote m =>
GitOrLookupEnvError -> Code m GitOrLookupEnvError
Lift,
      -- | @since 0.1
      Int -> GitOrLookupEnvError -> ShowS
[GitOrLookupEnvError] -> ShowS
GitOrLookupEnvError -> String
(Int -> GitOrLookupEnvError -> ShowS)
-> (GitOrLookupEnvError -> String)
-> ([GitOrLookupEnvError] -> ShowS)
-> Show GitOrLookupEnvError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitOrLookupEnvError -> ShowS
showsPrec :: Int -> GitOrLookupEnvError -> ShowS
$cshow :: GitOrLookupEnvError -> String
show :: GitOrLookupEnvError -> String
$cshowList :: [GitOrLookupEnvError] -> ShowS
showList :: [GitOrLookupEnvError] -> ShowS
Show
    )

-- | @since 0.1
instance Exception GitOrLookupEnvError where
  displayException :: GitOrLookupEnvError -> String
displayException (GitOrLookupEnvGit GitError
ge) = GitError -> String
forall e. Exception e => e -> String
displayException GitError
ge
  displayException (GitOrLookupEnvLookupEnv LookupEnvError
x) = LookupEnvError -> String
forall e. Exception e => e -> String
displayException LookupEnvError
x

-- | @runGitInEnvDirQ var q@ runs @q@ in the directory given by the
-- 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 GitOrLookupEnvError a)
runGitInEnvDirQ :: forall a.
String -> Q (Either GitError a) -> Q (Either GitOrLookupEnvError a)
runGitInEnvDirQ String
var = Q (Either LookupEnvError (Either GitError a))
-> Q (Either GitOrLookupEnvError a)
forall {a}.
Q (Either LookupEnvError (Either GitError a))
-> Q (Either GitOrLookupEnvError a)
joinErrors (Q (Either LookupEnvError (Either GitError a))
 -> Q (Either GitOrLookupEnvError a))
-> (Q (Either GitError a)
    -> Q (Either LookupEnvError (Either GitError a)))
-> Q (Either GitError a)
-> Q (Either GitOrLookupEnvError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Q (Either GitError a)
-> Q (Either LookupEnvError (Either GitError a))
forall a. String -> Q a -> Q (Either LookupEnvError a)
Env.runInEnvDirQ String
var
  where
    joinErrors :: Q (Either LookupEnvError (Either GitError a))
-> Q (Either GitOrLookupEnvError a)
joinErrors = (Either LookupEnvError (Either GitError a)
 -> Either GitOrLookupEnvError a)
-> Q (Either LookupEnvError (Either GitError a))
-> Q (Either GitOrLookupEnvError a)
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either LookupEnvError (Either GitError a)
-> Either GitOrLookupEnvError a
forall (p :: * -> * -> *) a.
(Bifunctor p, forall e. Monad (p e)) =>
p LookupEnvError (p GitError a) -> p GitOrLookupEnvError a
joinLookupEnvGitErrors

-- | Utility function for joining lookup and git errors.
--
-- ==== __Examples__
--
-- >>> :{
--   let e :: Either LookupEnvError (Either GitError ())
--       e = Right (Left GitNotFound)
--   in joinLookupEnvGitErrors e
-- :}
-- Left (GitOrLookupEnvGit GitNotFound)
--
-- @since 0.1
joinLookupEnvGitErrors ::
  forall p a.
  ( Bifunctor p,
    forall e. Monad (p e)
  ) =>
  -- | .
  p LookupEnvError (p GitError a) ->
  p GitOrLookupEnvError a
joinLookupEnvGitErrors :: forall (p :: * -> * -> *) a.
(Bifunctor p, forall e. Monad (p e)) =>
p LookupEnvError (p GitError a) -> p GitOrLookupEnvError a
joinLookupEnvGitErrors =
  p GitOrLookupEnvError (p GitOrLookupEnvError a)
-> p GitOrLookupEnvError a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    (p GitOrLookupEnvError (p GitOrLookupEnvError a)
 -> p GitOrLookupEnvError a)
-> (p LookupEnvError (p GitError a)
    -> p GitOrLookupEnvError (p GitOrLookupEnvError a))
-> p LookupEnvError (p GitError a)
-> p GitOrLookupEnvError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p GitOrLookupEnvError (p GitError a)
-> p GitOrLookupEnvError (p GitOrLookupEnvError a)
forall (f :: * -> *) (p :: * -> * -> *) a.
(Bifunctor p, Functor f) =>
f (p GitError a) -> f (p GitOrLookupEnvError a)
embedGitError
    (p GitOrLookupEnvError (p GitError a)
 -> p GitOrLookupEnvError (p GitOrLookupEnvError a))
-> (p LookupEnvError (p GitError a)
    -> p GitOrLookupEnvError (p GitError a))
-> p LookupEnvError (p GitError a)
-> p GitOrLookupEnvError (p GitOrLookupEnvError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LookupEnvError -> GitOrLookupEnvError)
-> p LookupEnvError (p GitError a)
-> p GitOrLookupEnvError (p GitError 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 LookupEnvError -> GitOrLookupEnvError
GitOrLookupEnvLookupEnv

-- | Utility function for joining git and lookup errors.
--
-- ==== __Examples__
--
-- >>> :{
--   let e :: Either GitError (Either LookupEnvError ())
--       e = Right (Left $ MkLookupEnvError "VAR")
--   in joinGitLookupEnvErrors e
-- :}
-- Left (GitOrLookupEnvLookupEnv (MkLookupEnvError "VAR"))
--
-- @since 0.1
joinGitLookupEnvErrors ::
  forall p a.
  ( Bifunctor p,
    forall e. Monad (p e)
  ) =>
  -- | .
  p GitError (p LookupEnvError a) ->
  p GitOrLookupEnvError a
joinGitLookupEnvErrors :: forall (p :: * -> * -> *) a.
(Bifunctor p, forall e. Monad (p e)) =>
p GitError (p LookupEnvError a) -> p GitOrLookupEnvError a
joinGitLookupEnvErrors =
  p GitOrLookupEnvError (p GitOrLookupEnvError a)
-> p GitOrLookupEnvError a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    (p GitOrLookupEnvError (p GitOrLookupEnvError a)
 -> p GitOrLookupEnvError a)
-> (p GitError (p LookupEnvError a)
    -> p GitOrLookupEnvError (p GitOrLookupEnvError a))
-> p GitError (p LookupEnvError a)
-> p GitOrLookupEnvError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p GitOrLookupEnvError (p LookupEnvError a)
-> p GitOrLookupEnvError (p GitOrLookupEnvError a)
forall (f :: * -> *) (p :: * -> * -> *) a.
(Bifunctor p, Functor f) =>
f (p LookupEnvError a) -> f (p GitOrLookupEnvError a)
embedLookupEnvError
    (p GitOrLookupEnvError (p LookupEnvError a)
 -> p GitOrLookupEnvError (p GitOrLookupEnvError a))
-> (p GitError (p LookupEnvError a)
    -> p GitOrLookupEnvError (p LookupEnvError a))
-> p GitError (p LookupEnvError a)
-> p GitOrLookupEnvError (p GitOrLookupEnvError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GitError -> GitOrLookupEnvError)
-> p GitError (p LookupEnvError a)
-> p GitOrLookupEnvError (p LookupEnvError 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 -> GitOrLookupEnvError
GitOrLookupEnvGit

-- | Embeds a 'GitError' in the larger 'GitOrLookupEnvError'.
--
-- ==== __Examples__
--
-- >>> :{
--   let q :: Q (Either GitError ())
--       q = pure (Left GitNotFound)
--   in runQ $ embedGitError q
-- :}
-- Left (GitOrLookupEnvGit GitNotFound)
--
-- @since 0.1
embedGitError ::
  forall f p a.
  ( Bifunctor p,
    Functor f
  ) =>
  -- | .
  f (p GitError a) ->
  f (p GitOrLookupEnvError a)
embedGitError :: forall (f :: * -> *) (p :: * -> * -> *) a.
(Bifunctor p, Functor f) =>
f (p GitError a) -> f (p GitOrLookupEnvError a)
embedGitError = (p GitError a -> p GitOrLookupEnvError a)
-> f (p GitError a) -> f (p GitOrLookupEnvError a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GitError -> GitOrLookupEnvError)
-> p GitError a -> p GitOrLookupEnvError 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 -> GitOrLookupEnvError
GitOrLookupEnvGit)

-- | Embeds a 'LookupEnvError' in the larger 'GitOrLookupEnvError'.
--
-- ==== __Examples__
--
-- >>> :{
--   let q :: Q (Either LookupEnvError ())
--       q = pure (Left $ MkLookupEnvError "VAR")
--   in runQ $ embedLookupEnvError q
-- :}
-- Left (GitOrLookupEnvLookupEnv (MkLookupEnvError "VAR"))
--
-- @since 0.1
embedLookupEnvError ::
  forall f p a.
  ( Bifunctor p,
    Functor f
  ) =>
  -- | .
  f (p LookupEnvError a) ->
  f (p GitOrLookupEnvError a)
embedLookupEnvError :: forall (f :: * -> *) (p :: * -> * -> *) a.
(Bifunctor p, Functor f) =>
f (p LookupEnvError a) -> f (p GitOrLookupEnvError a)
embedLookupEnvError = (p LookupEnvError a -> p GitOrLookupEnvError a)
-> f (p LookupEnvError a) -> f (p GitOrLookupEnvError a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((LookupEnvError -> GitOrLookupEnvError)
-> p LookupEnvError a -> p GitOrLookupEnvError 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 LookupEnvError -> GitOrLookupEnvError
GitOrLookupEnvLookupEnv)

#if !MIN_VERSION_base(4, 18, 0)
-- Copied from base. Technically not the same as the import above since
-- that one works for all Foldable1, not just NonEmpty, but we only use it
-- here for NonEmpty, so whatever.
foldMap1 :: (Semigroup m) => (a -> m) -> NonEmpty a -> m
foldMap1 f (x :| xs) = go (f x) xs
  where
    go y [] = y
    go y (z : zs) = y <> go (f z) zs
#endif