From 73fc334bf8d7bd6d8b83143995844ca0968ceeda Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 3 Nov 2019 10:42:10 +0100 Subject: [PATCH] Move related modules to Language.GraphQL.AST Fixes #18. - `Language.GraphQL.Encoder` moved to `Language.GraphQL.AST.Encoder`. - `Language.GraphQL.Parser` moved to `Language.GraphQL.AST.Parser`. - `Language.GraphQL.Lexer` moved to `Language.GraphQL.AST.Lexer`. - All `Language.GraphQL.AST.Value` data constructor prefixes were removed. The module should be imported qualified. - All `Language.GraphQL.AST.Core.Value` data constructor prefixes were removed. The module should be imported qualified. - `Language.GraphQL.AST.Transform` is now isn't exposed publically anymore. --- CHANGELOG.md | 16 +++ package.yaml | 2 + src/Language/GraphQL.hs | 2 +- src/Language/GraphQL/AST.hs | 77 ++++++++--- src/Language/GraphQL/AST/Core.hs | 93 +++---------- src/Language/GraphQL/{ => AST}/Encoder.hs | 122 +++++++++--------- src/Language/GraphQL/{ => AST}/Lexer.hs | 2 +- src/Language/GraphQL/{ => AST}/Parser.hs | 24 ++-- src/Language/GraphQL/AST/Transform.hs | 28 ++-- src/Language/GraphQL/Schema.hs | 20 +-- src/Language/GraphQL/Type.hs | 6 +- tests/Language/GraphQL/AST/EncoderSpec.hs | 19 +++ tests/Language/GraphQL/{ => AST}/LexerSpec.hs | 4 +- .../Language/GraphQL/{ => AST}/ParserSpec.hs | 4 +- tests/Language/GraphQL/EncoderSpec.hs | 21 --- tests/Test/KitchenSinkSpec.hs | 4 +- tests/Test/StarWars/Data.hs | 10 +- tests/Test/StarWars/Schema.hs | 20 +-- 18 files changed, 240 insertions(+), 234 deletions(-) rename src/Language/GraphQL/{ => AST}/Encoder.hs (66%) rename src/Language/GraphQL/{ => AST}/Lexer.hs (99%) rename src/Language/GraphQL/{ => AST}/Parser.hs (92%) create mode 100644 tests/Language/GraphQL/AST/EncoderSpec.hs rename tests/Language/GraphQL/{ => AST}/LexerSpec.hs (98%) rename tests/Language/GraphQL/{ => AST}/ParserSpec.hs (89%) delete mode 100644 tests/Language/GraphQL/EncoderSpec.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 79e258f..499cc7e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,22 @@ # Change Log All notable changes to this project will be documented in this file. +## Unreleased +### Changed +- `Language.GraphQL.Encoder` moved to `Language.GraphQL.AST.Encoder`. +- `Language.GraphQL.Parser` moved to `Language.GraphQL.AST.Parser`. +- `Language.GraphQL.Lexer` moved to `Language.GraphQL.AST.Lexer`. +- All `Language.GraphQL.AST.Value` data constructor prefixes were removed. The + module should be imported qualified. +- All `Language.GraphQL.AST.Core.Value` data constructor prefixes were removed. + The module should be imported qualified. +- Make `Language.GraphQL.AST.Core.Object` is now just a HashMap. +- `Language.GraphQL.AST.Transform` is now isn't exposed publically anymore. + +### Fixed +- (Unsupported) nested fragments doesn't throw a runtime error but return a + transformation error. + ## [0.5.1.0] - 2019-10-22 ### Deprecated - `Language.GraphQL.AST.Arguments`. Use `[Language.GraphQL.AST.Argument]` diff --git a/package.yaml b/package.yaml index a23dac2..cbb7337 100644 --- a/package.yaml +++ b/package.yaml @@ -35,6 +35,8 @@ dependencies: library: source-dirs: src + other-modules: + - Language.GraphQL.AST.Transform tests: tasty: diff --git a/src/Language/GraphQL.hs b/src/Language/GraphQL.hs index c33eb95..afce8aa 100644 --- a/src/Language/GraphQL.hs +++ b/src/Language/GraphQL.hs @@ -10,7 +10,7 @@ import Data.List.NonEmpty (NonEmpty) import qualified Data.Text as T import Language.GraphQL.Error import Language.GraphQL.Execute -import Language.GraphQL.Parser +import Language.GraphQL.AST.Parser import qualified Language.GraphQL.Schema as Schema import Text.Megaparsec (parse) diff --git a/src/Language/GraphQL/AST.hs b/src/Language/GraphQL/AST.hs index 29d7d80..b2feb4d 100644 --- a/src/Language/GraphQL/AST.hs +++ b/src/Language/GraphQL/AST.hs @@ -29,16 +29,15 @@ module Language.GraphQL.AST import Data.Int (Int32) import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) -import Language.GraphQL.AST.Core ( Alias - , Name - , TypeCondition - ) -- * Document -- | GraphQL document. type Document = NonEmpty Definition +-- | Name +type Name = Text + -- | Directive. data Directive = Directive Name [Argument] deriving (Eq, Show) @@ -82,12 +81,56 @@ data Selection -- * Field --- | GraphQL field. +-- | Single GraphQL field. +-- +-- The only required property of a field is its name. Optionally it can also +-- have an alias, arguments or a list of subfields. +-- +-- Given the following query: +-- +-- @ +-- { +-- zuck: user(id: 4) { +-- id +-- name +-- } +-- } +-- @ +-- +-- * "user", "id" and "name" are field names. +-- * "user" has two subfields, "id" and "name". +-- * "zuck" is an alias for "user". "id" and "name" have no aliases. +-- * "id: 4" is an argument for "name". "id" and "name don't have any +-- arguments. data Field = Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt deriving (Eq, Show) --- | Argument. +-- | Alternative field name. +-- +-- @ +-- { +-- smallPic: profilePic(size: 64) +-- bigPic: profilePic(size: 1024) +-- } +-- @ +-- +-- Here "smallPic" and "bigPic" are aliases for the same field, "profilePic", +-- used to distinquish between profile pictures with different arguments +-- (sizes). +type Alias = Name + +-- | Single argument. +-- +-- @ +-- { +-- user(id: 4) { +-- name +-- } +-- } +-- @ +-- +-- Here "id" is an argument for the field "user" and its value is 4. data Argument = Argument Name Value deriving (Eq,Show) -- * Fragments @@ -107,15 +150,15 @@ data FragmentDefinition -- * Inputs -- | Input value. -data Value = ValueVariable Name - | ValueInt Int32 - | ValueFloat Double - | ValueString Text - | ValueBoolean Bool - | ValueNull - | ValueEnum Name - | ValueList [Value] - | ValueObject [ObjectField] +data Value = Variable Name + | Int Int32 + | Float Double + | String Text + | Boolean Bool + | Null + | Enum Name + | List [Value] + | Object [ObjectField] deriving (Eq, Show) -- | Key-value pair. @@ -127,13 +170,15 @@ data ObjectField = ObjectField Name Value deriving (Eq, Show) data VariableDefinition = VariableDefinition Name Type (Maybe Value) deriving (Eq, Show) +-- | Type condition. +type TypeCondition = Name + -- | Type representation. data Type = TypeNamed Name | TypeList Type | TypeNonNull NonNullType deriving (Eq, Show) - -- | Helper type to represent Non-Null types and lists of such types. data NonNullType = NonNullTypeNamed Name | NonNullTypeList Type diff --git a/src/Language/GraphQL/AST/Core.hs b/src/Language/GraphQL/AST/Core.hs index a2a53be..2cdb122 100644 --- a/src/Language/GraphQL/AST/Core.hs +++ b/src/Language/GraphQL/AST/Core.hs @@ -6,7 +6,6 @@ module Language.GraphQL.AST.Core , Field(..) , Fragment(..) , Name - , ObjectField(..) , Operation(..) , Selection(..) , TypeCondition @@ -14,12 +13,11 @@ module Language.GraphQL.AST.Core ) where import Data.Int (Int32) +import Data.HashMap.Strict (HashMap) import Data.List.NonEmpty (NonEmpty) -import Data.String +import Data.String (IsString(..)) import Data.Text (Text) - --- | Name -type Name = Text +import Language.GraphQL.AST (Alias, Name, TypeCondition) -- | GraphQL document is a non-empty list of operations. type Document = NonEmpty Operation @@ -32,80 +30,12 @@ data Operation | Mutation (Maybe Text) (NonEmpty Selection) deriving (Eq, Show) --- | A single GraphQL field. --- --- Only required property of a field, is its name. Optionally it can also have --- an alias, arguments or a list of subfields. --- --- Given the following query: --- --- @ --- { --- zuck: user(id: 4) { --- id --- name --- } --- } --- @ --- --- * "user", "id" and "name" are field names. --- * "user" has two subfields, "id" and "name". --- * "zuck" is an alias for "user". "id" and "name" have no aliases. --- * "id: 4" is an argument for "name". "id" and "name don't have any --- arguments. +-- | Single GraphQL field. data Field = Field (Maybe Alias) Name [Argument] [Selection] deriving (Eq, Show) --- | Alternative field name. --- --- @ --- { --- smallPic: profilePic(size: 64) --- bigPic: profilePic(size: 1024) --- } --- @ --- --- Here "smallPic" and "bigPic" are aliases for the same field, "profilePic", --- used to distinquish between profile pictures with different arguments --- (sizes). -type Alias = Name - -- | Single argument. --- --- @ --- { --- user(id: 4) { --- name --- } --- } --- @ --- --- Here "id" is an argument for the field "user" and its value is 4. data Argument = Argument Name Value deriving (Eq, Show) --- | Represents accordingly typed GraphQL values. -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 - --- | Key-value pair. --- --- A list of 'ObjectField's represents a GraphQL object type. -data ObjectField = ObjectField Name Value deriving (Eq, Show) - --- | Type condition. -type TypeCondition = Name - -- | Represents fragments and inline fragments. data Fragment = Fragment TypeCondition (NonEmpty Selection) @@ -116,3 +46,18 @@ data Selection = SelectionFragment Fragment | SelectionField Field deriving (Eq, Show) + +-- | Represents accordingly typed GraphQL values. +data Value + = Int Int32 + | Float Double -- ^ GraphQL Float is double precision + | String Text + | Boolean Bool + | Null + | Enum Name + | List [Value] + | Object (HashMap Name Value) + deriving (Eq, Show) + +instance IsString Value where + fromString = String . fromString diff --git a/src/Language/GraphQL/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs similarity index 66% rename from src/Language/GraphQL/Encoder.hs rename to src/Language/GraphQL/AST/Encoder.hs index b3ec655..a8f6ca4 100644 --- a/src/Language/GraphQL/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -2,7 +2,7 @@ {-# LANGUAGE ExplicitForAll #-} -- | This module defines a minifier and a printer for the @GraphQL@ language. -module Language.GraphQL.Encoder +module Language.GraphQL.AST.Encoder ( Formatter , definition , directive @@ -21,7 +21,7 @@ import qualified Data.Text.Lazy as Text.Lazy import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder.Int (decimal) import Data.Text.Lazy.Builder.RealFloat (realFloat) -import Language.GraphQL.AST +import qualified Language.GraphQL.AST as Full -- | Instructs the encoder whether a GraphQL should be minified or pretty -- printed. @@ -40,7 +40,7 @@ minified :: Formatter minified = Minified -- | Converts a 'Document' into a string. -document :: Formatter -> Document -> Text +document :: Formatter -> Full.Document -> Text document formatter defs | Pretty _ <- formatter = Text.Lazy.intercalate "\n" encodeDocument | Minified <-formatter = Text.Lazy.snoc (mconcat encodeDocument) '\n' @@ -48,29 +48,29 @@ document formatter defs encodeDocument = NonEmpty.toList $ definition formatter <$> defs -- | Converts a 'Definition' into a string. -definition :: Formatter -> Definition -> Text +definition :: Formatter -> Full.Definition -> Text definition formatter x | Pretty _ <- formatter = Text.Lazy.snoc (encodeDefinition x) '\n' | Minified <- formatter = encodeDefinition x where - encodeDefinition (DefinitionOperation operation) + encodeDefinition (Full.DefinitionOperation operation) = operationDefinition formatter operation - encodeDefinition (DefinitionFragment fragment) + encodeDefinition (Full.DefinitionFragment fragment) = fragmentDefinition formatter fragment -operationDefinition :: Formatter -> OperationDefinition -> Text -operationDefinition formatter (OperationSelectionSet sels) +operationDefinition :: Formatter -> Full.OperationDefinition -> Text +operationDefinition formatter (Full.OperationSelectionSet sels) = selectionSet formatter sels -operationDefinition formatter (OperationDefinition Query name vars dirs sels) +operationDefinition formatter (Full.OperationDefinition Full.Query name vars dirs sels) = "query " <> node formatter name vars dirs sels -operationDefinition formatter (OperationDefinition Mutation name vars dirs sels) +operationDefinition formatter (Full.OperationDefinition Full.Mutation name vars dirs sels) = "mutation " <> node formatter name vars dirs sels node :: Formatter - -> Maybe Name - -> [VariableDefinition] - -> [Directive] - -> SelectionSet + -> Maybe Full.Name + -> [Full.VariableDefinition] + -> [Full.Directive] + -> Full.SelectionSet -> Text node formatter name vars dirs sels = Text.Lazy.fromStrict (fold name) @@ -79,39 +79,39 @@ node formatter name vars dirs sels <> eitherFormat formatter " " mempty <> selectionSet formatter sels -variableDefinitions :: Formatter -> [VariableDefinition] -> Text +variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Text variableDefinitions formatter = parensCommas formatter $ variableDefinition formatter -variableDefinition :: Formatter -> VariableDefinition -> Text -variableDefinition formatter (VariableDefinition var ty dv) +variableDefinition :: Formatter -> Full.VariableDefinition -> Text +variableDefinition formatter (Full.VariableDefinition var ty dv) = variable var <> eitherFormat formatter ": " ":" <> type' ty <> maybe mempty (defaultValue formatter) dv -defaultValue :: Formatter -> Value -> Text +defaultValue :: Formatter -> Full.Value -> Text defaultValue formatter val = eitherFormat formatter " = " "=" <> value formatter val -variable :: Name -> Text +variable :: Full.Name -> Text variable var = "$" <> Text.Lazy.fromStrict var -selectionSet :: Formatter -> SelectionSet -> Text +selectionSet :: Formatter -> Full.SelectionSet -> Text selectionSet formatter = bracesList formatter (selection formatter) . NonEmpty.toList -selectionSetOpt :: Formatter -> SelectionSetOpt -> Text +selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Text selectionSetOpt formatter = bracesList formatter $ selection formatter -selection :: Formatter -> Selection -> Text +selection :: Formatter -> Full.Selection -> Text selection formatter = Text.Lazy.append indent . f where - f (SelectionField x) = field incrementIndent x - f (SelectionInlineFragment x) = inlineFragment incrementIndent x - f (SelectionFragmentSpread x) = fragmentSpread incrementIndent x + f (Full.SelectionField x) = field incrementIndent x + f (Full.SelectionInlineFragment x) = inlineFragment incrementIndent x + f (Full.SelectionFragmentSpread x) = fragmentSpread incrementIndent x incrementIndent | Pretty n <- formatter = Pretty $ n + 1 | otherwise = Minified @@ -119,8 +119,8 @@ selection formatter = Text.Lazy.append indent . f | Pretty n <- formatter = Text.Lazy.replicate (fromIntegral $ n + 1) " " | otherwise = mempty -field :: Formatter -> Field -> Text -field formatter (Field alias name args dirs selso) +field :: Formatter -> Full.Field -> Text +field formatter (Full.Field alias name args dirs selso) = optempty (`Text.Lazy.append` colon) (Text.Lazy.fromStrict $ fold alias) <> Text.Lazy.fromStrict name <> optempty (arguments formatter) args @@ -132,31 +132,31 @@ field formatter (Field alias name args dirs selso) | null selso = mempty | otherwise = eitherFormat formatter " " mempty <> selectionSetOpt formatter selso -arguments :: Formatter -> [Argument] -> Text +arguments :: Formatter -> [Full.Argument] -> Text arguments formatter = parensCommas formatter $ argument formatter -argument :: Formatter -> Argument -> Text -argument formatter (Argument name v) +argument :: Formatter -> Full.Argument -> Text +argument formatter (Full.Argument name v) = Text.Lazy.fromStrict name <> eitherFormat formatter ": " ":" <> value formatter v -- * Fragments -fragmentSpread :: Formatter -> FragmentSpread -> Text -fragmentSpread formatter (FragmentSpread name ds) +fragmentSpread :: Formatter -> Full.FragmentSpread -> Text +fragmentSpread formatter (Full.FragmentSpread name ds) = "..." <> Text.Lazy.fromStrict name <> optempty (directives formatter) ds -inlineFragment :: Formatter -> InlineFragment -> Text -inlineFragment formatter (InlineFragment tc dirs sels) +inlineFragment :: Formatter -> Full.InlineFragment -> Text +inlineFragment formatter (Full.InlineFragment tc dirs sels) = "... on " <> Text.Lazy.fromStrict (fold tc) <> directives formatter dirs <> eitherFormat formatter " " mempty <> selectionSet formatter sels -fragmentDefinition :: Formatter -> FragmentDefinition -> Text -fragmentDefinition formatter (FragmentDefinition name tc dirs sels) +fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Text +fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels) = "fragment " <> Text.Lazy.fromStrict name <> " on " <> Text.Lazy.fromStrict tc <> optempty (directives formatter) dirs @@ -166,25 +166,25 @@ fragmentDefinition formatter (FragmentDefinition name tc dirs sels) -- * Miscellaneous -- | Converts a 'Directive' into a string. -directive :: Formatter -> Directive -> Text -directive formatter (Directive name args) +directive :: Formatter -> Full.Directive -> Text +directive formatter (Full.Directive name args) = "@" <> Text.Lazy.fromStrict name <> optempty (arguments formatter) args -directives :: Formatter -> [Directive] -> Text +directives :: Formatter -> [Full.Directive] -> Text directives formatter@(Pretty _) = Text.Lazy.cons ' ' . spaces (directive formatter) directives Minified = spaces (directive Minified) -- | Converts a 'Value' into a string. -value :: Formatter -> Value -> Text -value _ (ValueVariable x) = variable x -value _ (ValueInt x) = toLazyText $ decimal x -value _ (ValueFloat x) = toLazyText $ realFloat x -value _ (ValueBoolean x) = booleanValue x -value _ ValueNull = mempty -value _ (ValueString x) = stringValue $ Text.Lazy.fromStrict x -value _ (ValueEnum x) = Text.Lazy.fromStrict x -value formatter (ValueList x) = listValue formatter x -value formatter (ValueObject x) = objectValue formatter x +value :: Formatter -> Full.Value -> Text +value _ (Full.Variable x) = variable x +value _ (Full.Int x) = toLazyText $ decimal x +value _ (Full.Float x) = toLazyText $ realFloat x +value _ (Full.Boolean x) = booleanValue x +value _ Full.Null = mempty +value _ (Full.String x) = stringValue $ Text.Lazy.fromStrict x +value _ (Full.Enum x) = Text.Lazy.fromStrict x +value formatter (Full.List x) = listValue formatter x +value formatter (Full.Object x) = objectValue formatter x booleanValue :: Bool -> Text booleanValue True = "true" @@ -196,10 +196,10 @@ stringValue . Text.Lazy.replace "\"" "\\\"" . Text.Lazy.replace "\\" "\\\\" -listValue :: Formatter -> [Value] -> Text +listValue :: Formatter -> [Full.Value] -> Text listValue formatter = bracketsCommas formatter $ value formatter -objectValue :: Formatter -> [ObjectField] -> Text +objectValue :: Formatter -> [Full.ObjectField] -> Text objectValue formatter = intercalate $ objectField formatter where intercalate f @@ -208,8 +208,8 @@ objectValue formatter = intercalate $ objectField formatter . fmap f -objectField :: Formatter -> ObjectField -> Text -objectField formatter (ObjectField name v) +objectField :: Formatter -> Full.ObjectField -> Text +objectField formatter (Full.ObjectField name v) = Text.Lazy.fromStrict name <> colon <> value formatter v where colon @@ -217,17 +217,17 @@ objectField formatter (ObjectField name v) | Minified <- formatter = ":" -- | Converts a 'Type' a type into a string. -type' :: Type -> Text -type' (TypeNamed x) = Text.Lazy.fromStrict x -type' (TypeList x) = listType x -type' (TypeNonNull x) = nonNullType x +type' :: Full.Type -> Text +type' (Full.TypeNamed x) = Text.Lazy.fromStrict x +type' (Full.TypeList x) = listType x +type' (Full.TypeNonNull x) = nonNullType x -listType :: Type -> Text +listType :: Full.Type -> Text listType x = brackets (type' x) -nonNullType :: NonNullType -> Text -nonNullType (NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!" -nonNullType (NonNullTypeList x) = listType x <> "!" +nonNullType :: Full.NonNullType -> Text +nonNullType (Full.NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!" +nonNullType (Full.NonNullTypeList x) = listType x <> "!" -- * Internal diff --git a/src/Language/GraphQL/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs similarity index 99% rename from src/Language/GraphQL/Lexer.hs rename to src/Language/GraphQL/AST/Lexer.hs index dc000b5..97a334c 100644 --- a/src/Language/GraphQL/Lexer.hs +++ b/src/Language/GraphQL/AST/Lexer.hs @@ -3,7 +3,7 @@ -- | This module defines a bunch of small parsers used to parse individual -- lexemes. -module Language.GraphQL.Lexer +module Language.GraphQL.AST.Lexer ( Parser , amp , at diff --git a/src/Language/GraphQL/Parser.hs b/src/Language/GraphQL/AST/Parser.hs similarity index 92% rename from src/Language/GraphQL/Parser.hs rename to src/Language/GraphQL/AST/Parser.hs index bbe1de7..a5b6681 100644 --- a/src/Language/GraphQL/Parser.hs +++ b/src/Language/GraphQL/AST/Parser.hs @@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} -- | @GraphQL@ document parser. -module Language.GraphQL.Parser +module Language.GraphQL.AST.Parser ( document ) where @@ -11,7 +11,7 @@ import Control.Applicative ( Alternative(..) ) import Data.List.NonEmpty (NonEmpty(..)) import Language.GraphQL.AST -import Language.GraphQL.Lexer +import Language.GraphQL.AST.Lexer import Text.Megaparsec ( lookAhead , option , try @@ -105,16 +105,16 @@ typeCondition = symbol "on" *> name -- * Input Values value :: Parser Value -value = ValueVariable <$> variable - <|> ValueFloat <$> try float - <|> ValueInt <$> integer - <|> ValueBoolean <$> booleanValue - <|> ValueNull <$ symbol "null" - <|> ValueString <$> blockString - <|> ValueString <$> string - <|> ValueEnum <$> try enumValue - <|> ValueList <$> listValue - <|> ValueObject <$> objectValue +value = Variable <$> variable + <|> Float <$> try float + <|> Int <$> integer + <|> Boolean <$> booleanValue + <|> Null <$ symbol "null" + <|> String <$> blockString + <|> String <$> string + <|> Enum <$> try enumValue + <|> List <$> listValue + <|> Object <$> objectValue "value error!" where booleanValue :: Parser Bool diff --git a/src/Language/GraphQL/AST/Transform.hs b/src/Language/GraphQL/AST/Transform.hs index 107e1c6..ea90bab 100644 --- a/src/Language/GraphQL/AST/Transform.hs +++ b/src/Language/GraphQL/AST/Transform.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TupleSections #-} + -- | After the document is parsed, before getting executed the AST is -- transformed into a similar, simpler AST. This module is responsible for -- this transformation. @@ -113,20 +115,20 @@ 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 +value subs (Full.Variable n) = subs n +value _ (Full.Int i) = pure $ Core.Int i +value _ (Full.Float f) = pure $ Core.Float f +value _ (Full.String x) = pure $ Core.String x +value _ (Full.Boolean b) = pure $ Core.Boolean b +value _ Full.Null = pure Core.Null +value _ (Full.Enum e) = pure $ Core.Enum e +value subs (Full.List l) = + Core.List <$> traverse (value subs) l +value subs (Full.Object o) = + Core.Object . HashMap.fromList <$> traverse (objectField subs) o -objectField :: Schema.Subs -> Full.ObjectField -> Maybe Core.ObjectField -objectField subs (Full.ObjectField n v) = Core.ObjectField n <$> value subs v +objectField :: Schema.Subs -> Full.ObjectField -> Maybe (Core.Name, Core.Value) +objectField subs (Full.ObjectField n v) = (n,) <$> value subs v appendSelectionOpt :: Traversable t => diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs index d7e698b..44e9077 100644 --- a/src/Language/GraphQL/Schema.hs +++ b/src/Language/GraphQL/Schema.hs @@ -30,10 +30,10 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Text (Text) import qualified Data.Text as T +import Language.GraphQL.AST.Core import Language.GraphQL.Error import Language.GraphQL.Trans -import Language.GraphQL.Type -import Language.GraphQL.AST.Core +import qualified Language.GraphQL.Type as Type -- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error -- information (if an error has occurred). @m@ is usually expected to be an @@ -58,7 +58,7 @@ objectA name f = Resolver name $ resolveFieldValue f resolveRight -- | Like 'object' but also taking 'Argument's and can be null or a list of objects. wrappedObjectA :: MonadIO m - => Name -> ([Argument] -> ActionT m (Wrapping [Resolver m])) -> Resolver m + => Name -> ([Argument] -> ActionT m (Type.Wrapping [Resolver m])) -> Resolver m wrappedObjectA name f = Resolver name $ resolveFieldValue f resolveRight where resolveRight fld@(Field _ _ _ sels) resolver @@ -66,7 +66,7 @@ wrappedObjectA name f = Resolver name $ resolveFieldValue f resolveRight -- | Like 'object' but can be null or a list of objects. wrappedObject :: MonadIO m - => Name -> ActionT m (Wrapping [Resolver m]) -> Resolver m + => Name -> ActionT m (Type.Wrapping [Resolver m]) -> Resolver m wrappedObject name = wrappedObjectA name . const -- | A scalar represents a primitive value, like a string or an integer. @@ -80,19 +80,19 @@ scalarA name f = Resolver name $ resolveFieldValue f resolveRight where resolveRight fld result = withField (return result) fld --- | Lika 'scalar' but also taking 'Argument's and can be null or a list of scalars. +-- | Like 'scalar' but also taking 'Argument's and can be null or a list of scalars. wrappedScalarA :: (MonadIO m, Aeson.ToJSON a) - => Name -> ([Argument] -> ActionT m (Wrapping a)) -> Resolver m + => Name -> ([Argument] -> ActionT m (Type.Wrapping a)) -> Resolver m wrappedScalarA name f = Resolver name $ resolveFieldValue f resolveRight where - resolveRight fld (Named result) = withField (return result) fld - resolveRight fld Null + resolveRight fld (Type.Named result) = withField (return result) fld + resolveRight fld Type.Null = return $ HashMap.singleton (aliasOrName fld) Aeson.Null - resolveRight fld (List result) = withField (return result) fld + resolveRight fld (Type.List result) = withField (return result) fld -- | Like 'scalar' but can be null or a list of scalars. wrappedScalar :: (MonadIO m, Aeson.ToJSON a) - => Name -> ActionT m (Wrapping a) -> Resolver m + => Name -> ActionT m (Type.Wrapping a) -> Resolver m wrappedScalar name = wrappedScalarA name . const resolveFieldValue :: MonadIO m diff --git a/src/Language/GraphQL/Type.hs b/src/Language/GraphQL/Type.hs index 3f91e50..c8a9997 100644 --- a/src/Language/GraphQL/Type.hs +++ b/src/Language/GraphQL/Type.hs @@ -1,11 +1,9 @@ --- | Definitions for @GraphQL@ type system. +-- | Definitions for @GraphQL@ input types. module Language.GraphQL.Type ( Wrapping(..) ) where -import Data.Aeson as Aeson ( ToJSON - , toJSON - ) +import Data.Aeson as Aeson (ToJSON, toJSON) import qualified Data.Aeson as Aeson -- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping diff --git a/tests/Language/GraphQL/AST/EncoderSpec.hs b/tests/Language/GraphQL/AST/EncoderSpec.hs new file mode 100644 index 0000000..a418a61 --- /dev/null +++ b/tests/Language/GraphQL/AST/EncoderSpec.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} +module Language.GraphQL.AST.EncoderSpec + ( spec + ) where + +import Language.GraphQL.AST (Value(..)) +import Language.GraphQL.AST.Encoder +import Test.Hspec ( Spec + , describe + , it + , shouldBe + ) + +spec :: Spec +spec = describe "value" $ do + it "escapes \\" $ + value minified (String "\\") `shouldBe` "\"\\\\\"" + it "escapes quotes" $ + value minified (String "\"") `shouldBe` "\"\\\"\"" diff --git a/tests/Language/GraphQL/LexerSpec.hs b/tests/Language/GraphQL/AST/LexerSpec.hs similarity index 98% rename from tests/Language/GraphQL/LexerSpec.hs rename to tests/Language/GraphQL/AST/LexerSpec.hs index 274b29a..b1c280f 100644 --- a/tests/Language/GraphQL/LexerSpec.hs +++ b/tests/Language/GraphQL/AST/LexerSpec.hs @@ -1,12 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -module Language.GraphQL.LexerSpec +module Language.GraphQL.AST.LexerSpec ( spec ) where import Data.Text (Text) import Data.Void (Void) -import Language.GraphQL.Lexer +import Language.GraphQL.AST.Lexer import Test.Hspec (Spec, context, describe, it) import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn) import Text.Megaparsec (ParseErrorBundle, parse) diff --git a/tests/Language/GraphQL/ParserSpec.hs b/tests/Language/GraphQL/AST/ParserSpec.hs similarity index 89% rename from tests/Language/GraphQL/ParserSpec.hs rename to tests/Language/GraphQL/AST/ParserSpec.hs index 9b71c62..8473d73 100644 --- a/tests/Language/GraphQL/ParserSpec.hs +++ b/tests/Language/GraphQL/AST/ParserSpec.hs @@ -1,10 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -module Language.GraphQL.ParserSpec +module Language.GraphQL.AST.ParserSpec ( spec ) where -import Language.GraphQL.Parser (document) +import Language.GraphQL.AST.Parser import Test.Hspec (Spec, describe, it) import Test.Hspec.Megaparsec (shouldSucceedOn) import Text.Megaparsec (parse) diff --git a/tests/Language/GraphQL/EncoderSpec.hs b/tests/Language/GraphQL/EncoderSpec.hs deleted file mode 100644 index d2d4a00..0000000 --- a/tests/Language/GraphQL/EncoderSpec.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module Language.GraphQL.EncoderSpec - ( spec - ) where - -import Language.GraphQL.AST ( Value(..)) -import Language.GraphQL.Encoder ( value - , minified - ) -import Test.Hspec ( Spec - , describe - , it - , shouldBe - ) - -spec :: Spec -spec = describe "value" $ do - it "escapes \\" $ - value minified (ValueString "\\") `shouldBe` "\"\\\\\"" - it "escapes quotes" $ - value minified (ValueString "\"") `shouldBe` "\"\\\"\"" diff --git a/tests/Test/KitchenSinkSpec.hs b/tests/Test/KitchenSinkSpec.hs index 674f85b..9f5a947 100644 --- a/tests/Test/KitchenSinkSpec.hs +++ b/tests/Test/KitchenSinkSpec.hs @@ -7,8 +7,8 @@ module Test.KitchenSinkSpec import qualified Data.Text.IO as Text.IO import qualified Data.Text.Lazy.IO as Text.Lazy.IO import qualified Data.Text.Lazy as Lazy (Text) -import qualified Language.GraphQL.Encoder as Encoder -import qualified Language.GraphQL.Parser as Parser +import qualified Language.GraphQL.AST.Encoder as Encoder +import qualified Language.GraphQL.AST.Parser as Parser import Paths_graphql (getDataFileName) import Test.Hspec (Spec, describe, it) import Test.Hspec.Megaparsec (parseSatisfies) diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs index 6a514c5..4854f8f 100644 --- a/tests/Test/StarWars/Data.hs +++ b/tests/Test/StarWars/Data.hs @@ -26,7 +26,7 @@ import Control.Monad.Trans.Except (throwE) import Data.Maybe (catMaybes) import Data.Text (Text) import Language.GraphQL.Trans -import Language.GraphQL.Type +import qualified Language.GraphQL.Type as Type -- * Data -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js @@ -191,8 +191,8 @@ getDroid' _ = empty getFriends :: Character -> [Character] getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char -getEpisode :: Int -> Maybe (Wrapping Text) -getEpisode 4 = pure $ Named "NEWHOPE" -getEpisode 5 = pure $ Named "EMPIRE" -getEpisode 6 = pure $ Named "JEDI" +getEpisode :: Int -> Maybe (Type.Wrapping Text) +getEpisode 4 = pure $ Type.Named "NEWHOPE" +getEpisode 5 = pure $ Type.Named "EMPIRE" +getEpisode 6 = pure $ Type.Named "JEDI" getEpisode _ = empty diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs index f516f2a..7b98747 100644 --- a/tests/Test/StarWars/Schema.hs +++ b/tests/Test/StarWars/Schema.hs @@ -15,7 +15,7 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (catMaybes) import qualified Language.GraphQL.Schema as Schema import Language.GraphQL.Trans -import Language.GraphQL.Type +import qualified Language.GraphQL.Type as Type import Test.StarWars.Data -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js @@ -26,23 +26,23 @@ schema = hero :| [human, droid] hero :: MonadIO m => Schema.Resolver m hero = Schema.objectA "hero" $ \case [] -> character artoo - [Schema.Argument "episode" (Schema.ValueEnum "NEWHOPE")] -> character $ getHero 4 - [Schema.Argument "episode" (Schema.ValueEnum "EMPIRE" )] -> character $ getHero 5 - [Schema.Argument "episode" (Schema.ValueEnum "JEDI" )] -> character $ getHero 6 + [Schema.Argument "episode" (Schema.Enum "NEWHOPE")] -> character $ getHero 4 + [Schema.Argument "episode" (Schema.Enum "EMPIRE" )] -> character $ getHero 5 + [Schema.Argument "episode" (Schema.Enum "JEDI" )] -> character $ getHero 6 _ -> ActionT $ throwE "Invalid arguments." human :: MonadIO m => Schema.Resolver m human = Schema.wrappedObjectA "human" $ \case - [Schema.Argument "id" (Schema.ValueString i)] -> do + [Schema.Argument "id" (Schema.String i)] -> do humanCharacter <- lift $ return $ getHuman i >>= Just case humanCharacter of - Nothing -> return Null - Just e -> Named <$> character e + Nothing -> return Type.Null + Just e -> Type.Named <$> character e _ -> ActionT $ throwE "Invalid arguments." droid :: MonadIO m => Schema.Resolver m droid = Schema.objectA "droid" $ \case - [Schema.Argument "id" (Schema.ValueString i)] -> character =<< liftIO (getDroid i) + [Schema.Argument "id" (Schema.String i)] -> character =<< liftIO (getDroid i) _ -> ActionT $ throwE "Invalid arguments." character :: MonadIO m => Character -> ActionT m [Schema.Resolver m] @@ -50,8 +50,8 @@ character char = return [ Schema.scalar "id" $ return $ id_ char , Schema.scalar "name" $ return $ name char , Schema.wrappedObject "friends" - $ traverse character $ List $ Named <$> getFriends char - , Schema.wrappedScalar "appearsIn" $ return . List + $ traverse character $ Type.List $ Type.Named <$> getFriends char + , Schema.wrappedScalar "appearsIn" $ return . Type.List $ catMaybes (getEpisode <$> appearsIn char) , Schema.scalar "secretBackstory" $ secretBackstory char , Schema.scalar "homePlanet" $ return $ either mempty homePlanet char