blob: 3eef904da9c7c1da1d829f5bcf80b08b42f63292 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
-- | Monad transformer stack used by the @GraphQL@ resolvers.
module Language.GraphQL.Trans
( ActionT(..)
, Context(Context)
, argument
) where
import Control.Applicative (Alternative(..))
import Control.Monad (MonadPlus(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Reader (ReaderT, asks)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Language.GraphQL.AST.Core
import Prelude hiding (lookup)
-- | Resolution context holds resolver arguments.
newtype Context = Context (HashMap Name Value)
-- | Monad transformer stack used by the resolvers to provide error handling
-- and resolution context (resolver arguments).
newtype ActionT m a = ActionT
{ runActionT :: ExceptT Text (ReaderT Context m) a
}
instance Functor m => Functor (ActionT m) where
fmap f = ActionT . fmap f . runActionT
instance Monad m => Applicative (ActionT m) where
pure = ActionT . pure
(ActionT f) <*> (ActionT x) = ActionT $ f <*> x
instance Monad m => Monad (ActionT m) where
return = pure
(ActionT action) >>= f = ActionT $ action >>= runActionT . f
instance MonadTrans ActionT where
lift = ActionT . lift . lift
instance MonadIO m => MonadIO (ActionT m) where
liftIO = lift . liftIO
instance Monad m => Alternative (ActionT m) where
empty = ActionT empty
(ActionT x) <|> (ActionT y) = ActionT $ x <|> y
instance Monad m => MonadPlus (ActionT m) where
mzero = empty
mplus = (<|>)
-- | Retrieves an argument by its name. If the argument with this name couldn't
-- be found, returns 'Value.Null' (i.e. the argument is assumed to
-- be optional then).
argument :: MonadIO m => Name -> ActionT m Value
argument argumentName = do
argumentValue <- ActionT $ lift $ asks lookup
pure $ fromMaybe Null argumentValue
where
lookup (Context argumentMap) = HashMap.lookup argumentName argumentMap
|
