{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module      : Control.Monad.Trans.Fail.String
-- 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 __@`String`@__. 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.String (
  Fail,
  runFail,
  runFailLast,
  runFailAgg,
  errorFail,
  errorFailWithoutStackTrace,
  FailT,
  F.FailException (..),
  failT,
  failManyT,
  runFailT,
  runFailLastT,
  runFailAggT,
  hoistFailT,
  mapFailT,
  mapErrorFailT,
  mapErrorsFailT,
  exceptFailT,
  throwErrorFailT,
  throwFailT,
) where

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

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

-- | Version of `F.runFail` restricted to `String`
runFail :: Fail a -> Either String a
runFail :: forall a. Fail a -> Either String 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 `String`
runFailLast :: Fail a -> Either String a
runFailLast :: forall a. Fail a -> Either String a
runFailLast = forall e a. IsString e => Fail e a -> Either e a
F.runFailLast
{-# INLINE runFailLast #-}

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

-- | Version of `F.errorFail` restricted to `String`
--
-- 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.runFail` restricted to `String`
--
-- 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 `String`
--
-- Fail monad transformer that plays well with `MonadFail`
type FailT = F.FailT String

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

-- | Version of `F.failManyT` restricted to `String`
--
-- prop> runFailAgg (foldMap failT xs) == runFailAgg (failManyT xs)
--
-- @since 0.1.2
failManyT :: Applicative m => [String] -> FailT m a
failManyT :: forall (m :: * -> *) a. Applicative m => [String] -> FailT m a
failManyT = forall (m :: * -> *) e a. Applicative m => [e] -> FailT e m a
F.failManyT
{-# INLINE failManyT #-}

-- | Version of `F.runFailT` restricted to `String`
runFailT :: Functor m => FailT m a -> m (Either String a)
runFailT :: forall (m :: * -> *) a.
Functor m =>
FailT m a -> m (Either String 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 `String`
runFailLastT :: Functor m => FailT m a -> m (Either String a)
runFailLastT :: forall (m :: * -> *) a.
Functor m =>
FailT m a -> m (Either String 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 `String`
runFailAggT :: FailT m a -> m (Either [String] a)
runFailAggT :: forall (m :: * -> *) a. FailT m a -> m (Either [String] a)
runFailAggT = forall e (m :: * -> *) a. FailT e m a -> m (Either [e] a)
F.runFailAggT
{-# INLINE runFailAggT #-}

-- | Version of `F.hoistFailT` restricted to `String`
--
-- 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 `String`
--
-- Map a function over the underlying representation of the `FailT` monad.
mapFailT :: (m (Either [String] a) -> n (Either [String] b)) -> FailT m a -> FailT n b
mapFailT :: forall (m :: * -> *) a (n :: * -> *) b.
(m (Either [String] a) -> n (Either [String] 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.mapErrorFail`, where resulting type is restricted to `String`
--
-- Map a function over the error type in the `FailT` monad.
mapErrorFailT :: Functor m => (e -> String) -> F.FailT e m a -> FailT m a
mapErrorFailT :: forall (m :: * -> *) e a.
Functor m =>
(e -> String) -> 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 `String`
--
-- 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 []) $ failT "Something went wrong") :: Either String ()
-- Left "No failure reason given"
mapErrorsFailT :: Functor m => ([e] -> [String]) -> F.FailT e m a -> FailT m a
mapErrorsFailT :: forall (m :: * -> *) e a.
Functor m =>
([e] -> [String]) -> 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 `String`
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.throwErrorFailT` restricted to `String`
--
-- Same as `exceptFailT`, but works with any `MonadError`.
--
-- >>> import Control.Monad.Trans.Fail.String
-- >>> throwErrorFailT (fail "A bad thing" >> pure () :: FailT (Except FailException) ())
-- ExceptT (Identity (Left FailException
-- "A bad thing"
-- CallStack (from HasCallStack):
-- ...
throwErrorFailT :: (HasCallStack, MonadError F.FailException m) => FailT m a -> m a
throwErrorFailT :: forall (m :: * -> *) a.
(HasCallStack, MonadError FailException m) =>
FailT m a -> m a
throwErrorFailT = forall e (m :: * -> *) a.
(HasCallStack, Typeable e, Show e, MonadError FailException m) =>
FailT e m a -> m a
F.throwErrorFailT
{-# INLINE throwErrorFailT #-}

-- | Version of `F.throwFailT` restricted to `String`
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 #-}