mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
121 lines
3.3 KiB
Haskell
121 lines
3.3 KiB
Haskell
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE MultiWayIf #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TupleSections #-}
|
|
|
|
module Hasura.GraphQL.Resolve.InputValue
|
|
( withNotNull
|
|
, tyMismatch
|
|
, asPGColValM
|
|
, asPGColVal
|
|
, asEnumVal
|
|
, withObject
|
|
, withObjectM
|
|
, withArray
|
|
, withArrayM
|
|
, parseMany
|
|
, asPGColText
|
|
) where
|
|
|
|
import Hasura.Prelude
|
|
|
|
import qualified Data.Text as T
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
|
|
import Hasura.GraphQL.Utils
|
|
import Hasura.GraphQL.Validate.Types
|
|
import Hasura.RQL.Types
|
|
import Hasura.SQL.Types
|
|
import Hasura.SQL.Value
|
|
|
|
withNotNull
|
|
:: (MonadError QErr m)
|
|
=> G.NamedType -> Maybe a -> m a
|
|
withNotNull nt v =
|
|
onNothing v $ throw500 $
|
|
"unexpected null for a value of type " <> showNamedTy nt
|
|
|
|
tyMismatch
|
|
:: (MonadError QErr m) => Text -> AnnGValue -> m a
|
|
tyMismatch expectedTy v =
|
|
throw500 $ "expected " <> expectedTy <> ", found " <>
|
|
getAnnInpValKind v <> " for value of type " <>
|
|
G.showGT (getAnnInpValTy v)
|
|
|
|
asPGColValM
|
|
:: (MonadError QErr m)
|
|
=> AnnGValue -> m (Maybe (PGColType, PGColValue))
|
|
asPGColValM = \case
|
|
AGScalar colTy valM -> return $ fmap (colTy,) valM
|
|
v -> tyMismatch "pgvalue" v
|
|
|
|
asPGColVal
|
|
:: (MonadError QErr m)
|
|
=> AnnGValue -> m (PGColType, PGColValue)
|
|
asPGColVal = \case
|
|
AGScalar colTy (Just val) -> return (colTy, val)
|
|
AGScalar colTy Nothing ->
|
|
throw500 $ "unexpected null for ty"
|
|
<> T.pack (show colTy)
|
|
v -> tyMismatch "pgvalue" v
|
|
|
|
asEnumVal
|
|
:: (MonadError QErr m)
|
|
=> AnnGValue -> m (G.NamedType, G.EnumValue)
|
|
asEnumVal = \case
|
|
AGEnum ty (Just val) -> return (ty, val)
|
|
AGEnum ty Nothing ->
|
|
throw500 $ "unexpected null for ty " <> showNamedTy ty
|
|
v -> tyMismatch "enum" v
|
|
|
|
withObject
|
|
:: (MonadError QErr m)
|
|
=> (G.NamedType -> AnnGObject -> m a) -> AnnGValue -> m a
|
|
withObject fn v = case v of
|
|
AGObject nt (Just obj) -> fn nt obj
|
|
AGObject nt Nothing ->
|
|
throw500 $ "unexpected null for ty"
|
|
<> G.showGT (G.TypeNamed nt)
|
|
_ -> tyMismatch "object" v
|
|
|
|
withObjectM
|
|
:: (MonadError QErr m)
|
|
=> (G.NamedType -> Maybe AnnGObject -> m a) -> AnnGValue -> m a
|
|
withObjectM fn v = case v of
|
|
AGObject nt objM -> fn nt objM
|
|
_ -> tyMismatch "object" v
|
|
|
|
withArrayM
|
|
:: (MonadError QErr m)
|
|
=> (G.ListType -> Maybe [AnnGValue] -> m a) -> AnnGValue -> m a
|
|
withArrayM fn v = case v of
|
|
AGArray lt listM -> fn lt listM
|
|
_ -> tyMismatch "array" v
|
|
|
|
withArray
|
|
:: (MonadError QErr m)
|
|
=> (G.ListType -> [AnnGValue] -> m a) -> AnnGValue -> m a
|
|
withArray fn v = case v of
|
|
AGArray lt (Just l) -> fn lt l
|
|
AGArray lt Nothing -> throw500 $ "unexpected null for ty"
|
|
<> G.showGT (G.TypeList lt)
|
|
_ -> tyMismatch "array" v
|
|
|
|
parseMany
|
|
:: (MonadError QErr m)
|
|
=> (AnnGValue -> m a) -> AnnGValue -> m (Maybe [a])
|
|
parseMany fn v = case v of
|
|
AGArray _ arrM -> mapM (mapM fn) arrM
|
|
_ -> tyMismatch "array" v
|
|
|
|
asPGColText
|
|
:: (MonadError QErr m)
|
|
=> AnnGValue -> m Text
|
|
asPGColText val = do
|
|
(_, pgColVal) <- asPGColVal val
|
|
case pgColVal of
|
|
PGValText t -> return t
|
|
_ -> throw500 "expecting text for asPGColText"
|