{-# LANGUAGE RankNTypes #-}

-- |
-- Module      : Control.Monad.Trans.Fail.Text
-- Copyright   : (c) Alexey Kuleshevich 2022-2023
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
-- This module contains a synonym for __@`F.FailT` e m a@__ transformer, where failure
-- type __@e@__ is restricted to __@`Text`@__. All functions in this module have the same
-- names and are a drop-in replacement for "Control.Monad.Trans.Fail" module, except with
-- monomorphic failure type.
module Control.Monad.Trans.Fail.Text (
  Fail,
  runFail,
  runFailLast,
  runFailAgg,
  errorFail,
  errorFailWithoutStackTrace,
  FailT,
  F.FailException (..),
  failT,
  runFailT,
  runFailLastT,
  runFailAggT,
  hoistFailT,
  mapFailT,
  mapErrorFailT,
  mapErrorsFailT,
  exceptFailT,
  throwFailT,
) where

import Control.Monad.Catch (MonadThrow)
import Control.Monad.Except
import qualified Control.Monad.Trans.Fail as F
import Data.Text (Text)
import GHC.Stack

-- | Version of `F.Fail` restricted to `Text`
type Fail = F.Fail Text

-- | Version of `F.runFail` restricted to `Text`
runFail :: Fail a -> Either Text a
runFail :: forall a. Fail a -> Either Text a
runFail = forall e a. (IsString e, Semigroup e) => Fail e a -> Either e a
F.runFail
{-# INLINE runFail #-}

-- | Version of `F.runFailLast` restricted to `Text`
runFailLast :: Fail a -> Either Text a
runFailLast :: forall a. Fail a -> Either Text a
runFailLast = forall e a. IsString e => Fail e a -> Either e a
F.runFailLast
{-# INLINE runFailLast #-}

-- | Version of `F.runFailAgg` restricted to `Text`
runFailAgg :: Fail a -> Either [Text] a
runFailAgg :: forall a. Fail a -> Either [Text] a
runFailAgg = forall e a. Fail e a -> Either [e] a
F.runFailAgg
{-# INLINE runFailAgg #-}

-- | Version of `F.errorFail` restricted to `Text`
--
-- Throw an error if there was a failure, otherwise return the result of monadic
-- computation. Use `throwFailT` in case you'd like to handle an actual exception.
errorFail :: HasCallStack => Fail a -> a
errorFail :: forall a. HasCallStack => Fail a -> a
errorFail = forall e a. (Show e, HasCallStack) => Fail e a -> a
F.errorFail

-- | Version of `F.errorFailWithoutStackTrace` restricted to `Text`
--
-- Same as `errorFail`, but without the stack trace:
--
-- >>> errorFailWithoutStackTrace (fail "This didn't work" :: Fail ())
-- *** Exception: "This didn't work"
-- >>> import Control.Applicative
-- >>> errorFailWithoutStackTrace (fail "This didn't work" <|> pure "That Worked" :: Fail String)
-- "That Worked"
errorFailWithoutStackTrace :: Fail a -> a
errorFailWithoutStackTrace :: forall a. Fail a -> a
errorFailWithoutStackTrace = forall e a. Show e => Fail e a -> a
F.errorFailWithoutStackTrace

-- | Version of `F.FailT` restricted to `Text`
--
-- Fail monad transformer that plays well with `MonadFail`
type FailT = F.FailT Text

-- | Version of `F.failT` restricted to `Text`
--
-- Monomorphic synonym for `fail`
failT :: Applicative m => Text -> FailT m a
failT :: forall (m :: * -> *) a. Applicative m => Text -> FailT m a
failT = forall (m :: * -> *) e a. Applicative m => e -> FailT e m a
F.failT
{-# INLINE failT #-}

-- | Version of `F.runFailT` restricted to `Text`
runFailT :: Functor m => FailT m a -> m (Either Text a)
runFailT :: forall (m :: * -> *) a. Functor m => FailT m a -> m (Either Text a)
runFailT = forall e (m :: * -> *) a.
(IsString e, Semigroup e, Functor m) =>
FailT e m a -> m (Either e a)
F.runFailT
{-# INLINE runFailT #-}

-- | Version of `F.runFailLastT` restricted to `Text`
runFailLastT :: Functor m => FailT m a -> m (Either Text a)
runFailLastT :: forall (m :: * -> *) a. Functor m => FailT m a -> m (Either Text a)
runFailLastT = forall e (m :: * -> *) a.
(IsString e, Functor m) =>
FailT e m a -> m (Either e a)
F.runFailLastT
{-# INLINE runFailLastT #-}

-- | Version of `F.runFailAggT` restricted to `Text`
runFailAggT :: FailT m a -> m (Either [Text] a)
runFailAggT :: forall (m :: * -> *) a. FailT m a -> m (Either [Text] a)
runFailAggT = forall e (m :: * -> *) a. FailT e m a -> m (Either [e] a)
F.runFailAggT
{-# INLINE runFailAggT #-}

-- | Version of `F.hoistFailT` restricted to `Text`
--
-- Change the underlying monad with the hoisting function
hoistFailT :: (forall a. m a -> n a) -> FailT m b -> FailT n b
hoistFailT :: forall (m :: * -> *) (n :: * -> *) b.
(forall a. m a -> n a) -> FailT m b -> FailT n b
hoistFailT = forall (m :: * -> *) (n :: * -> *) e b.
(forall a. m a -> n a) -> FailT e m b -> FailT e n b
F.hoistFailT
{-# INLINE hoistFailT #-}

-- | Version of `F.mapFailT` restricted to `Text`
--
-- Map a function over the underlying representation of the `FailT` monad.
mapFailT :: (m (Either [Text] a) -> n (Either [Text] b)) -> FailT m a -> FailT n b
mapFailT :: forall (m :: * -> *) a (n :: * -> *) b.
(m (Either [Text] a) -> n (Either [Text] b))
-> FailT m a -> FailT n b
mapFailT = forall (m :: * -> *) e a (n :: * -> *) b.
(m (Either [e] a) -> n (Either [e] b))
-> FailT e m a -> FailT e n b
F.mapFailT
{-# INLINE mapFailT #-}

-- | Version of `F.mapErrorFailT` where resulting type is restricted to `Text`
--
-- Map a function over the error type in the `FailT` monad.
mapErrorFailT :: Functor m => (e -> Text) -> F.FailT e m a -> FailT m a
mapErrorFailT :: forall (m :: * -> *) e a.
Functor m =>
(e -> Text) -> FailT e m a -> FailT m a
mapErrorFailT = forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> FailT e m a -> FailT e' m a
F.mapErrorFailT
{-# INLINE mapErrorFailT #-}

-- | Version of `F.mapErrorsFail`, where resulting type is restricted to `Text`
--
-- Map a function over the aggregation of errors in the `FailT` monad. Could be used for
-- example for clearing our all of the aggregated error messages:
--
-- >>> runFail (mapErrorsFailT (const [] :: [Text] -> [Text]) $ fail "Something went wrong" >> pure ())
-- Left "No failure reason given"
mapErrorsFailT :: Functor m => ([e] -> [Text]) -> F.FailT e m a -> FailT m a
mapErrorsFailT :: forall (m :: * -> *) e a.
Functor m =>
([e] -> [Text]) -> FailT e m a -> FailT m a
mapErrorsFailT = forall (m :: * -> *) e e' a.
Functor m =>
([e] -> [e']) -> FailT e m a -> FailT e' m a
F.mapErrorsFailT
{-# INLINE mapErrorsFailT #-}

-- | Version of `F.exceptFailT` restricted to `Text`
exceptFailT :: (HasCallStack, Monad m) => FailT m a -> ExceptT F.FailException m a
exceptFailT :: forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
FailT m a -> ExceptT FailException m a
exceptFailT = forall e (m :: * -> *) a.
(HasCallStack, Typeable e, Show e, Monad m) =>
FailT e m a -> ExceptT FailException m a
F.exceptFailT
{-# INLINE exceptFailT #-}

-- | Version of `F.throwFailT` restricted to `Text`
throwFailT :: (HasCallStack, MonadThrow m) => FailT m a -> m a
throwFailT :: forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
FailT m a -> m a
throwFailT = forall e (m :: * -> *) a.
(HasCallStack, Typeable e, Show e, MonadThrow m) =>
FailT e m a -> m a
F.throwFailT
{-# INLINE throwFailT #-}