module Language.GraphQL.Trans
( argument
, ActionT(..)
, Context(..)
) 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 qualified Data.HashMap.Strict as HashMap
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Language.GraphQL.AST (Name)
import Language.GraphQL.AST.Core
import Language.GraphQL.Type.Definition
import Prelude hiding (lookup)
data Context = Context
{ arguments :: Arguments
, values :: Value
}
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 = (<|>)
argument :: Monad m => Name -> ActionT m Value
argument argumentName = do
argumentValue <- ActionT $ lift $ asks $ lookup . arguments
pure $ fromMaybe Null argumentValue
where
lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap