diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,23 @@ # Change Log All notable changes to this project will be documented in this file. +## [0.5.0.0] - 2019-08-14 +### Added +- `executeWithName` executes an operation with the given name. +- Export `Language.GraphQL.Encoder.definition`, + `Language.GraphQL.Encoder.type'` and `Language.GraphQL.Encoder.directive`. +- Export `Language.GraphQL.Encoder.value`. Escapes \ and " in strings now. + +### Changed +- `Operation` includes now possible operation name which allows to support + documents with multiple operations. +- `Language.GraphQL.Encoder.document` and other encoding functions take a + `Formatter` as argument to distinguish between minified and pretty printing. +- All encoder functions return `Data.Text.Lazy`. + +### Removed +- Unused `Language.GraphQL.Encoder.spaced`. + ## [0.4.0.0] - 2019-07-23 ### Added - Support for mutations. @@ -53,6 +70,7 @@ ### Added - Data types for the GraphQL language. +[0.5.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.4.0.0...v0.5.0.0 [0.4.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.3...v0.4.0.0 [0.3]: https://github.com/caraus-ecms/graphql/compare/v0.2.1...v0.3 [0.2.1]: https://github.com/caraus-ecms/graphql/compare/v0.2...v0.2.1 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,24 +4,37 @@ [![Build Status](https://semaphoreci.com/api/v1/belka-ew/graphql/branches/master/badge.svg)](https://semaphoreci.com/belka-ew/graphql) [![License](https://img.shields.io/badge/license-BSD--3--Clause-blue.svg)](https://raw.githubusercontent.com/caraus-ecms/graphql/master/LICENSE) -For now this only provides a parser for the GraphQL query language and allows -to execute queries and mutations without the schema validation step. -But the idea is to be a Haskell port of -[`graphql-js`](https://github.com/graphql/graphql-js). Next releases should -include: +GraphQL implementation in Haskell. -- [x] GraphQL AST -- [x] Parser for the GraphQL language. -- [x] Printer for GraphQL. This is not pretty yet. -- [ ] GraphQL Schema AST. -- [ ] Parser for the GraphQL Schema language. -- [ ] Printer for the GraphQL Schema language. -- [ ] Interpreter of GraphQL requests. -- [ ] Utilities to define GraphQL types and schema. +This implementation is relatively low-level by design, it doesn't provide any +mappings between the GraphQL types and Haskell's type system and avoids +compile-time magic. It focuses on flexibility instead instead, so other +solutions can be built on top of it. +## State of the work + +For now this only provides a parser and a printer for the GraphQL query +language and allows to execute queries and mutations without the schema +validation step. But the idea is to be a Haskell port of +[`graphql-js`](https://github.com/graphql/graphql-js). + +For the list of currently missing features see issues marked as +"[not implemented](https://github.com/caraus-ecms/graphql/labels/not%20implemented)". + +## Documentation + +API documentation is available through +[hackage](https://hackage.haskell.org/package/graphql). + +You'll also find a small tutorial with some examples under +[docs/tutorial](https://github.com/caraus-ecms/graphql/tree/master/docs/tutorial). + ## Contact Suggestions, contributions and bug reports are welcome. + +Should you have questions on usage, please open an issue and ask – this helps +to write useful documentation. Feel free to contact on Slack in [#haskell on GraphQL](https://graphql.slack.com/messages/haskell/). You can obtain an diff --git a/graphql.cabal b/graphql.cabal --- a/graphql.cabal +++ b/graphql.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: graphql -version: 0.4.0.0 +version: 0.5.0.0 license: BSD3 license-file: LICENSE copyright: (c) 2019 Eugen Wissner, @@ -48,7 +48,7 @@ Paths_graphql default-language: Haskell2010 build-depends: - aeson >=1.4.2.0 && <1.5, + aeson >=1.4.4.0 && <1.5, base >=4.7 && <5, megaparsec >=7.0.5 && <7.1, text >=1.2.3.1 && <1.3, @@ -60,6 +60,7 @@ main-is: Spec.hs hs-source-dirs: tests other-modules: + Language.GraphQL.EncoderSpec Language.GraphQL.ErrorSpec Language.GraphQL.LexerSpec Language.GraphQL.ParserSpec @@ -71,10 +72,10 @@ default-language: Haskell2010 ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - aeson >=1.4.2.0 && <1.5, + aeson >=1.4.4.0 && <1.5, base >=4.7 && <5, graphql -any, - hspec >=2.6.1 && <2.7, + hspec >=2.7.1 && <2.8, hspec-expectations >=0.8.2 && <0.9, megaparsec >=7.0.5 && <7.1, raw-strings-qq ==1.1.*, diff --git a/src/Language/GraphQL/AST/Core.hs b/src/Language/GraphQL/AST/Core.hs --- a/src/Language/GraphQL/AST/Core.hs +++ b/src/Language/GraphQL/AST/Core.hs @@ -21,8 +21,8 @@ type Document = NonEmpty Operation -data Operation = Query (NonEmpty Field) - | Mutation (NonEmpty Field) +data Operation = Query (Maybe Text) (NonEmpty Field) + | Mutation (Maybe Text) (NonEmpty Field) deriving (Eq,Show) data Field = Field (Maybe Alias) Name [Argument] [Field] deriving (Eq,Show) diff --git a/src/Language/GraphQL/AST/Transform.hs b/src/Language/GraphQL/AST/Transform.hs --- a/src/Language/GraphQL/AST/Transform.hs +++ b/src/Language/GraphQL/AST/Transform.hs @@ -41,7 +41,6 @@ -> Maybe Core.Document operations subs fr = NonEmpty.nonEmpty <=< traverse (operation subs fr) --- TODO: Replace Maybe by MonadThrow CustomError operation :: Schema.Subs -> Fragmenter @@ -50,10 +49,10 @@ 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 +operation subs fr (Full.OperationDefinition operationType name _vars _dirs sels) + = case operationType of + Full.Query -> Core.Query name <$> node + Full.Mutation -> Core.Mutation name <$> node where node = traverse (hush . selection subs fr) sels diff --git a/src/Language/GraphQL/Encoder.hs b/src/Language/GraphQL/Encoder.hs --- a/src/Language/GraphQL/Encoder.hs +++ b/src/Language/GraphQL/Encoder.hs @@ -1,156 +1,238 @@ {-# LANGUAGE OverloadedStrings #-} --- | This module defines a printer for the @GraphQL@ language. +{-# LANGUAGE ExplicitForAll #-} + +-- | This module defines a minifier and a printer for the @GraphQL@ language. module Language.GraphQL.Encoder - ( document - , spaced + ( Formatter + , definition + , directive + , document + , minified + , pretty + , type' + , value ) where import Data.Foldable (fold) import Data.Monoid ((<>)) import qualified Data.List.NonEmpty as NonEmpty (toList) -import Data.Text (Text, cons, intercalate, pack, snoc) +import Data.Text.Lazy (Text) +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 --- * Document +-- | Instructs the encoder whether a GraphQL should be minified or pretty +-- printed. +-- +-- Use 'pretty' and 'minified' to construct the formatter. +data Formatter + = Minified + | Pretty Word -document :: Document -> Text -document defs = (`snoc` '\n') . mconcat . NonEmpty.toList $ definition <$> defs +-- Constructs a formatter for pretty printing. +pretty :: Formatter +pretty = Pretty 0 -definition :: Definition -> Text -definition (DefinitionOperation x) = operationDefinition x -definition (DefinitionFragment x) = fragmentDefinition x +-- Constructs a formatter for minifying. +minified :: Formatter +minified = Minified -operationDefinition :: OperationDefinition -> Text -operationDefinition (OperationSelectionSet sels) = selectionSet sels -operationDefinition (OperationDefinition Query name vars dirs sels) = - "query " <> node (fold name) vars dirs sels -operationDefinition (OperationDefinition Mutation name vars dirs sels) = - "mutation " <> node (fold name) vars dirs sels +-- | Converts a 'Document' into a string. +document :: Formatter -> Document -> Text +document formatter defs + | Pretty _ <- formatter = Text.Lazy.intercalate "\n" encodeDocument + | Minified <-formatter = Text.Lazy.snoc (mconcat encodeDocument) '\n' + where + encodeDocument = NonEmpty.toList $ definition formatter <$> defs -node :: Name -> VariableDefinitions -> Directives -> SelectionSet -> Text -node name vars dirs sels = - name - <> optempty variableDefinitions vars - <> optempty directives dirs - <> selectionSet sels +-- | Converts a 'Definition' into a string. +definition :: Formatter -> Definition -> Text +definition formatter x + | Pretty _ <- formatter = Text.Lazy.snoc (encodeDefinition x) '\n' + | Minified <- formatter = encodeDefinition x + where + encodeDefinition (DefinitionOperation operation) + = operationDefinition formatter operation + encodeDefinition (DefinitionFragment fragment) + = fragmentDefinition formatter fragment -variableDefinitions :: [VariableDefinition] -> Text -variableDefinitions = parensCommas variableDefinition +operationDefinition :: Formatter -> OperationDefinition -> Text +operationDefinition formatter (OperationSelectionSet sels) + = selectionSet formatter sels +operationDefinition formatter (OperationDefinition Query name vars dirs sels) + = "query " <> node formatter name vars dirs sels +operationDefinition formatter (OperationDefinition Mutation name vars dirs sels) + = "mutation " <> node formatter name vars dirs sels -variableDefinition :: VariableDefinition -> Text -variableDefinition (VariableDefinition var ty dv) = - variable var <> ":" <> type_ ty <> maybe mempty defaultValue dv +node :: Formatter + -> Maybe Name + -> VariableDefinitions + -> Directives + -> SelectionSet + -> Text +node formatter name vars dirs sels + = Text.Lazy.fromStrict (fold name) + <> optempty (variableDefinitions formatter) vars + <> optempty (directives formatter) dirs + <> eitherFormat formatter " " mempty + <> selectionSet formatter sels -defaultValue :: Value -> Text -defaultValue val = "=" <> value val +variableDefinitions :: Formatter -> [VariableDefinition] -> Text +variableDefinitions formatter + = parensCommas formatter $ variableDefinition formatter +variableDefinition :: Formatter -> VariableDefinition -> Text +variableDefinition formatter (VariableDefinition var ty dv) + = variable var + <> eitherFormat formatter ": " ":" + <> type' ty + <> maybe mempty (defaultValue formatter) dv + +defaultValue :: Formatter -> Value -> Text +defaultValue formatter val + = eitherFormat formatter " = " "=" + <> value formatter val + variable :: Name -> Text -variable var = "$" <> var +variable var = "$" <> Text.Lazy.fromStrict var -selectionSet :: SelectionSet -> Text -selectionSet = bracesCommas selection . NonEmpty.toList +selectionSet :: Formatter -> SelectionSet -> Text +selectionSet formatter + = bracesList formatter (selection formatter) + . NonEmpty.toList -selectionSetOpt :: SelectionSetOpt -> Text -selectionSetOpt = bracesCommas selection +selectionSetOpt :: Formatter -> SelectionSetOpt -> Text +selectionSetOpt formatter = bracesList formatter $ selection formatter -selection :: Selection -> Text -selection (SelectionField x) = field x -selection (SelectionInlineFragment x) = inlineFragment x -selection (SelectionFragmentSpread x) = fragmentSpread x +selection :: Formatter -> 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 + incrementIndent + | Pretty n <- formatter = Pretty $ n + 1 + | otherwise = Minified + indent + | Pretty n <- formatter = Text.Lazy.replicate (fromIntegral $ n + 1) " " + | otherwise = mempty -field :: Field -> Text -field (Field alias name args dirs selso) = - optempty (`snoc` ':') (fold alias) - <> name - <> optempty arguments args - <> optempty directives dirs - <> optempty selectionSetOpt selso +field :: Formatter -> Field -> Text +field formatter (Field alias name args dirs selso) + = optempty (`Text.Lazy.append` colon) (Text.Lazy.fromStrict $ fold alias) + <> Text.Lazy.fromStrict name + <> optempty (arguments formatter) args + <> optempty (directives formatter) dirs + <> selectionSetOpt' + where + colon = eitherFormat formatter ": " ":" + selectionSetOpt' + | null selso = mempty + | otherwise = eitherFormat formatter " " mempty <> selectionSetOpt formatter selso -arguments :: [Argument] -> Text -arguments = parensCommas argument +arguments :: Formatter -> [Argument] -> Text +arguments formatter = parensCommas formatter $ argument formatter -argument :: Argument -> Text -argument (Argument name v) = name <> ":" <> value v +argument :: Formatter -> Argument -> Text +argument formatter (Argument name v) + = Text.Lazy.fromStrict name + <> eitherFormat formatter ": " ":" + <> value formatter v -- * Fragments -fragmentSpread :: FragmentSpread -> Text -fragmentSpread (FragmentSpread name ds) = - "..." <> name <> optempty directives ds +fragmentSpread :: Formatter -> FragmentSpread -> Text +fragmentSpread formatter (FragmentSpread name ds) + = "..." <> Text.Lazy.fromStrict name <> optempty (directives formatter) ds -inlineFragment :: InlineFragment -> Text -inlineFragment (InlineFragment tc dirs sels) = - "... on " <> fold tc - <> directives dirs - <> selectionSet sels +inlineFragment :: Formatter -> InlineFragment -> Text +inlineFragment formatter (InlineFragment tc dirs sels) + = "... on " + <> Text.Lazy.fromStrict (fold tc) + <> directives formatter dirs + <> eitherFormat formatter " " mempty + <> selectionSet formatter sels -fragmentDefinition :: FragmentDefinition -> Text -fragmentDefinition (FragmentDefinition name tc dirs sels) = - "fragment " <> name <> " on " <> tc - <> optempty directives dirs - <> selectionSet sels +fragmentDefinition :: Formatter -> FragmentDefinition -> Text +fragmentDefinition formatter (FragmentDefinition name tc dirs sels) + = "fragment " <> Text.Lazy.fromStrict name + <> " on " <> Text.Lazy.fromStrict tc + <> optempty (directives formatter) dirs + <> eitherFormat formatter " " mempty + <> selectionSet formatter sels --- * Values +-- * Miscellaneous -value :: Value -> Text -value (ValueVariable x) = variable x --- TODO: This will be replaced with `decimal` Builder -value (ValueInt x) = pack $ show x --- TODO: This will be replaced with `decimal` Builder -value (ValueFloat x) = pack $ show x -value (ValueBoolean x) = booleanValue x -value ValueNull = mempty -value (ValueString x) = stringValue x -value (ValueEnum x) = x -value (ValueList x) = listValue x -value (ValueObject x) = objectValue x +-- | Converts a 'Directive' into a string. +directive :: Formatter -> Directive -> Text +directive formatter (Directive name args) + = "@" <> Text.Lazy.fromStrict name <> optempty (arguments formatter) args +directives :: Formatter -> Directives -> 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 + booleanValue :: Bool -> Text booleanValue True = "true" booleanValue False = "false" --- TODO: Escape characters stringValue :: Text -> Text -stringValue = quotes +stringValue + = quotes + . Text.Lazy.replace "\"" "\\\"" + . Text.Lazy.replace "\\" "\\\\" -listValue :: [Value] -> Text -listValue = bracketsCommas value +listValue :: Formatter -> [Value] -> Text +listValue formatter = bracketsCommas formatter $ value formatter -objectValue :: [ObjectField] -> Text -objectValue = bracesCommas objectField +objectValue :: Formatter -> [ObjectField] -> Text +objectValue formatter = intercalate $ objectField formatter + where + intercalate f + = braces + . Text.Lazy.intercalate (eitherFormat formatter ", " ",") + . fmap f -objectField :: ObjectField -> Text -objectField (ObjectField name v) = name <> ":" <> value v --- * Directives - -directives :: [Directive] -> Text -directives = spaces directive - -directive :: Directive -> Text -directive (Directive name args) = "@" <> name <> optempty arguments args - --- * Type Reference +objectField :: Formatter -> ObjectField -> Text +objectField formatter (ObjectField name v) + = Text.Lazy.fromStrict name <> colon <> value formatter v + where + colon + | Pretty _ <- formatter = ": " + | Minified <- formatter = ":" -type_ :: Type -> Text -type_ (TypeNamed x) = x -type_ (TypeList x) = listType x -type_ (TypeNonNull x) = nonNullType x +-- | 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 listType :: Type -> Text -listType x = brackets (type_ x) +listType x = brackets (type' x) nonNullType :: NonNullType -> Text -nonNullType (NonNullTypeNamed x) = x <> "!" +nonNullType (NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!" nonNullType (NonNullTypeList x) = listType x <> "!" -- * Internal -spaced :: Text -> Text -spaced = cons '\SP' - between :: Char -> Char -> Text -> Text -between open close = cons open . (`snoc` close) +between open close = Text.Lazy.cons open . (`Text.Lazy.snoc` close) parens :: Text -> Text parens = between '(' ')' @@ -164,17 +246,32 @@ quotes :: Text -> Text quotes = between '"' '"' -spaces :: (a -> Text) -> [a] -> Text -spaces f = intercalate "\SP" . fmap f +spaces :: forall a. (a -> Text) -> [a] -> Text +spaces f = Text.Lazy.intercalate "\SP" . fmap f -parensCommas :: (a -> Text) -> [a] -> Text -parensCommas f = parens . intercalate "," . fmap f +parensCommas :: forall a. Formatter -> (a -> Text) -> [a] -> Text +parensCommas formatter f + = parens + . Text.Lazy.intercalate (eitherFormat formatter ", " ",") + . fmap f -bracketsCommas :: (a -> Text) -> [a] -> Text -bracketsCommas f = brackets . intercalate "," . fmap f +bracketsCommas :: Formatter -> (a -> Text) -> [a] -> Text +bracketsCommas formatter f + = brackets + . Text.Lazy.intercalate (eitherFormat formatter ", " ",") + . fmap f -bracesCommas :: (a -> Text) -> [a] -> Text -bracesCommas f = braces . intercalate "," . fmap f +bracesList :: forall a. Formatter -> (a -> Text) -> [a] -> Text +bracesList (Pretty intendation) f xs + = Text.Lazy.snoc (Text.Lazy.intercalate "\n" content) '\n' + <> (Text.Lazy.snoc $ Text.Lazy.replicate (fromIntegral intendation) " ") '}' + where + content = "{" : fmap f xs +bracesList Minified f xs = braces $ Text.Lazy.intercalate "," $ fmap f xs optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b optempty f xs = if xs == mempty then mempty else f xs + +eitherFormat :: forall a. Formatter -> a -> a -> a +eitherFormat (Pretty _) x _ = x +eitherFormat Minified _ x = x diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -4,12 +4,15 @@ -- according to a 'Schema'. module Language.GraphQL.Execute ( execute + , executeWithName ) where import Control.Monad.IO.Class (MonadIO) +import qualified Data.Aeson as Aeson import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty((:|))) -import qualified Data.Aeson as Aeson +import Data.Text (Text) +import qualified Data.Text as Text import qualified Language.GraphQL.AST as AST import qualified Language.GraphQL.AST.Core as AST.Core import qualified Language.GraphQL.AST.Transform as Transform @@ -23,20 +26,47 @@ -- -- Returns the result of the query against the 'Schema' wrapped in a /data/ field, or -- errors wrapped in an /errors/ field. -execute - :: MonadIO m - => Schema m -> Schema.Subs -> AST.Document -> m Aeson.Value +execute :: MonadIO m + => Schema m + -> Schema.Subs + -> AST.Document + -> m Aeson.Value execute schema subs doc = - maybe transformError (document schema) $ Transform.document subs doc + maybe transformError (document schema Nothing) $ Transform.document subs doc where transformError = return $ singleError "Schema transformation error." -document :: MonadIO m => Schema m -> AST.Core.Document -> m Aeson.Value -document schema (op :| []) = operation schema op -document _ _ = return $ singleError "Multiple operations not supported yet." +-- | Takes a 'Schema', operation name, a variable substitution function ('Schema.Subs'), +-- and a @GraphQL@ 'document'. The substitution is applied to the document using +-- 'rootFields', and the 'Schema''s resolvers are applied to the resulting fields. +-- +-- Returns the result of the query against the 'Schema' wrapped in a /data/ field, or +-- errors wrapped in an /errors/ field. +executeWithName :: MonadIO m + => Schema m + -> Text + -> Schema.Subs + -> AST.Document + -> m Aeson.Value +executeWithName schema name subs doc = + maybe transformError (document schema $ Just name) $ Transform.document subs doc + where + transformError = return $ singleError "Schema transformation error." +document :: MonadIO m => Schema m -> Maybe Text -> AST.Core.Document -> m Aeson.Value +document schema Nothing (op :| []) = operation schema op +document schema (Just name) operations = case NE.dropWhile matchingName operations of + [] -> return $ singleError + $ Text.unwords ["Operation", name, "couldn't be found in the document."] + (op:_) -> operation schema op + where + matchingName (AST.Core.Query (Just name') _) = name == name' + matchingName (AST.Core.Mutation (Just name') _) = name == name' + matchingName _ = False +document _ _ _ = return $ singleError "Missing operation name." + operation :: MonadIO m => Schema m -> AST.Core.Operation -> m Aeson.Value -operation schema (AST.Core.Query flds) +operation schema (AST.Core.Query _ flds) = runCollectErrs (Schema.resolve (NE.toList schema) (NE.toList flds)) -operation schema (AST.Core.Mutation flds) +operation schema (AST.Core.Mutation _ flds) = runCollectErrs (Schema.resolve (NE.toList schema) (NE.toList flds)) diff --git a/tests/Language/GraphQL/EncoderSpec.hs b/tests/Language/GraphQL/EncoderSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Language/GraphQL/EncoderSpec.hs @@ -0,0 +1,21 @@ +{-# 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 --- a/tests/Test/KitchenSinkSpec.hs +++ b/tests/Test/KitchenSinkSpec.hs @@ -1,8 +1,11 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} module Test.KitchenSinkSpec ( spec ) where import qualified Data.Text.IO as Text.IO +import qualified Data.Text.Lazy.IO as Text.Lazy.IO import qualified Language.GraphQL.Encoder as Encoder import qualified Language.GraphQL.Parser as Parser import Paths_graphql (getDataFileName) @@ -16,14 +19,58 @@ import Text.Megaparsec ( errorBundlePretty , parse ) +import Text.RawString.QQ (r) spec :: Spec -spec = describe "Kitchen Sink" $ - it "prints the query" $ do - dataFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql" - expected <- Text.IO.readFile dataFileName +spec = describe "Kitchen Sink" $ do + it "minifies the query" $ do + dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql" + minFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql" + actual <- Text.IO.readFile dataFileName + expected <- Text.Lazy.IO.readFile minFileName either (expectationFailure . errorBundlePretty) - (flip shouldBe expected . Encoder.document) - $ parse Parser.document dataFileName expected + (flip shouldBe expected . Encoder.document Encoder.minified) + $ parse Parser.document dataFileName actual + + it "pretty prints the query" $ do + dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql" + actual <- Text.IO.readFile dataFileName + let expected = [r|query queryName($foo: ComplexType, $site: Site = MOBILE) { + whoever123is: node(id: [123, 456]) { + id + ... on User @defer { + field2 { + id + alias: field1(first: 10, after: $foo) @include(if: $foo) { + id + ...frag + } + } + } + } +} + +mutation likeStory { + like(story: 123) @defer { + story { + id + } + } +} + +fragment frag on Friend { + foo(size: $size, bar: $b, obj: {key: "value"}) +} + +{ + unnamed(truthy: true, falsey: false) + query +} +|] + + either + (expectationFailure . errorBundlePretty) + (flip shouldBe expected . Encoder.document Encoder.pretty) + $ parse Parser.document dataFileName actual diff --git a/tests/data/kitchen-sink.graphql b/tests/data/kitchen-sink.graphql --- a/tests/data/kitchen-sink.graphql +++ b/tests/data/kitchen-sink.graphql @@ -7,11 +7,11 @@ query queryName($foo: ComplexType, $site: Site = MOBILE) { whoever123is: node(id: [123, 456]) { - id , # Inline test comment + id, # Inline test comment ... on User @defer { field2 { - id , - alias: field1(first:10, after:$foo,) @include(if: $foo) { + id, + alias: field1(first: 10, after: $foo) @include(if: $foo) { id, ...frag } diff --git a/tests/data/kitchen-sink.min.graphql b/tests/data/kitchen-sink.min.graphql --- a/tests/data/kitchen-sink.min.graphql +++ b/tests/data/kitchen-sink.min.graphql @@ -1,1 +1,1 @@ -query queryName($foo:ComplexType,$site:Site=MOBILE){whoever123is:node(id:[123,456]){id,... on User@defer{field2{id,alias:field1(first:10,after:$foo)@include(if:$foo){id,...frag}}}}}mutation likeStory{like(story:123)@defer{story{id}}}fragment frag on Friend{foo(size:$size,bar:$b,obj:{key:"value"})} +query queryName($foo:ComplexType,$site:Site=MOBILE){whoever123is:node(id:[123,456]){id,... on User@defer{field2{id,alias:field1(first:10,after:$foo)@include(if:$foo){id,...frag}}}}}mutation likeStory{like(story:123)@defer{story{id}}}fragment frag on Friend{foo(size:$size,bar:$b,obj:{key:"value"})}{unnamed(truthy:true,falsey:false),query}