{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.Internal.Validation
  ( Validator,
    SelectionValidator,
    InputValidator,
    BaseValidator,
    InputSource (..),
    OperationContext (..),
    runValidator,
    DirectiveValidator,
    askType,
    askTypeMember,
    selectRequired,
    selectKnown,
    Constraint (..),
    constraint,
    withScope,
    withScopeType,
    withPosition,
    asks,
    asksScope,
    selectWithDefaultValue,
    startInput,
    inField,
    inputMessagePrefix,
    checkUnused,
    Prop (..),
    constraintInputUnion,
    ScopeKind (..),
    withDirective,
    inputValueSource,
    askVariables,
    Scope (..),
    MissingRequired (..),
    InputContext,
    GetWith,
    SetWith,
    Unknown,
    askSchema,
    askFragments,
    MonadContext,
    CurrentSelection (..),
    getOperationType,
    selectType,
    FragmentValidator,
    askInterfaceTypes,
  )
where

import Data.Morpheus.Internal.Utils
  ( Failure (..),
    KeyOf (..),
    Selectable,
    member,
    selectBy,
    selectOr,
    size,
  )
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    FieldContent (..),
    FieldDefinition (..),
    FieldName,
    IN,
    Message,
    Object,
    ObjectEntry (..),
    Position (..),
    Ref (..),
    TRUE,
    TypeContent (..),
    TypeDefinition (..),
    TypeName,
    UnionMember (..),
    ValidationError,
    Value (..),
    __inputname,
    entryValue,
    fromAny,
    isNullable,
    msg,
    msgValidation,
    toFieldName,
  )
import Data.Morpheus.Types.Internal.Validation.Error
  ( KindViolation (..),
    MissingRequired (..),
    Unknown (..),
    Unused (..),
  )
import Data.Morpheus.Types.Internal.Validation.Internal
  ( askInterfaceTypes,
    askType,
    askTypeMember,
    getOperationType,
  )
import Data.Morpheus.Types.Internal.Validation.Validator
  ( BaseValidator,
    Constraint (..),
    CurrentSelection (..),
    DirectiveValidator,
    FragmentValidator,
    GetWith (..),
    InputContext,
    InputSource (..),
    InputValidator,
    MonadContext (..),
    OperationContext (..),
    Prop (..),
    Resolution,
    Scope (..),
    ScopeKind (..),
    SelectionValidator,
    SetWith (..),
    Target (..),
    Validator (..),
    ValidatorContext (..),
    askFragments,
    askSchema,
    askVariables,
    asks,
    asksScope,
    inField,
    inputMessagePrefix,
    inputValueSource,
    runValidator,
    startInput,
    withDirective,
    withPosition,
    withScope,
    withScopeType,
  )
import Relude hiding
  ( Constraint,
    asks,
  )

getUnused :: (KeyOf k b, Selectable k a c) => c -> [b] -> [b]
getUnused :: c -> [b] -> [b]
getUnused c
uses = (b -> Bool) -> [b] -> [b]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (b -> Bool) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> c -> Bool
forall k a c. Selectable k a c => k -> c -> Bool
`member` c
uses) (k -> Bool) -> (b -> k) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> k
forall k a. KeyOf k a => a -> k
keyOf)

failOnUnused :: Unused ctx b => [b] -> Validator s ctx ()
failOnUnused :: [b] -> Validator s ctx ()
failOnUnused [b]
x
  | [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
x = () -> Validator s ctx ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = do
    ctx
ctx <- ValidatorContext s ctx -> ctx
forall (s :: Stage) ctx. ValidatorContext s ctx -> ctx
validatorCTX (ValidatorContext s ctx -> ctx)
-> Validator s ctx (ValidatorContext s ctx) -> Validator s ctx ctx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (ValidatorContext s ctx) Eventless (ValidatorContext s ctx)
-> Validator s ctx (ValidatorContext s ctx)
forall (s :: Stage) ctx a.
ReaderT (ValidatorContext s ctx) Eventless a -> Validator s ctx a
Validator ReaderT (ValidatorContext s ctx) Eventless (ValidatorContext s ctx)
forall r (m :: * -> *). MonadReader r m => m r
ask
    [ValidationError] -> Validator s ctx ()
forall error (f :: * -> *) v. Failure error f => error -> f v
failure ([ValidationError] -> Validator s ctx ())
-> [ValidationError] -> Validator s ctx ()
forall a b. (a -> b) -> a -> b
$ (b -> ValidationError) -> [b] -> [ValidationError]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ctx -> b -> ValidationError
forall ctx c. Unused ctx c => ctx -> c -> ValidationError
unused ctx
ctx) [b]
x

checkUnused ::
  ( KeyOf k b,
    Selectable k a ca,
    Unused ctx b
  ) =>
  ca ->
  [b] ->
  Validator s ctx ()
checkUnused :: ca -> [b] -> Validator s ctx ()
checkUnused ca
uses = [b] -> Validator s ctx ()
forall ctx b (s :: Stage).
Unused ctx b =>
[b] -> Validator s ctx ()
failOnUnused ([b] -> Validator s ctx ())
-> ([b] -> [b]) -> [b] -> Validator s ctx ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ca -> [b] -> [b]
forall k b a c. (KeyOf k b, Selectable k a c) => c -> [b] -> [b]
getUnused ca
uses

constraint ::
  KindViolation a inp =>
  Constraint (a :: Target) ->
  inp ->
  TypeDefinition ANY s ->
  Validator s ctx (Resolution s a)
constraint :: Constraint a
-> inp -> TypeDefinition ANY s -> Validator s ctx (Resolution s a)
constraint Constraint a
IMPLEMENTABLE inp
_ TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataObject {FieldsDefinition OUT s
objectFields :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectFields, [TypeName]
objectImplements :: forall (a :: TypeCategory) (s :: Stage).
TypeContent (ELEM OBJECT a) a s -> [TypeName]
objectImplements :: [TypeName]
..}, Directives s
Maybe Description
TypeName
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Description
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Description
..} =
  TypeDefinition IMPLEMENTABLE s
-> Validator s ctx (TypeDefinition IMPLEMENTABLE s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Description
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition {typeContent :: TypeContent TRUE IMPLEMENTABLE s
typeContent = DataObject :: forall (s :: Stage) (a :: TypeCategory).
[TypeName]
-> FieldsDefinition OUT s -> TypeContent (ELEM OBJECT a) a s
DataObject {FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT s
objectFields, [TypeName]
objectImplements :: [TypeName]
objectImplements :: [TypeName]
..}, Directives s
Maybe Description
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Description
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Description
..}
constraint Constraint a
IMPLEMENTABLE inp
_ TypeDefinition {typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent = DataInterface FieldsDefinition OUT s
fields, Directives s
Maybe Description
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Description
typeDirectives :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Directives s
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeDescription :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Maybe Description
..} =
  TypeDefinition IMPLEMENTABLE s
-> Validator s ctx (TypeDefinition IMPLEMENTABLE s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeDefinition :: forall (a :: TypeCategory) (s :: Stage).
Maybe Description
-> TypeName
-> Directives s
-> TypeContent TRUE a s
-> TypeDefinition a s
TypeDefinition {typeContent :: TypeContent TRUE IMPLEMENTABLE s
typeContent = FieldsDefinition OUT s
-> TypeContent (ELEM IMPLEMENTABLE IMPLEMENTABLE) IMPLEMENTABLE s
forall (s :: Stage) (a :: TypeCategory).
FieldsDefinition OUT s -> TypeContent (ELEM IMPLEMENTABLE a) a s
DataInterface FieldsDefinition OUT s
fields, Directives s
Maybe Description
TypeName
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Description
typeDirectives :: Directives s
typeName :: TypeName
typeDescription :: Maybe Description
..}
constraint Constraint a
INPUT inp
ctx TypeDefinition ANY s
x = Validator s ctx (TypeDefinition IN s)
-> (TypeDefinition IN s -> Validator s ctx (TypeDefinition IN s))
-> Maybe (TypeDefinition IN s)
-> Validator s ctx (TypeDefinition IN s)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([ValidationError] -> Validator s ctx (TypeDefinition IN s)
forall error (f :: * -> *) v. Failure error f => error -> f v
failure [Constraint 'TARGET_INPUT -> inp -> ValidationError
forall (t :: Target) ctx (c :: Target -> *).
KindViolation t ctx =>
c t -> ctx -> ValidationError
kindViolation Constraint 'TARGET_INPUT
INPUT inp
ctx]) TypeDefinition IN s -> Validator s ctx (TypeDefinition IN s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeDefinition ANY s -> Maybe (TypeDefinition IN s)
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
FromCategory a ANY k =>
a ANY s -> Maybe (a k s)
fromAny TypeDefinition ANY s
x)
constraint Constraint a
target inp
ctx TypeDefinition ANY s
_ = [ValidationError] -> Validator s ctx (Resolution s a)
forall error (f :: * -> *) v. Failure error f => error -> f v
failure [Constraint a -> inp -> ValidationError
forall (t :: Target) ctx (c :: Target -> *).
KindViolation t ctx =>
c t -> ctx -> ValidationError
kindViolation Constraint a
target inp
ctx]

selectRequired ::
  ( Selectable FieldName value c,
    MissingRequired c ctx
  ) =>
  Ref ->
  c ->
  Validator s ctx value
selectRequired :: Ref -> c -> Validator s ctx value
selectRequired Ref
selector c
container =
  do
    ValidatorContext {Scope
scope :: forall (s :: Stage) ctx. ValidatorContext s ctx -> Scope
scope :: Scope
scope, ctx
validatorCTX :: ctx
validatorCTX :: forall (s :: Stage) ctx. ValidatorContext s ctx -> ctx
validatorCTX} <- ReaderT (ValidatorContext s ctx) Eventless (ValidatorContext s ctx)
-> Validator s ctx (ValidatorContext s ctx)
forall (s :: Stage) ctx a.
ReaderT (ValidatorContext s ctx) Eventless a -> Validator s ctx a
Validator ReaderT (ValidatorContext s ctx) Eventless (ValidatorContext s ctx)
forall r (m :: * -> *). MonadReader r m => m r
ask
    [ValidationError] -> FieldName -> c -> Validator s ctx value
forall e (m :: * -> *) k a c.
(Failure e m, Selectable k a c, Monad m) =>
e -> k -> c -> m a
selectBy
      [Scope -> ctx -> Ref -> c -> ValidationError
forall c ctx.
MissingRequired c ctx =>
Scope -> ctx -> Ref -> c -> ValidationError
missingRequired Scope
scope ctx
validatorCTX Ref
selector c
container]
      (Ref -> FieldName
forall k a. KeyOf k a => a -> k
keyOf Ref
selector)
      c
container

selectWithDefaultValue ::
  forall ctx values value s validValue.
  ( Selectable FieldName value values,
    MissingRequired values ctx,
    MonadContext (Validator s) s ctx
  ) =>
  (Value s -> Validator s ctx validValue) ->
  (value -> Validator s ctx validValue) ->
  FieldDefinition IN s ->
  values ->
  Validator s ctx validValue
selectWithDefaultValue :: (Value s -> Validator s ctx validValue)
-> (value -> Validator s ctx validValue)
-> FieldDefinition IN s
-> values
-> Validator s ctx validValue
selectWithDefaultValue
  Value s -> Validator s ctx validValue
f
  value -> Validator s ctx validValue
validateF
  field :: FieldDefinition IN s
field@FieldDefinition
    { FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName :: FieldName
fieldName,
      Maybe (FieldContent TRUE IN s)
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldContent :: Maybe (FieldContent TRUE IN s)
fieldContent
    }
  values
values =
    Validator s ctx validValue
-> (value -> Validator s ctx validValue)
-> FieldName
-> values
-> Validator s ctx validValue
forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d
selectOr
      (Maybe (FieldContent TRUE IN s) -> Validator s ctx validValue
handleNull Maybe (FieldContent TRUE IN s)
fieldContent)
      value -> Validator s ctx validValue
validateF
      FieldName
fieldName
      values
values
    where
      ------------------
      handleNull ::
        Maybe (FieldContent TRUE IN s) ->
        Validator s ctx validValue
      handleNull :: Maybe (FieldContent TRUE IN s) -> Validator s ctx validValue
handleNull (Just (DefaultInputValue Value s
value)) = Value s -> Validator s ctx validValue
f Value s
value
      handleNull Maybe (FieldContent TRUE IN s)
Nothing
        | FieldDefinition IN s -> Bool
forall a. Nullable a => a -> Bool
isNullable FieldDefinition IN s
field = Value s -> Validator s ctx validValue
f Value s
forall (stage :: Stage). Value stage
Null
        | Bool
otherwise = Validator s ctx validValue
failSelection
      -----------------
      failSelection :: Validator s ctx validValue
failSelection = do
        ValidatorContext {Scope
scope :: Scope
scope :: forall (s :: Stage) ctx. ValidatorContext s ctx -> Scope
scope, ctx
validatorCTX :: ctx
validatorCTX :: forall (s :: Stage) ctx. ValidatorContext s ctx -> ctx
validatorCTX} <- ReaderT (ValidatorContext s ctx) Eventless (ValidatorContext s ctx)
-> Validator s ctx (ValidatorContext s ctx)
forall (s :: Stage) ctx a.
ReaderT (ValidatorContext s ctx) Eventless a -> Validator s ctx a
Validator ReaderT (ValidatorContext s ctx) Eventless (ValidatorContext s ctx)
forall r (m :: * -> *). MonadReader r m => m r
ask
        Maybe Position
position <- (Scope -> Maybe Position) -> Validator s ctx (Maybe Position)
forall (m :: * -> * -> *) (s :: Stage) c a.
MonadContext m s c =>
(Scope -> a) -> m c a
asksScope Scope -> Maybe Position
position
        [ValidationError] -> Validator s ctx validValue
forall error (f :: * -> *) v. Failure error f => error -> f v
failure [Scope -> ctx -> Ref -> values -> ValidationError
forall c ctx.
MissingRequired c ctx =>
Scope -> ctx -> Ref -> c -> ValidationError
missingRequired Scope
scope ctx
validatorCTX (FieldName -> Position -> Ref
Ref FieldName
fieldName (Position -> Maybe Position -> Position
forall a. a -> Maybe a -> a
fromMaybe (Int -> Int -> Position
Position Int
0 Int
0) Maybe Position
position)) values
values]

selectType ::
  TypeName ->
  Validator s ctx (TypeDefinition ANY s)
selectType :: TypeName -> Validator s ctx (TypeDefinition ANY s)
selectType TypeName
name =
  Validator s ctx (Schema s)
forall (m :: * -> * -> *) (s :: Stage) c.
MonadContext m s c =>
m c (Schema s)
askSchema Validator s ctx (Schema s)
-> (Schema s -> Validator s ctx (TypeDefinition ANY s))
-> Validator s ctx (TypeDefinition ANY s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ValidationError
-> TypeName -> Schema s -> Validator s ctx (TypeDefinition ANY s)
forall e (m :: * -> *) k a c.
(Failure e m, Selectable k a c, Monad m) =>
e -> k -> c -> m a
selectBy ValidationError
err TypeName
name
  where
    err :: ValidationError
err = ValidationError
"Unknown Type " ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> TypeName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation TypeName
name ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> ValidationError
"." :: ValidationError

selectKnown ::
  ( Selectable k a c,
    Unknown c sel ctx,
    KeyOf k sel
  ) =>
  sel ->
  c ->
  Validator s ctx a
selectKnown :: sel -> c -> Validator s ctx a
selectKnown sel
selector c
lib =
  do
    ValidatorContext {Scope
scope :: Scope
scope :: forall (s :: Stage) ctx. ValidatorContext s ctx -> Scope
scope, ctx
validatorCTX :: ctx
validatorCTX :: forall (s :: Stage) ctx. ValidatorContext s ctx -> ctx
validatorCTX} <- ReaderT (ValidatorContext s ctx) Eventless (ValidatorContext s ctx)
-> Validator s ctx (ValidatorContext s ctx)
forall (s :: Stage) ctx a.
ReaderT (ValidatorContext s ctx) Eventless a -> Validator s ctx a
Validator ReaderT (ValidatorContext s ctx) Eventless (ValidatorContext s ctx)
forall r (m :: * -> *). MonadReader r m => m r
ask
    ValidationError -> k -> c -> Validator s ctx a
forall e (m :: * -> *) k a c.
(Failure e m, Selectable k a c, Monad m) =>
e -> k -> c -> m a
selectBy
      (Scope -> ctx -> c -> sel -> ValidationError
forall c ref ctx.
Unknown c ref ctx =>
Scope -> ctx -> c -> ref -> ValidationError
unknown Scope
scope ctx
validatorCTX c
lib sel
selector)
      (sel -> k
forall k a. KeyOf k a => a -> k
keyOf sel
selector)
      c
lib

constraintInputUnion ::
  forall stage schemaStage.
  [UnionMember IN schemaStage] ->
  Object stage ->
  Either Message (UnionMember IN schemaStage, Maybe (Value stage))
constraintInputUnion :: [UnionMember IN schemaStage]
-> Object stage
-> Either Message (UnionMember IN schemaStage, Maybe (Value stage))
constraintInputUnion [UnionMember IN schemaStage]
tags Object stage
hm = do
  (Value stage
enum :: Value stage) <-
    ObjectEntry stage -> Value stage
forall (s :: Stage). ObjectEntry s -> Value s
entryValue
      (ObjectEntry stage -> Value stage)
-> Either Message (ObjectEntry stage)
-> Either Message (Value stage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message
-> FieldName -> Object stage -> Either Message (ObjectEntry stage)
forall e (m :: * -> *) k a c.
(Failure e m, Selectable k a c, Monad m) =>
e -> k -> c -> m a
selectBy
        ( Message
"valid input union should contain \""
            Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
__inputname
            Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
"\" and actual value"
        )
        FieldName
__inputname
        Object stage
hm
  UnionMember IN schemaStage
unionMember <- [UnionMember IN schemaStage]
-> Value stage -> Either Message (UnionMember IN schemaStage)
forall (s :: Stage) (stage :: Stage).
[UnionMember IN s]
-> Value stage -> Either Message (UnionMember IN s)
isPossibleInputUnion [UnionMember IN schemaStage]
tags Value stage
enum
  case Object stage -> Int
forall a coll. Elems a coll => coll -> Int
size Object stage
hm of
    Int
1 -> (UnionMember IN schemaStage, Maybe (Value stage))
-> Either Message (UnionMember IN schemaStage, Maybe (Value stage))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnionMember IN schemaStage
unionMember, Maybe (Value stage)
forall a. Maybe a
Nothing)
    Int
2 -> do
      Value stage
value <-
        ObjectEntry stage -> Value stage
forall (s :: Stage). ObjectEntry s -> Value s
entryValue
          (ObjectEntry stage -> Value stage)
-> Either Message (ObjectEntry stage)
-> Either Message (Value stage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message
-> FieldName -> Object stage -> Either Message (ObjectEntry stage)
forall e (m :: * -> *) k a c.
(Failure e m, Selectable k a c, Monad m) =>
e -> k -> c -> m a
selectBy
            ( Message
"value for Union \""
                Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> UnionMember IN schemaStage -> Message
forall a. Msg a => a -> Message
msg UnionMember IN schemaStage
unionMember
                Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
"\" was not Provided."
            )
            (TypeName -> FieldName
toFieldName (TypeName -> FieldName) -> TypeName -> FieldName
forall a b. (a -> b) -> a -> b
$ UnionMember IN schemaStage -> TypeName
forall (cat :: TypeCategory) (s :: Stage).
UnionMember cat s -> TypeName
memberName UnionMember IN schemaStage
unionMember)
            Object stage
hm
      (UnionMember IN schemaStage, Maybe (Value stage))
-> Either Message (UnionMember IN schemaStage, Maybe (Value stage))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnionMember IN schemaStage
unionMember, Value stage -> Maybe (Value stage)
forall a. a -> Maybe a
Just Value stage
value)
    Int
_ -> Message
-> Either Message (UnionMember IN schemaStage, Maybe (Value stage))
forall error (f :: * -> *) v. Failure error f => error -> f v
failure (Message
"input union can have only one variant." :: Message)

isPossibleInputUnion :: [UnionMember IN s] -> Value stage -> Either Message (UnionMember IN s)
isPossibleInputUnion :: [UnionMember IN s]
-> Value stage -> Either Message (UnionMember IN s)
isPossibleInputUnion [UnionMember IN s]
tags (Enum TypeName
name) =
  Message
-> TypeName
-> [UnionMember IN s]
-> Either Message (UnionMember IN s)
forall e (m :: * -> *) k a c.
(Failure e m, Selectable k a c, Monad m) =>
e -> k -> c -> m a
selectBy
    (TypeName -> Message
forall a. Msg a => a -> Message
msg TypeName
name Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
" is not possible union type")
    TypeName
name
    [UnionMember IN s]
tags
isPossibleInputUnion [UnionMember IN s]
_ Value stage
_ = Message -> Either Message (UnionMember IN s)
forall error (f :: * -> *) v. Failure error f => error -> f v
failure (Message -> Either Message (UnionMember IN s))
-> Message -> Either Message (UnionMember IN s)
forall a b. (a -> b) -> a -> b
$ Message
"\"" Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
__inputname Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
"\" must be Enum"