{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- |
-- Module      : Data.Morpheus.Types.SelectionTree
-- Description : A simple interface for Morpheus internal Selection Set's representation.
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

-- | The 'SelectionTree' instance is a simple interface for interacting
-- with morpheus's internal AST while keeping the ability to safely change the concrete
-- representation of the AST.
class SelectionTree node where
  type ChildNode node :: Type

  -- | leaf test: is the list of children empty?
  isLeaf :: node -> Bool

  -- | get a node's name (real name. not alias)
  getName :: IsString name => node -> name

  -- | Get the children
  getChildrenList :: node -> [ChildNode node]
  getChildrenList = forall node. SelectionTree node => node -> [ChildNode node]
getChildren

  -- | get the child nodes
  getChildren :: node -> [ChildNode node]

  -- | lookup child node by name (does not use aliases)
  getChild :: ToString name => name -> node -> Maybe (ChildNode node)

  -- | checks if the node has a child with the specified name (does not use aliases)
  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

  -- | get node arguments (as aeson values)
  getArguments :: IsString name => node -> [(name, Value)]

  -- | get node argument by name (as aeson values)
  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