{-# 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 {Result err a -> a
result :: a, Result err a -> [err]
warnings :: [err]}
| Failure {Result err a -> NonEmpty err
errors :: NonEmpty err}
deriving (a -> Result err b -> Result err a
(a -> b) -> Result err a -> Result err b
(forall a b. (a -> b) -> Result err a -> Result err b)
-> (forall a b. a -> Result err b -> Result err a)
-> Functor (Result err)
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
<$ :: a -> Result err b -> Result err a
$c<$ :: forall err a b. a -> Result err b -> Result err a
fmap :: (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 :: a -> Result er a
pure a
x = a -> [er] -> Result er a
forall err a. a -> [err] -> Result err a
Success a
x []
Success a -> b
f [er]
w1 <*> :: Result er (a -> b) -> Result er a -> Result er b
<*> Success a
x [er]
w2 = b -> [er] -> Result er b
forall err a. a -> [err] -> Result err a
Success (a -> b
f a
x) ([er]
w1 [er] -> [er] -> [er]
forall a. Semigroup a => a -> a -> a
<> [er]
w2)
Failure NonEmpty er
e1 <*> Failure NonEmpty er
e2 = NonEmpty er -> Result er b
forall err a. NonEmpty err -> Result err a
Failure (NonEmpty er
e1 NonEmpty er -> NonEmpty er -> NonEmpty er
forall a. Semigroup a => a -> a -> a
<> NonEmpty er
e2)
Failure (er
e :| [er]
es) <*> Success a
_ [er]
w = NonEmpty er -> Result er b
forall err a. NonEmpty err -> Result err a
Failure (er
e er -> [er] -> NonEmpty er
forall a. a -> [a] -> NonEmpty a
:| [er]
es [er] -> [er] -> [er]
forall a. Semigroup a => a -> a -> a
<> [er]
w)
Success a -> b
_ [er]
w <*> Failure (er
e :| [er]
es) = NonEmpty er -> Result er b
forall err a. NonEmpty err -> Result err a
Failure (er
e er -> [er] -> NonEmpty er
forall a. a -> [a] -> NonEmpty a
:| [er]
es [er] -> [er] -> [er]
forall a. Semigroup a => a -> a -> a
<> [er]
w)
instance Monad (Result er) where
return :: a -> Result er a
return = a -> Result er a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Success a
v [er]
w1 >>= :: 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) -> b -> [er] -> Result er b
forall err a. a -> [err] -> Result err a
Success b
x ([er]
w1 [er] -> [er] -> [er]
forall a. Semigroup a => a -> a -> a
<> [er]
w2)
(Failure (er
e :| [er]
es)) -> NonEmpty er -> Result er b
forall err a. NonEmpty err -> Result err a
Failure (er
e er -> [er] -> NonEmpty er
forall a. a -> [a] -> NonEmpty a
:| [er]
es [er] -> [er] -> [er]
forall a. Semigroup a => a -> a -> a
<> [er]
w1)
Failure NonEmpty er
e >>= a -> Result er b
_ = NonEmpty er -> Result er b
forall err a. NonEmpty err -> Result err a
Failure NonEmpty er
e
instance Bifunctor Result where
bimap :: (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 :: forall err a. a -> [err] -> Result err a
Success {warnings :: [b]
warnings = a -> b
f (a -> b) -> [a] -> [b]
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
..} = NonEmpty b -> Result b d
forall err a. NonEmpty err -> Result err a
Failure (a -> b
f (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty a
errors)
instance MonadError er (Result er) where
throwError :: er -> Result er a
throwError = NonEmpty er -> Result er a
forall err a. NonEmpty err -> Result err a
Failure (NonEmpty er -> Result er a)
-> (er -> NonEmpty er) -> er -> Result er a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. er -> NonEmpty er
forall (f :: * -> *) a. Applicative f => a -> f a
pure
catchError :: 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 :: String -> Result err a
fail = NonEmpty err -> Result err a
forall err a. NonEmpty err -> Result err a
Failure (NonEmpty err -> Result err a)
-> (String -> NonEmpty err) -> String -> Result err a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> NonEmpty err
forall (f :: * -> *) a. Applicative f => a -> f a
pure (err -> NonEmpty err) -> (String -> err) -> String -> NonEmpty err
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> err
forall a. IsString a => String -> a
fromString
resultOr :: (NonEmpty err -> a') -> (a -> a') -> Result err a -> a'
resultOr :: (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 :: Result GQLError a -> Result GQLError a
sortErrors (Failure NonEmpty GQLError
errors) = NonEmpty GQLError -> Result GQLError a
forall err a. NonEmpty err -> Result err a
Failure (NonEmpty GQLError -> NonEmpty GQLError
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
{ ResultT event m a -> m (Result GQLError ([event], a))
runResultT :: m (Result GQLError ([event], a))
}
deriving (a -> ResultT event m b -> ResultT event m a
(a -> b) -> ResultT event m a -> ResultT event m b
(forall a b. (a -> b) -> ResultT event m a -> ResultT event m b)
-> (forall a b. a -> ResultT event m b -> ResultT event m a)
-> Functor (ResultT event m)
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
<$ :: 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 :: (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 :: a -> ResultT event m a
pure = m (Result GQLError ([event], a)) -> ResultT event m a
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([event], a)) -> ResultT event m a)
-> (a -> m (Result GQLError ([event], a)))
-> a
-> ResultT event m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result GQLError ([event], a) -> m (Result GQLError ([event], a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result GQLError ([event], a) -> m (Result GQLError ([event], a)))
-> (a -> Result GQLError ([event], a))
-> a
-> m (Result GQLError ([event], a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([event], a) -> Result GQLError ([event], a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([event], a) -> Result GQLError ([event], a))
-> (a -> ([event], a)) -> a -> Result GQLError ([event], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],)
ResultT m (Result GQLError ([event], a -> b))
app1 <*> :: ResultT event m (a -> b) -> ResultT event m a -> ResultT event m b
<*> ResultT m (Result GQLError ([event], a))
app2 = m (Result GQLError ([event], b)) -> ResultT event m b
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([event], b)) -> ResultT event m b)
-> m (Result GQLError ([event], b)) -> ResultT event m b
forall a b. (a -> b) -> a -> b
$ (Result GQLError (([event], a) -> ([event], b))
-> Result GQLError ([event], a) -> Result GQLError ([event], b))
-> m (Result GQLError (([event], a) -> ([event], b)))
-> m (Result GQLError ([event], a))
-> m (Result GQLError ([event], b))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Result GQLError (([event], a) -> ([event], b))
-> Result GQLError ([event], a) -> Result GQLError ([event], b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (Result GQLError ([event], a -> b)
-> Result GQLError (([event], a) -> ([event], b))
forall (f :: * -> *) event a b.
Monad f =>
f ([event], a -> b) -> f (([event], a) -> ([event], b))
fx (Result GQLError ([event], a -> b)
-> Result GQLError (([event], a) -> ([event], b)))
-> m (Result GQLError ([event], a -> b))
-> m (Result GQLError (([event], a) -> ([event], b)))
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 :: 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
(([event], a) -> ([event], b)) -> f (([event], a) -> ([event], b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((([event], a) -> ([event], b))
-> f (([event], a) -> ([event], b)))
-> (([event], a) -> ([event], b))
-> f (([event], a) -> ([event], b))
forall a b. (a -> b) -> a -> b
$ \([event]
e, a
a) -> ([event]
e [event] -> [event] -> [event]
forall a. Semigroup a => a -> a -> a
<> [event]
e', a -> b
f a
a)
instance Monad m => Monad (ResultT event m) where
return :: a -> ResultT event m a
return = a -> ResultT event m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(ResultT m (Result GQLError ([event], a))
m1) >>= :: ResultT event m a -> (a -> ResultT event m b) -> ResultT event m b
>>= a -> ResultT event m b
mFunc = m (Result GQLError ([event], b)) -> ResultT event m b
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([event], b)) -> ResultT event m b)
-> m (Result GQLError ([event], b)) -> ResultT event m b
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 -> Result GQLError ([event], b) -> m (Result GQLError ([event], b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result GQLError ([event], b) -> m (Result GQLError ([event], b)))
-> Result GQLError ([event], b) -> m (Result GQLError ([event], b))
forall a b. (a -> b) -> a -> b
$ NonEmpty GQLError -> Result GQLError ([event], 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' <- ResultT event m b -> m (Result GQLError ([event], b))
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) -> Result GQLError ([event], b) -> m (Result GQLError ([event], b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result GQLError ([event], b) -> m (Result GQLError ([event], b)))
-> Result GQLError ([event], b) -> m (Result GQLError ([event], b))
forall a b. (a -> b) -> a -> b
$ NonEmpty GQLError -> Result GQLError ([event], b)
forall err a. NonEmpty err -> Result err a
Failure (GQLError
e GQLError -> [GQLError] -> NonEmpty GQLError
forall a. a -> [a] -> NonEmpty a
:| [GQLError]
es [GQLError] -> [GQLError] -> [GQLError]
forall a. Semigroup a => a -> a -> a
<> [GQLError]
w1)
Success ([event]
events', b
value') [GQLError]
w2 -> Result GQLError ([event], b) -> m (Result GQLError ([event], b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result GQLError ([event], b) -> m (Result GQLError ([event], b)))
-> Result GQLError ([event], b) -> m (Result GQLError ([event], b))
forall a b. (a -> b) -> a -> b
$ ([event], b) -> [GQLError] -> Result GQLError ([event], b)
forall err a. a -> [err] -> Result err a
Success ([event]
events [event] -> [event] -> [event]
forall a. Semigroup a => a -> a -> a
<> [event]
events', b
value') ([GQLError]
w1 [GQLError] -> [GQLError] -> [GQLError]
forall a. Semigroup a => a -> a -> a
<> [GQLError]
w2)
instance MonadTrans (ResultT event) where
lift :: m a -> ResultT event m a
lift = m (Result GQLError ([event], a)) -> ResultT event m a
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([event], a)) -> ResultT event m a)
-> (m a -> m (Result GQLError ([event], a)))
-> m a
-> ResultT event m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result GQLError ([event], a))
-> m a -> m (Result GQLError ([event], a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([event], a) -> Result GQLError ([event], a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([event], a) -> Result GQLError ([event], a))
-> (a -> ([event], a)) -> a -> Result GQLError ([event], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],))
instance Monad m => MonadError GQLError (ResultT event m) where
throwError :: GQLError -> ResultT event m a
throwError = m (Result GQLError ([event], a)) -> ResultT event m a
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([event], a)) -> ResultT event m a)
-> (GQLError -> m (Result GQLError ([event], a)))
-> GQLError
-> ResultT event m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result GQLError ([event], a) -> m (Result GQLError ([event], a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result GQLError ([event], a) -> m (Result GQLError ([event], a)))
-> (GQLError -> Result GQLError ([event], a))
-> GQLError
-> m (Result GQLError ([event], a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLError -> Result GQLError ([event], a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: 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 = m (Result GQLError ([event], a)) -> ResultT event m a
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([event], a))
mx m (Result GQLError ([event], a))
-> (Result GQLError ([event], a)
-> m (Result GQLError ([event], a)))
-> m (Result GQLError ([event], a))
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]
_)) = ResultT event m a -> m (Result GQLError ([event], a))
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 = Result GQLError ([event], a) -> m (Result GQLError ([event], a))
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 = m (Result GQLError ([event], ())) -> ResultT event m ()
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([event], ())) -> ResultT event m ())
-> m (Result GQLError ([event], ())) -> ResultT event m ()
forall a b. (a -> b) -> a -> b
$ Result GQLError ([event], ()) -> m (Result GQLError ([event], ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result GQLError ([event], ())
-> m (Result GQLError ([event], ())))
-> Result GQLError ([event], ())
-> m (Result GQLError ([event], ()))
forall a b. (a -> b) -> a -> b
$ ([event], ()) -> Result GQLError ([event], ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([event]
x, ())
cleanEvents ::
Functor m =>
ResultT e m a ->
ResultT e' m a
cleanEvents :: ResultT e m a -> ResultT e' m a
cleanEvents ResultT e m a
resT = m (Result GQLError ([e'], a)) -> ResultT e' m a
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([e'], a)) -> ResultT e' m a)
-> m (Result GQLError ([e'], a)) -> ResultT e' m a
forall a b. (a -> b) -> a -> b
$ (([e], a) -> ([e'], a))
-> Result GQLError ([e], a) -> Result GQLError ([e'], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([e] -> [e']) -> ([e], a) -> ([e'], a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([e'] -> [e] -> [e']
forall a b. a -> b -> a
const [])) (Result GQLError ([e], a) -> Result GQLError ([e'], a))
-> m (Result GQLError ([e], a)) -> m (Result GQLError ([e'], a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResultT e m a -> m (Result GQLError ([e], a))
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 :: (e -> e') -> ResultT e m value -> ResultT e' m value
mapEvent e -> e'
func (ResultT m (Result GQLError ([e], value))
ma) = m (Result GQLError ([e'], value)) -> ResultT e' m value
forall event (m :: * -> *) a.
m (Result GQLError ([event], a)) -> ResultT event m a
ResultT (m (Result GQLError ([e'], value)) -> ResultT e' m value)
-> m (Result GQLError ([e'], value)) -> ResultT e' m value
forall a b. (a -> b) -> a -> b
$ (([e], value) -> ([e'], value))
-> Result GQLError ([e], value) -> Result GQLError ([e'], value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([e] -> [e']) -> ([e], value) -> ([e'], value)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((e -> e') -> [e] -> [e']
forall a b. (a -> b) -> [a] -> [b]
map e -> e'
func)) (Result GQLError ([e], value) -> Result GQLError ([e'], value))
-> m (Result GQLError ([e], value))
-> m (Result GQLError ([e'], value))
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 :: Result err b -> Either (NonEmpty err) b
toEither = (NonEmpty err -> Either (NonEmpty err) b)
-> (b -> Either (NonEmpty err) b)
-> Result err b
-> Either (NonEmpty err) b
forall err a' a.
(NonEmpty err -> a') -> (a -> a') -> Result err a -> a'
resultOr NonEmpty err -> Either (NonEmpty err) b
forall a b. a -> Either a b
Left b -> Either (NonEmpty err) b
forall a b. b -> Either a b
Right