{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Ext.Result
  ( Eventless,
    Result (..),
    Failure (..),
    ResultT (..),
    unpackEvents,
    mapEvent,
    cleanEvents,
    PushEvents (..),
    resultOr,
    sortErrors,
  )
where

import Data.Morpheus.Internal.Utils
  ( Failure (..),
  )
import Data.Morpheus.Types.Internal.AST.Base
  ( GQLError (..),
    GQLErrors,
    ValidationError (..),
    toGQLError,
  )
import Relude

type Eventless = Result ()

-- EVENTS
class PushEvents e m where
  pushEvents :: [e] -> m ()

unpackEvents :: Result event a -> [event]
unpackEvents :: Result event a -> [event]
unpackEvents Success {[event]
events :: forall events a. Result events a -> [events]
events :: [event]
events} = [event]
events
unpackEvents Result event a
_ = []

--
-- Result
--
--
data Result events a
  = Success {Result events a -> a
result :: a, Result events a -> GQLErrors
warnings :: GQLErrors, Result events a -> [events]
events :: [events]}
  | Failure {Result events a -> GQLErrors
errors :: GQLErrors}
  deriving (a -> Result events b -> Result events a
(a -> b) -> Result events a -> Result events b
(forall a b. (a -> b) -> Result events a -> Result events b)
-> (forall a b. a -> Result events b -> Result events a)
-> Functor (Result events)
forall a b. a -> Result events b -> Result events a
forall a b. (a -> b) -> Result events a -> Result events b
forall events a b. a -> Result events b -> Result events a
forall events a b. (a -> b) -> Result events a -> Result events b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Result events b -> Result events a
$c<$ :: forall events a b. a -> Result events b -> Result events a
fmap :: (a -> b) -> Result events a -> Result events b
$cfmap :: forall events a b. (a -> b) -> Result events a -> Result events b
Functor)

instance Applicative (Result e) where
  pure :: a -> Result e a
pure a
x = a -> GQLErrors -> [e] -> Result e a
forall events a. a -> GQLErrors -> [events] -> Result events a
Success a
x [] []
  Success a -> b
f GQLErrors
w1 [e]
e1 <*> :: Result e (a -> b) -> Result e a -> Result e b
<*> Success a
x GQLErrors
w2 [e]
e2 = b -> GQLErrors -> [e] -> Result e b
forall events a. a -> GQLErrors -> [events] -> Result events a
Success (a -> b
f a
x) (GQLErrors
w1 GQLErrors -> GQLErrors -> GQLErrors
forall a. Semigroup a => a -> a -> a
<> GQLErrors
w2) ([e]
e1 [e] -> [e] -> [e]
forall a. Semigroup a => a -> a -> a
<> [e]
e2)
  Failure GQLErrors
e1 <*> Failure GQLErrors
e2 = GQLErrors -> Result e b
forall events a. GQLErrors -> Result events a
Failure (GQLErrors
e1 GQLErrors -> GQLErrors -> GQLErrors
forall a. Semigroup a => a -> a -> a
<> GQLErrors
e2)
  Failure GQLErrors
e <*> Success a
_ GQLErrors
w [e]
_ = GQLErrors -> Result e b
forall events a. GQLErrors -> Result events a
Failure (GQLErrors
e GQLErrors -> GQLErrors -> GQLErrors
forall a. Semigroup a => a -> a -> a
<> GQLErrors
w)
  Success a -> b
_ GQLErrors
w [e]
_ <*> Failure GQLErrors
e = GQLErrors -> Result e b
forall events a. GQLErrors -> Result events a
Failure (GQLErrors
e GQLErrors -> GQLErrors -> GQLErrors
forall a. Semigroup a => a -> a -> a
<> GQLErrors
w)

instance Monad (Result e) where
  return :: a -> Result e a
return = a -> Result e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Success a
v GQLErrors
w1 [e]
e1 >>= :: Result e a -> (a -> Result e b) -> Result e b
>>= a -> Result e b
fm = case a -> Result e b
fm a
v of
    (Success b
x GQLErrors
w2 [e]
e2) -> b -> GQLErrors -> [e] -> Result e b
forall events a. a -> GQLErrors -> [events] -> Result events a
Success b
x (GQLErrors
w1 GQLErrors -> GQLErrors -> GQLErrors
forall a. Semigroup a => a -> a -> a
<> GQLErrors
w2) ([e]
e1 [e] -> [e] -> [e]
forall a. Semigroup a => a -> a -> a
<> [e]
e2)
    (Failure GQLErrors
e) -> GQLErrors -> Result e b
forall events a. GQLErrors -> Result events a
Failure (GQLErrors
e GQLErrors -> GQLErrors -> GQLErrors
forall a. Semigroup a => a -> a -> a
<> GQLErrors
w1)
  Failure GQLErrors
e >>= a -> Result e b
_ = GQLErrors -> Result e b
forall events a. GQLErrors -> Result events a
Failure GQLErrors
e

instance Failure [GQLError] (Result ev) where
  failure :: GQLErrors -> Result ev v
failure = GQLErrors -> Result ev v
forall events a. GQLErrors -> Result events a
Failure

instance PushEvents events (Result events) where
  pushEvents :: [events] -> Result events ()
pushEvents [events]
events = Success :: forall events a. a -> GQLErrors -> [events] -> Result events a
Success {result :: ()
result = (), warnings :: GQLErrors
warnings = [], [events]
events :: [events]
events :: [events]
events}

instance Failure [ValidationError] (Result ev) where
  failure :: [ValidationError] -> Result ev v
failure = GQLErrors -> Result ev v
forall error (f :: * -> *) v. Failure error f => error -> f v
failure (GQLErrors -> Result ev v)
-> ([ValidationError] -> GQLErrors)
-> [ValidationError]
-> Result ev v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValidationError -> GQLError) -> [ValidationError] -> GQLErrors
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValidationError -> GQLError
toGQLError

resultOr :: (GQLErrors -> a') -> (a -> a') -> Result e a -> a'
resultOr :: (GQLErrors -> a') -> (a -> a') -> Result e a -> a'
resultOr GQLErrors -> a'
_ a -> a'
f (Success a
x GQLErrors
_ [e]
_) = a -> a'
f a
x
resultOr GQLErrors -> a'
f a -> a'
_ (Failure GQLErrors
e) = GQLErrors -> a'
f GQLErrors
e

sortErrors :: Result e a -> Result e a
sortErrors :: Result e a -> Result e a
sortErrors (Failure GQLErrors
errors) = GQLErrors -> Result e a
forall events a. GQLErrors -> Result events a
Failure ((GQLError -> [Position]) -> GQLErrors -> GQLErrors
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn GQLError -> [Position]
locations GQLErrors
errors)
sortErrors Result e a
x = Result e a
x

-- ResultT
newtype ResultT event (m :: * -> *) a = ResultT
  { ResultT event m a -> m (Result event a)
runResultT :: m (Result 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 event a) -> ResultT event m a
forall event (m :: * -> *) a.
m (Result event a) -> ResultT event m a
ResultT (m (Result event a) -> ResultT event m a)
-> (a -> m (Result event a)) -> a -> ResultT event m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result event a -> m (Result event a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result event a -> m (Result event a))
-> (a -> Result event a) -> a -> m (Result event a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Result event a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  ResultT m (Result event (a -> b))
app1 <*> :: ResultT event m (a -> b) -> ResultT event m a -> ResultT event m b
<*> ResultT m (Result event a)
app2 = m (Result event b) -> ResultT event m b
forall event (m :: * -> *) a.
m (Result event a) -> ResultT event m a
ResultT (m (Result event b) -> ResultT event m b)
-> m (Result event b) -> ResultT event m b
forall a b. (a -> b) -> a -> b
$ (Result event (a -> b) -> Result event a -> Result event b)
-> m (Result event (a -> b))
-> m (Result event a)
-> m (Result event b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Result event (a -> b) -> Result event a -> Result event b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) m (Result event (a -> b))
app1 m (Result event a)
app2

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 event a)
m1) >>= :: ResultT event m a -> (a -> ResultT event m b) -> ResultT event m b
>>= a -> ResultT event m b
mFunc = m (Result event b) -> ResultT event m b
forall event (m :: * -> *) a.
m (Result event a) -> ResultT event m a
ResultT (m (Result event b) -> ResultT event m b)
-> m (Result event b) -> ResultT event m b
forall a b. (a -> b) -> a -> b
$ do
    Result event a
result1 <- m (Result event a)
m1
    case Result event a
result1 of
      Failure GQLErrors
errors -> Result event b -> m (Result event b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result event b -> m (Result event b))
-> Result event b -> m (Result event b)
forall a b. (a -> b) -> a -> b
$ GQLErrors -> Result event b
forall events a. GQLErrors -> Result events a
Failure GQLErrors
errors
      Success a
value1 GQLErrors
w1 [event]
e1 -> do
        Result event b
result2 <- ResultT event m b -> m (Result event b)
forall event (m :: * -> *) a.
ResultT event m a -> m (Result event a)
runResultT (a -> ResultT event m b
mFunc a
value1)
        case Result event b
result2 of
          Failure GQLErrors
errors -> Result event b -> m (Result event b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result event b -> m (Result event b))
-> Result event b -> m (Result event b)
forall a b. (a -> b) -> a -> b
$ GQLErrors -> Result event b
forall events a. GQLErrors -> Result events a
Failure (GQLErrors
errors GQLErrors -> GQLErrors -> GQLErrors
forall a. Semigroup a => a -> a -> a
<> GQLErrors
w1)
          Success b
v2 GQLErrors
w2 [event]
e2 -> Result event b -> m (Result event b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result event b -> m (Result event b))
-> Result event b -> m (Result event b)
forall a b. (a -> b) -> a -> b
$ b -> GQLErrors -> [event] -> Result event b
forall events a. a -> GQLErrors -> [events] -> Result events a
Success b
v2 (GQLErrors
w1 GQLErrors -> GQLErrors -> GQLErrors
forall a. Semigroup a => a -> a -> a
<> GQLErrors
w2) ([event]
e1 [event] -> [event] -> [event]
forall a. Semigroup a => a -> a -> a
<> [event]
e2)

instance MonadTrans (ResultT event) where
  lift :: m a -> ResultT event m a
lift = m (Result event a) -> ResultT event m a
forall event (m :: * -> *) a.
m (Result event a) -> ResultT event m a
ResultT (m (Result event a) -> ResultT event m a)
-> (m a -> m (Result event a)) -> m a -> ResultT event m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Result event a) -> m a -> m (Result event a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Result event a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Monad m => Failure GQLErrors (ResultT event m) where
  failure :: GQLErrors -> ResultT event m v
failure = m (Result event v) -> ResultT event m v
forall event (m :: * -> *) a.
m (Result event a) -> ResultT event m a
ResultT (m (Result event v) -> ResultT event m v)
-> (GQLErrors -> m (Result event v))
-> GQLErrors
-> ResultT event m v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result event v -> m (Result event v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result event v -> m (Result event v))
-> (GQLErrors -> Result event v) -> GQLErrors -> m (Result event v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GQLErrors -> Result event v
forall error (f :: * -> *) v. Failure error f => error -> f v
failure

instance Applicative m => PushEvents event (ResultT event m) where
  pushEvents :: [event] -> ResultT event m ()
pushEvents = m (Result event ()) -> ResultT event m ()
forall event (m :: * -> *) a.
m (Result event a) -> ResultT event m a
ResultT (m (Result event ()) -> ResultT event m ())
-> ([event] -> m (Result event ()))
-> [event]
-> ResultT event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result event () -> m (Result event ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result event () -> m (Result event ()))
-> ([event] -> Result event ()) -> [event] -> m (Result event ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [event] -> Result event ()
forall e (m :: * -> *). PushEvents e m => [e] -> m ()
pushEvents

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 e' a) -> ResultT e' m a
forall event (m :: * -> *) a.
m (Result event a) -> ResultT event m a
ResultT (m (Result e' a) -> ResultT e' m a)
-> m (Result e' a) -> ResultT e' m a
forall a b. (a -> b) -> a -> b
$ Result e a -> Result e' a
forall events a events. Result events a -> Result events a
replace (Result e a -> Result e' a) -> m (Result e a) -> m (Result e' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResultT e m a -> m (Result e a)
forall event (m :: * -> *) a.
ResultT event m a -> m (Result event a)
runResultT ResultT e m a
resT
  where
    replace :: Result events a -> Result events a
replace (Success a
v GQLErrors
w [events]
_) = a -> GQLErrors -> [events] -> Result events a
forall events a. a -> GQLErrors -> [events] -> Result events a
Success a
v GQLErrors
w []
    replace (Failure GQLErrors
e) = GQLErrors -> Result events a
forall events a. GQLErrors -> Result events a
Failure GQLErrors
e

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 e value)
ma) = m (Result e' value) -> ResultT e' m value
forall event (m :: * -> *) a.
m (Result event a) -> ResultT event m a
ResultT (m (Result e' value) -> ResultT e' m value)
-> m (Result e' value) -> ResultT e' m value
forall a b. (a -> b) -> a -> b
$ Result e value -> Result e' value
forall a. Result e a -> Result e' a
mapEv (Result e value -> Result e' value)
-> m (Result e value) -> m (Result e' value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Result e value)
ma
  where
    mapEv :: Result e a -> Result e' a
mapEv Success {a
result :: a
result :: forall events a. Result events a -> a
result, GQLErrors
warnings :: GQLErrors
warnings :: forall events a. Result events a -> GQLErrors
warnings, [e]
events :: [e]
events :: forall events a. Result events a -> [events]
events} =
      Success :: forall events a. a -> GQLErrors -> [events] -> Result events a
Success {a
result :: a
result :: a
result, GQLErrors
warnings :: GQLErrors
warnings :: GQLErrors
warnings, events :: [e']
events = (e -> e') -> [e] -> [e']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap e -> e'
func [e]
events}
    mapEv (Failure GQLErrors
err) = GQLErrors -> Result e' a
forall events a. GQLErrors -> Result events a
Failure GQLErrors
err