From f64e186c60a94223eb4b5a156d986a4c78c025c7 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 30 Jun 2019 06:07:32 +0200 Subject: Move the source code into src/ --- Data/GraphQL/AST/Core.hs | 38 ------------- Data/GraphQL/AST/Transform.hs | 123 ------------------------------------------ 2 files changed, 161 deletions(-) delete mode 100644 Data/GraphQL/AST/Core.hs delete mode 100644 Data/GraphQL/AST/Transform.hs (limited to 'Data/GraphQL/AST') diff --git a/Data/GraphQL/AST/Core.hs b/Data/GraphQL/AST/Core.hs deleted file mode 100644 index f0c617c..0000000 --- a/Data/GraphQL/AST/Core.hs +++ /dev/null @@ -1,38 +0,0 @@ --- | This is the AST meant to be executed. -module Data.GraphQL.AST.Core where - -import Data.Int (Int32) -import Data.List.NonEmpty (NonEmpty) -import Data.String - -import Data.Text (Text) - -type Name = Text - -type Document = NonEmpty Operation - -data Operation = Query (NonEmpty Field) - | Mutation (NonEmpty Field) - deriving (Eq,Show) - -data Field = Field (Maybe Alias) Name [Argument] [Field] deriving (Eq,Show) - -type Alias = Name - -data Argument = Argument Name Value deriving (Eq,Show) - -data Value = ValueInt Int32 - -- GraphQL Float is double precision - | ValueFloat Double - | ValueString Text - | ValueBoolean Bool - | ValueNull - | ValueEnum Name - | ValueList [Value] - | ValueObject [ObjectField] - deriving (Eq,Show) - -instance IsString Value where - fromString = ValueString . fromString - -data ObjectField = ObjectField Name Value deriving (Eq,Show) diff --git a/Data/GraphQL/AST/Transform.hs b/Data/GraphQL/AST/Transform.hs deleted file mode 100644 index af55772..0000000 --- a/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 -- cgit v1.2.3