{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.SelectionTree
( SelectionTree (..),
)
where
import Data.Aeson (ToJSON (..), Value)
import Data.Morpheus.Internal.Utils (IsMap (lookup))
import Data.Morpheus.Types.Internal.AST
( Argument (..),
Operation (..),
Selection (..),
SelectionContent (..),
UnionTag (..),
VALID,
Variable (..),
VariableContent (..),
unpackName,
)
import Data.Morpheus.Types.Internal.AST.Name (Name)
import Data.Text (unpack)
import Relude hiding (empty)
__lookup :: (IsMap (Name t) m, ToString n) => n -> m a -> Maybe a
__lookup :: forall (t :: NAME) (m :: * -> *) n a.
(IsMap (Name t) m, ToString n) =>
n -> m a -> Maybe a
__lookup n
name = forall k (m :: * -> *) a. IsMap k m => k -> m a -> Maybe a
lookup (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> String
toString n
name)
__argument :: IsString name => Argument VALID -> (name, Value)
__argument :: forall name. IsString name => Argument VALID -> (name, Value)
__argument Argument {Position
FieldName
Value VALID
argumentValue :: forall (valid :: Stage). Argument valid -> Value valid
argumentName :: forall (valid :: Stage). Argument valid -> FieldName
argumentPosition :: forall (valid :: Stage). Argument valid -> Position
argumentValue :: Value VALID
argumentName :: FieldName
argumentPosition :: Position
..} = (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> String
toString FieldName
argumentName, forall a. ToJSON a => a -> Value
toJSON Value VALID
argumentValue)
__variable :: IsString name => Variable VALID -> (name, Value)
__variable :: forall name. IsString name => Variable VALID -> (name, Value)
__variable Variable {Position
FieldName
TypeRef
VariableContent (CONST_OR_VALID VALID)
variableValue :: forall (stage :: Stage).
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableType :: forall (stage :: Stage). Variable stage -> TypeRef
variableName :: forall (stage :: Stage). Variable stage -> FieldName
variablePosition :: forall (stage :: Stage). Variable stage -> Position
variableValue :: VariableContent (CONST_OR_VALID VALID)
variableType :: TypeRef
variableName :: FieldName
variablePosition :: Position
..} = (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. ToString a => a -> String
toString FieldName
variableName, VariableContent VALID -> Value
__variableContent VariableContent (CONST_OR_VALID VALID)
variableValue)
__variableContent :: VariableContent VALID -> Value
__variableContent :: VariableContent VALID -> Value
__variableContent (ValidVariableValue Value VALID
x) = forall a. ToJSON a => a -> Value
toJSON Value VALID
x
class SelectionTree node where
type ChildNode node :: Type
isLeaf :: node -> Bool
getName :: IsString name => node -> name
getChildrenList :: node -> [ChildNode node]
getChildrenList = forall node. SelectionTree node => node -> [ChildNode node]
getChildren
getChildren :: node -> [ChildNode node]
getChild :: ToString name => name -> node -> Maybe (ChildNode node)
hasChild :: ToString name => name -> node -> Bool
hasChild name
name = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall node name.
(SelectionTree node, ToString name) =>
name -> node -> Maybe (ChildNode node)
getChild name
name
getArguments :: IsString name => node -> [(name, Value)]
getArgument :: ToString name => name -> node -> Maybe Value
instance SelectionTree (Selection VALID) where
type ChildNode (Selection VALID) = Selection VALID
isLeaf :: Selection VALID -> Bool
isLeaf Selection VALID
node = case forall (s :: Stage). Selection s -> SelectionContent s
selectionContent Selection VALID
node of
SelectionContent VALID
SelectionField -> Bool
True
SelectionContent VALID
_ -> Bool
False
getChildren :: Selection VALID -> [ChildNode (Selection VALID)]
getChildren Selection VALID
node = case forall (s :: Stage). Selection s -> SelectionContent s
selectionContent Selection VALID
node of
SelectionContent VALID
SelectionField -> forall a. Monoid a => a
mempty
(SelectionSet SelectionSet VALID
deeperSel) -> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet VALID
deeperSel
(UnionSelection SelectionSet VALID
interfaceSelection UnionSelection VALID
sel) ->
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet VALID
interfaceSelection
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionTag -> SelectionSet VALID
unionTagSelection)
(forall (t :: * -> *) a. Foldable t => t a -> [a]
toList UnionSelection VALID
sel)
getChild :: forall name.
ToString name =>
name -> Selection VALID -> Maybe (ChildNode (Selection VALID))
getChild name
name Selection VALID
node = case forall (s :: Stage). Selection s -> SelectionContent s
selectionContent Selection VALID
node of
SelectionContent VALID
SelectionField -> forall a. Maybe a
Nothing
(SelectionSet SelectionSet VALID
deeperSel) -> forall (t :: NAME) (m :: * -> *) n a.
(IsMap (Name t) m, ToString n) =>
n -> m a -> Maybe a
__lookup name
name SelectionSet VALID
deeperSel
(UnionSelection SelectionSet VALID
interfaceSelection UnionSelection VALID
sel) -> [MergeMap 'False FieldName (Selection VALID)]
-> Maybe (Selection VALID)
select (SelectionSet VALID
interfaceSelection forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map UnionTag -> SelectionSet VALID
unionTagSelection (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList UnionSelection VALID
sel))
where
select :: [MergeMap 'False FieldName (Selection VALID)]
-> Maybe (Selection VALID)
select (MergeMap 'False FieldName (Selection VALID)
x : [MergeMap 'False FieldName (Selection VALID)]
xs) = forall (t :: NAME) (m :: * -> *) n a.
(IsMap (Name t) m, ToString n) =>
n -> m a -> Maybe a
__lookup name
name MergeMap 'False FieldName (Selection VALID)
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [MergeMap 'False FieldName (Selection VALID)]
-> Maybe (Selection VALID)
select [MergeMap 'False FieldName (Selection VALID)]
xs
select [] = forall a. Maybe a
Nothing
getName :: IsString name => Selection VALID -> name
getName :: forall name. IsString name => Selection VALID -> name
getName = forall name (t :: NAME). IsString name => Name t -> name
toName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). Selection s -> FieldName
selectionName
getArguments :: forall name. IsString name => Selection VALID -> [(name, Value)]
getArguments = forall a b. (a -> b) -> [a] -> [b]
map forall name. IsString name => Argument VALID -> (name, Value)
__argument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). Selection s -> Arguments s
selectionArguments
getArgument :: forall name.
ToString name =>
name -> Selection VALID -> Maybe Value
getArgument name
name = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (valid :: Stage). Argument valid -> Value valid
argumentValue) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: NAME) (m :: * -> *) n a.
(IsMap (Name t) m, ToString n) =>
n -> m a -> Maybe a
__lookup name
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). Selection s -> Arguments s
selectionArguments
instance SelectionTree (Operation VALID) where
type ChildNode (Operation VALID) = Selection VALID
isLeaf :: Operation VALID -> Bool
isLeaf Operation VALID
_ = Bool
False
getChildren :: Operation VALID -> [ChildNode (Operation VALID)]
getChildren = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). Operation s -> SelectionSet s
operationSelection
getChild :: forall name.
ToString name =>
name -> Operation VALID -> Maybe (ChildNode (Operation VALID))
getChild name
name = forall (t :: NAME) (m :: * -> *) n a.
(IsMap (Name t) m, ToString n) =>
n -> m a -> Maybe a
__lookup name
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). Operation s -> SelectionSet s
operationSelection
getName :: forall name. IsString name => Operation VALID -> name
getName = forall name (t :: NAME). IsString name => Name t -> name
toName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe FieldName
"Root" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). Operation s -> Maybe FieldName
operationName
getArguments :: forall name. IsString name => Operation VALID -> [(name, Value)]
getArguments = forall a b. (a -> b) -> [a] -> [b]
map forall name. IsString name => Variable VALID -> (name, Value)
__variable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). Operation s -> VariableDefinitions s
operationArguments
getArgument :: forall name.
ToString name =>
name -> Operation VALID -> Maybe Value
getArgument name
name = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (VariableContent VALID -> Value
__variableContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (stage :: Stage).
Variable stage -> VariableContent (CONST_OR_VALID stage)
variableValue) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: NAME) (m :: * -> *) n a.
(IsMap (Name t) m, ToString n) =>
n -> m a -> Maybe a
__lookup name
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: Stage). Operation s -> VariableDefinitions s
operationArguments
toName :: IsString name => Name t -> name
toName :: forall name (t :: NAME). IsString name => Name t -> name
toName = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: NAME). NamePacking a => Name t -> a
unpackName