summaryrefslogtreecommitdiff
path: root/src/Data/GraphQL/AST/Transform.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/GraphQL/AST/Transform.hs')
-rw-r--r--src/Data/GraphQL/AST/Transform.hs123
1 files changed, 0 insertions, 123 deletions
diff --git a/src/Data/GraphQL/AST/Transform.hs b/src/Data/GraphQL/AST/Transform.hs
deleted file mode 100644
index af55772..0000000
--- a/src/Data/GraphQL/AST/Transform.hs
+++ /dev/null
@@ -1,123 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Data.GraphQL.AST.Transform where
-
-import Control.Applicative (empty)
-import Control.Monad ((<=<))
-import Data.Bifunctor (first)
-import Data.Either (partitionEithers)
-import Data.Foldable (fold, foldMap)
-import qualified Data.List.NonEmpty as NonEmpty
-import Data.Monoid (Alt(Alt,getAlt), (<>))
-
-import Data.Text (Text)
-
-import qualified Data.GraphQL.AST as Full
-import qualified Data.GraphQL.AST.Core as Core
-import qualified Data.GraphQL.Schema as Schema
-
-type Name = Text
-
--- | Replaces a fragment name by a list of 'Field'. If the name doesn't match an
--- empty list is returned.
-type Fragmenter = Name -> [Core.Field]
-
--- TODO: Replace Maybe by MonadThrow with CustomError
-document :: Schema.Subs -> Full.Document -> Maybe Core.Document
-document subs doc = operations subs fr ops
- where
- (fr, ops) = first foldFrags
- . partitionEithers
- . NonEmpty.toList
- $ defrag subs
- <$> doc
-
- foldFrags :: [Fragmenter] -> Fragmenter
- foldFrags fs n = getAlt $ foldMap (Alt . ($ n)) fs
-
--- * Operation
-
--- TODO: Replace Maybe by MonadThrow CustomError
-operations
- :: Schema.Subs
- -> Fragmenter
- -> [Full.OperationDefinition]
- -> Maybe Core.Document
-operations subs fr = NonEmpty.nonEmpty <=< traverse (operation subs fr)
-
--- TODO: Replace Maybe by MonadThrow CustomError
-operation
- :: Schema.Subs
- -> Fragmenter
- -> Full.OperationDefinition
- -> Maybe Core.Operation
-operation subs fr (Full.OperationSelectionSet sels) =
- operation subs fr $ Full.OperationDefinition Full.Query empty empty empty sels
--- TODO: Validate Variable definitions with substituter
-operation subs fr (Full.OperationDefinition ot _n _vars _dirs sels) =
- case ot of
- Full.Query -> Core.Query <$> node
- Full.Mutation -> Core.Mutation <$> node
- where
- node = traverse (hush . selection subs fr) sels
-
-selection
- :: Schema.Subs
- -> Fragmenter
- -> Full.Selection
- -> Either [Core.Field] Core.Field
-selection subs fr (Full.SelectionField fld) =
- Right $ field subs fr fld
-selection _ fr (Full.SelectionFragmentSpread (Full.FragmentSpread n _dirs)) =
- Left $ fr n
-selection _ _ (Full.SelectionInlineFragment _) =
- error "Inline fragments not supported yet"
-
--- * Fragment replacement
-
--- | Extract Fragments into a single Fragmenter function and a Operation
--- Definition.
-defrag
- :: Schema.Subs
- -> Full.Definition
- -> Either Fragmenter Full.OperationDefinition
-defrag _ (Full.DefinitionOperation op) =
- Right op
-defrag subs (Full.DefinitionFragment fragDef) =
- Left $ fragmentDefinition subs fragDef
-
-fragmentDefinition :: Schema.Subs -> Full.FragmentDefinition -> Fragmenter
-fragmentDefinition subs (Full.FragmentDefinition name _tc _dirs sels) name' =
- -- TODO: Support fragments within fragments. Fold instead of map.
- if name == name'
- then either id pure =<< NonEmpty.toList (selection subs mempty <$> sels)
- else empty
-
-field :: Schema.Subs -> Fragmenter -> Full.Field -> Core.Field
-field subs fr (Full.Field a n args _dirs sels) =
- Core.Field a n (fold $ argument subs `traverse` args) (foldr go empty sels)
- where
- go :: Full.Selection -> [Core.Field] -> [Core.Field]
- go (Full.SelectionFragmentSpread (Full.FragmentSpread name _dirs)) = (fr name <>)
- go sel = (either id pure (selection subs fr sel) <>)
-
-argument :: Schema.Subs -> Full.Argument -> Maybe Core.Argument
-argument subs (Full.Argument n v) = Core.Argument n <$> value subs v
-
-value :: Schema.Subs -> Full.Value -> Maybe Core.Value
-value subs (Full.ValueVariable n) = subs n
-value _ (Full.ValueInt i) = pure $ Core.ValueInt i
-value _ (Full.ValueFloat f) = pure $ Core.ValueFloat f
-value _ (Full.ValueString x) = pure $ Core.ValueString x
-value _ (Full.ValueBoolean b) = pure $ Core.ValueBoolean b
-value _ Full.ValueNull = pure Core.ValueNull
-value _ (Full.ValueEnum e) = pure $ Core.ValueEnum e
-value subs (Full.ValueList l) =
- Core.ValueList <$> traverse (value subs) l
-value subs (Full.ValueObject o) =
- Core.ValueObject <$> traverse (objectField subs) o
-
-objectField :: Schema.Subs -> Full.ObjectField -> Maybe Core.ObjectField
-objectField subs (Full.ObjectField n v) = Core.ObjectField n <$> value subs v
-
-hush :: Either a b -> Maybe b
-hush = either (const Nothing) Just