{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- |
-- Module      : Data.Morpheus.Types.SelectionTree
-- Description : A simple interface for Morpheus internal Selection Set's representation.
module Data.Morpheus.Types.SelectionTree where

import Data.Morpheus.Internal.Utils (keyOf)
import Data.Morpheus.Types.Internal.AST
  ( Selection (..),
    SelectionContent (..),
    UnionTag (..),
    VALID,
    unpackName,
  )
import Data.Text (unpack)
import Relude

-- | 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.
-- The set of operation is very limited on purpose.
class SelectionTree nodeType where
  -- | leaf test: is the list of children empty?
  isLeaf :: nodeType -> Bool

  -- | Get the children
  getChildrenList :: nodeType -> [nodeType]

  -- | get a node's name
  getName :: IsString name => nodeType -> name

instance SelectionTree (Selection VALID) where
  isLeaf :: Selection VALID -> Bool
isLeaf Selection VALID
node = case Selection VALID -> SelectionContent VALID
forall (s :: Stage). Selection s -> SelectionContent s
selectionContent Selection VALID
node of
    SelectionContent VALID
SelectionField -> Bool
True
    SelectionContent VALID
_ -> Bool
False

  getChildrenList :: Selection VALID -> [Selection VALID]
getChildrenList Selection VALID
node = case Selection VALID -> SelectionContent VALID
forall (s :: Stage). Selection s -> SelectionContent s
selectionContent Selection VALID
node of
    SelectionContent VALID
SelectionField -> [Selection VALID]
forall a. Monoid a => a
mempty
    (SelectionSet SelectionSet VALID
deeperSel) -> MergeMap 'False FieldName (Selection VALID) -> [Selection VALID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList MergeMap 'False FieldName (Selection VALID)
SelectionSet VALID
deeperSel
    (UnionSelection SelectionSet VALID
interfaceSelection UnionSelection VALID
sel) ->
      MergeMap 'False FieldName (Selection VALID) -> [Selection VALID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList MergeMap 'False FieldName (Selection VALID)
SelectionSet VALID
interfaceSelection
        [Selection VALID] -> [Selection VALID] -> [Selection VALID]
forall a. Semigroup a => a -> a -> a
<> (UnionTag -> [Selection VALID]) -> [UnionTag] -> [Selection VALID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (MergeMap 'False FieldName (Selection VALID) -> [Selection VALID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (MergeMap 'False FieldName (Selection VALID) -> [Selection VALID])
-> (UnionTag -> MergeMap 'False FieldName (Selection VALID))
-> UnionTag
-> [Selection VALID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnionTag -> MergeMap 'False FieldName (Selection VALID)
UnionTag -> SelectionSet VALID
unionTagSelection)
          (MergeMap 'False TypeName UnionTag -> [UnionTag]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList MergeMap 'False TypeName UnionTag
UnionSelection VALID
sel)

  getName :: Selection VALID -> name
getName =
    String -> name
forall a. IsString a => String -> a
fromString
      (String -> name)
-> (Selection VALID -> String) -> Selection VALID -> name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
      (Text -> String)
-> (Selection VALID -> Text) -> Selection VALID -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
forall a (t :: NAME). NamePacking a => Name t -> a
unpackName
      (FieldName -> Text)
-> (Selection VALID -> FieldName) -> Selection VALID -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selection VALID -> FieldName
forall k a. KeyOf k a => a -> k
keyOf