{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Ext.Result
( Result (..),
ResultT (..),
mapEvent,
cleanEvents,
PushEvents (..),
resultOr,
sortErrors,
toEither,
GQLResult,
)
where
import Control.Monad.Except (MonadError (..))
import qualified Data.List.NonEmpty as NE
import Data.Morpheus.Types.Internal.AST.Error
( GQLError (..),
GQLError,
)
import Data.Text.Lazy.Builder ()
import Relude
type GQLResult = Result GQLError
class PushEvents e m where
pushEvents :: [e] -> m ()
data Result err a
= Success {forall err a. Result err a -> a
result :: a, forall err a. Result err a -> [err]
warnings :: [err]}
| Failure {forall err a. Result err a -> NonEmpty err
errors :: NonEmpty err}
deriving (forall a b. a -> Result err b -> Result err a
forall a b. (a -> b) -> Result err a -> Result err b
forall err a b. a -> Result err b -> Result err a
forall err a b. (a -> b) -> Result err a -> Result err b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Result err b -> Result err a
$c<$ :: forall err a b. a -> Result err b -> Result err a
fmap :: forall a b. (a -> b) -> Result err a -> Result err b
$cfmap :: forall err a b. (a -> b) -> Result err a -> Result err b
Functor)
instance Applicative (Result er) where
pure :: forall a. a -> Result er a
pure a
x = forall err a. a -> [err] -> Result err a
Success a
x []
Success a -> b
f [er]
w1 <*> :: forall a b. Result er (a -> b) -> Result er a -> Result er b
<*> Success a
x [er]
w2 = forall err a. a -> [err] -> Result err a
Success (a -> b
f a
x) ([er]
w1 forall a. Semigroup a => a -> a -> a
<> [er]
w2)
Failure NonEmpty er
e1 <*> Failure NonEmpty er
e2 = forall err a. NonEmpty err -> Result err a
Failure (NonEmpty er
e1 forall a. Semigroup a => a -> a -> a
<> NonEmpty er
e2)
Failure (er
e :| [er]
es) <*> Success a
_ [er]
w = forall err a. NonEmpty err -> Result err a
Failure (er
e forall a. a -> [a] -> NonEmpty a
:| [er]
es forall a. Semigroup a => a -> a -> a
<> [er]
w)
Success a -> b
_ [er]
w <*> Failure (er
e :| [er]
es) = forall err a. NonEmpty err -> Result err a
Failure (er
e forall a. a -> [a] -> NonEmpty a
:| [er]
es forall a. Semigroup a => a -> a -> a
<> [er]
w)
instance Monad (Result er) where
return :: forall a. a -> Result er a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Success a
v [er]
w1 >>= :: forall a b. Result er a -> (a -> Result er b) -> Result er b
>>= a -> Result er b
fm = case a -> Result er b
fm a
v of
(Success b
x [er]
w2) -> forall err a. a -> [err] -> Result err a
Success b
x ([er]
w1 forall a. Semigroup a => a -> a -> a
<> [er]
w2)
(Failure (er
e :| [er]
es)) -> forall err a. NonEmpty err -> Result err a
Failure (er
e forall a. a -> [a] -> NonEmpty a
:| [er]
es forall a. Semigroup a => a -> a -> a
<> [er]
w1)
Failure NonEmpty er
e >>= a -> Result er b
_ = forall err a. NonEmpty err -> Result err a
Failure NonEmpty er
e
instance Bifunctor Result where
bimap :: forall a b c d. (a -> b) -> (c -> d) -> Result a c -> Result b d
bimap a -> b
f c -> d
g Success {c
[a]
warnings :: [a]
result :: c
warnings :: forall err a. Result err a -> [err]
result :: forall err a. Result err a -> a
..} = Success {warnings :: [b]
warnings = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
warnings, result :: d
result = c -> d
g c
result, ..}
bimap a -> b
f c -> d
_ Failure {NonEmpty a
errors :: NonEmpty a
errors :: forall err a. Result err a -> NonEmpty err
..} = forall err a. NonEmpty err -> Result err a
Failure (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty a
errors)
instance MonadError er (Result er) where
throwError :: forall a. er -> Result er a
throwError = forall err a. NonEmpty err -> Result err a
Failure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
catchError :: forall a. Result er a -> (er -> Result er a) -> Result er a
catchError (Failure (er
x :| [er]
_)) er -> Result er a
f = er -> Result er a
f er
x
catchError Result er a
x er -> Result er a
_ = Result er a
x
instance IsString err => MonadFail (Result err) where
fail :: forall a. String -> Result err a
fail = forall err a. NonEmpty err -> Result err a
Failure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
resultOr :: (NonEmpty err -> a') -> (a -> a') -> Result err a -> a'
resultOr :: forall err a' a.
(NonEmpty err -> a') -> (a -> a') -> Result err a -> a'
resultOr NonEmpty err -> a'
_ a -> a'
f Success {a
result :: a
result :: forall err a. Result err a -> a
result} = a -> a'
f a
result
resultOr NonEmpty err -> a'
f a -> a'
_ Failure {NonEmpty err
errors :: NonEmpty err
errors :: forall err a. Result err a -> NonEmpty err
errors} = NonEmpty err -> a'
f NonEmpty err
errors
sortErrors :: Result GQLError a -> Result GQLError a
sortErrors :: forall a. Result GQLError a -> Result GQLError a
sortErrors (Failure NonEmpty GQLError
errors) = forall err a. NonEmpty err -> Result err a
Failure (forall a. Ord a => NonEmpty a -> NonEmpty a
NE.sort NonEmpty GQLError
errors)
sortErrors Result GQLError a
x = Result GQLError a
x
newtype ResultT event (m :: Type -> Type) a = ResultT
{ forall event (m :: * -> *) a.
ResultT event m a -> m (Result GQLError ([event], a))
runResultT :: m (Result GQLError ([event], a))
}
deriving (forall a b. a -> ResultT event m b -> ResultT event m a
forall a b. (a -> b) -> ResultT event m a -> ResultT event m b
forall event (m :: * -> *) a b.
Functor m =>
a -> ResultT event m b -> ResultT event m a
forall event (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResultT event m a -> ResultT event m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ResultT event m b -> ResultT event m a
$c<$ :: forall event (m :: * -> *) a b.
Functor m =>
a -> ResultT event m b -> ResultT event m a
fmap :: forall a b. (a -> b) -> ResultT event m a -> ResultT event m b
$cfmap :: forall event (m :: * -> *) a b.
Functor m =>
(a -> b) -> ResultT event m a -> ResultT event m b
Functor)
instance Applicative m => Applicative (ResultT event m) where
pure :: forall a. a -> ResultT event m a
pure = forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],)
ResultT m (Result GQLError ([event], a -> b))
app1 <*> :: forall a b.
ResultT event m (a -> b) -> ResultT event m a -> ResultT event m b
<*> ResultT m (Result GQLError ([event], a))
app2 = forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (forall (f :: * -> *) event a b.
Monad f =>
f ([event], a -> b) -> f (([event], a) -> ([event], b))
fx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result GQLError ([event], a -> b))
app1) m (Result GQLError ([event], a))
app2
where
fx :: Monad f => f ([event], a -> b) -> f (([event], a) -> ([event], b))
fx :: forall (f :: * -> *) event a b.
Monad f =>
f ([event], a -> b) -> f (([event], a) -> ([event], b))
fx f ([event], a -> b)
x = do
([event]
e', a -> b
f) <- f ([event], a -> b)
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \([event]
e, a
a) -> ([event]
e forall a. Semigroup a => a -> a -> a
<> [event]
e', a -> b
f a
a)
instance Monad m => Monad (ResultT event m) where
return :: forall a. a -> ResultT event m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
(ResultT m (Result GQLError ([event], a))
m1) >>= :: forall a b.
ResultT event m a -> (a -> ResultT event m b) -> ResultT event m b
>>= a -> ResultT event m b
mFunc = forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT forall a b. (a -> b) -> a -> b
$ do
Result GQLError ([event], a)
result <- m (Result GQLError ([event], a))
m1
case Result GQLError ([event], a)
result of
Failure NonEmpty GQLError
errors -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall err a. NonEmpty err -> Result err a
Failure NonEmpty GQLError
errors
Success ([event]
events, a
value) [GQLError]
w1 -> do
Result GQLError ([event], b)
result' <- forall event (m :: * -> *) a.
ResultT event m a -> m (Result GQLError ([event], a))
runResultT (a -> ResultT event m b
mFunc a
value)
case Result GQLError ([event], b)
result' of
Failure (GQLError
e :| [GQLError]
es) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall err a. NonEmpty err -> Result err a
Failure (GQLError
e forall a. a -> [a] -> NonEmpty a
:| [GQLError]
es forall a. Semigroup a => a -> a -> a
<> [GQLError]
w1)
Success ([event]
events', b
value') [GQLError]
w2 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall err a. a -> [err] -> Result err a
Success ([event]
events forall a. Semigroup a => a -> a -> a
<> [event]
events', b
value') ([GQLError]
w1 forall a. Semigroup a => a -> a -> a
<> [GQLError]
w2)
instance MonadTrans (ResultT event) where
lift :: forall (m :: * -> *) a. Monad m => m a -> ResultT event m a
lift = forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],))
instance Monad m => MonadError GQLError (ResultT event m) where
throwError :: forall a. GQLError -> ResultT event m a
throwError = forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: forall a.
ResultT event m a
-> (GQLError -> ResultT event m a) -> ResultT event m a
catchError (ResultT m (Result GQLError ([event], a))
mx) GQLError -> ResultT event m a
f = forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([event], a))
mx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result GQLError ([event], a) -> m (Result GQLError ([event], a))
catchResultError)
where
catchResultError :: Result GQLError ([event], a) -> m (Result GQLError ([event], a))
catchResultError (Failure (GQLError
x :| [GQLError]
_)) = forall event (m :: * -> *) a.
ResultT event m a -> m (Result GQLError ([event], a))
runResultT (GQLError -> ResultT event m a
f GQLError
x)
catchResultError Result GQLError ([event], a)
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure Result GQLError ([event], a)
x
instance Applicative m => PushEvents event (ResultT event m) where
pushEvents :: [event] -> ResultT event m ()
pushEvents [event]
x = forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ([event]
x, ())
cleanEvents ::
Functor m =>
ResultT e m a ->
ResultT e' m a
cleanEvents :: forall (m :: * -> *) e a e'.
Functor m =>
ResultT e m a -> ResultT e' m a
cleanEvents ResultT e m a
resT = forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. a -> b -> a
const [])) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall event (m :: * -> *) a.
ResultT event m a -> m (Result GQLError ([event], a))
runResultT ResultT e m a
resT
mapEvent ::
Monad m =>
(e -> e') ->
ResultT e m value ->
ResultT e' m value
mapEvent :: forall (m :: * -> *) e e' value.
Monad m =>
(e -> e') -> ResultT e m value -> ResultT e' m value
mapEvent e -> e'
func (ResultT m (Result GQLError ([e], value))
ma) = forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. (a -> b) -> [a] -> [b]
map e -> e'
func)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result GQLError ([e], value))
ma
toEither :: Result err b -> Either (NonEmpty err) b
toEither :: forall err b. Result err b -> Either (NonEmpty err) b
toEither = forall err a' a.
(NonEmpty err -> a') -> (a -> a') -> Result err a -> a'
resultOr forall a b. a -> Either a b
Left forall a b. b -> Either a b
Right