59 lines
2.2 KiB
Haskell
Raw Normal View History

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.GraphQL.Execute.Execution
( aliasOrName
, collectFields
) where
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Language.GraphQL.AST.Document (Name)
import Language.GraphQL.Execute.Transform
import qualified Language.GraphQL.Type.Out as Out
import Language.GraphQL.Type.Schema
collectFields :: Monad m
=> Out.ObjectType m
-> Seq (Selection m)
-> Map Name (Seq (Field m))
collectFields objectType = foldl forEach Map.empty
where
forEach groupedFields (SelectionField field) =
let responseKey = aliasOrName field
in Map.insertWith (<>) responseKey (Seq.singleton field) groupedFields
forEach groupedFields (SelectionFragment selectionFragment)
| Fragment fragmentType fragmentSelectionSet <- selectionFragment
, doesFragmentTypeApply fragmentType objectType =
let fragmentGroupedFieldSet = collectFields objectType fragmentSelectionSet
in Map.unionWith (<>) groupedFields fragmentGroupedFieldSet
| otherwise = groupedFields
aliasOrName :: forall m. Field m -> Name
aliasOrName (Field alias name _ _) = fromMaybe name alias
doesFragmentTypeApply :: forall m
. CompositeType m
-> Out.ObjectType m
-> Bool
doesFragmentTypeApply (CompositeObjectType fragmentType) objectType =
let Out.ObjectType fragmentName _ _ _ = fragmentType
Out.ObjectType objectName _ _ _ = objectType
in fragmentName == objectName
doesFragmentTypeApply (CompositeInterfaceType fragmentType) objectType =
let Out.ObjectType _ _ interfaces _ = objectType
in foldr instanceOf False interfaces
where
instanceOf (Out.InterfaceType that _ interfaces _) acc =
let Out.InterfaceType this _ _ _ = fragmentType
in acc || foldr instanceOf (this == that) interfaces
doesFragmentTypeApply (CompositeUnionType fragmentType) objectType =
let Out.UnionType _ _ members = fragmentType
in foldr instanceOf False members
where
instanceOf (Out.ObjectType that _ _ _) acc =
let Out.ObjectType this _ _ _ = objectType
in acc || this == that