content: {-# 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 name = lookup (fromString $ toString name)
  
  __argument :: (IsString name) => Argument VALID -> (name, Value)
  __argument Argument {..} = (fromString $ toString argumentName, toJSON argumentValue)
  
  __variable :: (IsString name) => Variable VALID -> (name, Value)
  __variable Variable {..} = (fromString $ toString variableName, __variableContent variableValue)
  
  __variableContent :: VariableContent VALID -> Value
  __variableContent (ValidVariableValue x) = toJSON 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 = 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 = isJust . getChild 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 node = case selectionContent node of
      SelectionField -> True
      _ -> False
  
    getChildren node = case selectionContent node of
      SelectionField -> mempty
      (SelectionSet deeperSel) -> toList deeperSel
      (UnionSelection interfaceSelection sel) ->
        concatMap toList (toList interfaceSelection)
          <> concatMap
            (toList . unionTagSelection)
            (toList sel)
  
    getChild name node = case selectionContent node of
      SelectionField -> Nothing
      (SelectionSet deeperSel) -> __lookup name deeperSel
      (UnionSelection interfaceSelection sel) -> select (toList interfaceSelection <> map unionTagSelection (toList sel))
        where
          select (x : xs) = __lookup name x <|> select xs
          select [] = Nothing
  
    getName :: (IsString name) => Selection VALID -> name
    getName = toName . selectionName
  
    getArguments = map __argument . toList . selectionArguments
  
    getArgument name = fmap (toJSON . argumentValue) . __lookup name . selectionArguments
  
  instance SelectionTree (Operation VALID) where
    type ChildNode (Operation VALID) = Selection VALID
  
    isLeaf _ = False
  
    getChildren = toList . operationSelection
  
    getChild name = __lookup name . operationSelection
  
    getName = toName . fromMaybe "Root" . operationName
  
    getArguments = map __variable . toList . operationArguments
  
    getArgument name = fmap (__variableContent . variableValue) . __lookup name . operationArguments
  
  toName :: (IsString name) => Name t -> name
  toName = fromString . unpack . unpackName
  