diff options
| -rw-r--r-- | .gitignore | 12 | ||||
| -rw-r--r-- | CHANGELOG.md | 18 | ||||
| -rw-r--r-- | README.md | 41 | ||||
| -rw-r--r-- | graphql.cabal | 5 | ||||
| -rw-r--r-- | package.yaml | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Core.hs | 4 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Transform.hs | 9 | ||||
| -rw-r--r-- | src/Language/GraphQL/Encoder.hs | 367 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute.hs | 50 | ||||
| -rw-r--r-- | stack.yaml | 2 | ||||
| -rw-r--r-- | stack.yaml.lock | 12 | ||||
| -rw-r--r-- | tests/Language/GraphQL/EncoderSpec.hs | 21 | ||||
| -rw-r--r-- | tests/Test/KitchenSinkSpec.hs | 59 | ||||
| -rw-r--r-- | tests/data/kitchen-sink.graphql | 6 | ||||
| -rw-r--r-- | tests/data/kitchen-sink.min.graphql | 2 |
15 files changed, 412 insertions, 198 deletions
@@ -1,10 +1,10 @@ +# Stack .stack-work/ +/stack.yaml.lock + +# Cabal +/dist/ +/dist-newstyle/ .cabal-sandbox/ cabal.sandbox.config -dist/ -TAGS -.#* -.DS_Store cabal.project.local -dist-newstyle/ -dist-newstyle/ diff --git a/CHANGELOG.md b/CHANGELOG.md index 03743f3..efdf1c6 100644 --- 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 @@ All notable changes to this project will be documented in this file. ### 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 @@ -4,25 +4,38 @@ [](https://semaphoreci.com/belka-ew/graphql) [](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: - -- [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. +GraphQL implementation in Haskell. + +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 invitation [here](https://graphql-slack.herokuapp.com/). diff --git a/graphql.cabal b/graphql.cabal index dc4bf54..b8d699e 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -4,10 +4,10 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: dca80d6bcaa432cabc2499efc9f047c6f59546bc2ba75b35fed6efd694895598 +-- hash: 6598c2424405b7a92a4672ad7d1a4e8ad768ea47bf3ed0c3c5ae51bac8730301 name: graphql -version: 0.4.0.0 +version: 0.5.0.0 synopsis: Haskell GraphQL implementation description: This package provides a rudimentary parser for the <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language. category: Language @@ -66,6 +66,7 @@ test-suite tasty type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + Language.GraphQL.EncoderSpec Language.GraphQL.ErrorSpec Language.GraphQL.LexerSpec Language.GraphQL.ParserSpec diff --git a/package.yaml b/package.yaml index 814d8c3..000fdf9 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: graphql -version: 0.4.0.0 +version: 0.5.0.0 synopsis: Haskell GraphQL implementation description: This package provides a rudimentary parser for the diff --git a/src/Language/GraphQL/AST/Core.hs b/src/Language/GraphQL/AST/Core.hs index 00072e0..87dced9 100644 --- a/src/Language/GraphQL/AST/Core.hs +++ b/src/Language/GraphQL/AST/Core.hs @@ -21,8 +21,8 @@ type Name = Text 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 index 64670db..63a2c72 100644 --- a/src/Language/GraphQL/AST/Transform.hs +++ b/src/Language/GraphQL/AST/Transform.hs @@ -41,7 +41,6 @@ operations -> 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 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 index c315091..11115b1 100644 --- 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 - -document :: Document -> Text -document defs = (`snoc` '\n') . mconcat . NonEmpty.toList $ definition <$> defs - -definition :: Definition -> Text -definition (DefinitionOperation x) = operationDefinition x -definition (DefinitionFragment x) = fragmentDefinition x - -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 - -node :: Name -> VariableDefinitions -> Directives -> SelectionSet -> Text -node name vars dirs sels = - name - <> optempty variableDefinitions vars - <> optempty directives dirs - <> selectionSet sels - -variableDefinitions :: [VariableDefinition] -> Text -variableDefinitions = parensCommas variableDefinition - -variableDefinition :: VariableDefinition -> Text -variableDefinition (VariableDefinition var ty dv) = - variable var <> ":" <> type_ ty <> maybe mempty defaultValue dv - -defaultValue :: Value -> Text -defaultValue val = "=" <> value val +-- | 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 + +-- Constructs a formatter for pretty printing. +pretty :: Formatter +pretty = Pretty 0 + +-- Constructs a formatter for minifying. +minified :: Formatter +minified = Minified + +-- | 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 + +-- | 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 + +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 + +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 + +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 - -selectionSet :: SelectionSet -> Text -selectionSet = bracesCommas selection . NonEmpty.toList - -selectionSetOpt :: SelectionSetOpt -> Text -selectionSetOpt = bracesCommas selection - -selection :: Selection -> Text -selection (SelectionField x) = field x -selection (SelectionInlineFragment x) = inlineFragment x -selection (SelectionFragmentSpread x) = fragmentSpread x - -field :: Field -> Text -field (Field alias name args dirs selso) = - optempty (`snoc` ':') (fold alias) - <> name - <> optempty arguments args - <> optempty directives dirs - <> optempty selectionSetOpt selso - -arguments :: [Argument] -> Text -arguments = parensCommas argument - -argument :: Argument -> Text -argument (Argument name v) = name <> ":" <> value v +variable var = "$" <> Text.Lazy.fromStrict var + +selectionSet :: Formatter -> SelectionSet -> Text +selectionSet formatter + = bracesList formatter (selection formatter) + . NonEmpty.toList + +selectionSetOpt :: Formatter -> SelectionSetOpt -> Text +selectionSetOpt formatter = bracesList formatter $ selection formatter + +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 :: 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 :: Formatter -> [Argument] -> Text +arguments formatter = parensCommas formatter $ argument formatter + +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 - -inlineFragment :: InlineFragment -> Text -inlineFragment (InlineFragment tc dirs sels) = - "... on " <> fold tc - <> directives dirs - <> selectionSet sels - -fragmentDefinition :: FragmentDefinition -> Text -fragmentDefinition (FragmentDefinition name tc dirs sels) = - "fragment " <> name <> " on " <> tc - <> optempty directives dirs - <> selectionSet sels - --- * Values - -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 +fragmentSpread :: Formatter -> FragmentSpread -> Text +fragmentSpread formatter (FragmentSpread name ds) + = "..." <> Text.Lazy.fromStrict name <> optempty (directives formatter) ds + +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 :: 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 + +-- * Miscellaneous + +-- | 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 - -listValue :: [Value] -> Text -listValue = bracketsCommas value - -objectValue :: [ObjectField] -> Text -objectValue = bracesCommas objectField - -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 - -type_ :: Type -> Text -type_ (TypeNamed x) = x -type_ (TypeList x) = listType x -type_ (TypeNonNull x) = nonNullType x +stringValue + = quotes + . Text.Lazy.replace "\"" "\\\"" + . Text.Lazy.replace "\\" "\\\\" + +listValue :: Formatter -> [Value] -> Text +listValue formatter = bracketsCommas formatter $ value formatter + +objectValue :: Formatter -> [ObjectField] -> Text +objectValue formatter = intercalate $ objectField formatter + where + intercalate f + = braces + . Text.Lazy.intercalate (eitherFormat formatter ", " ",") + . fmap f + + +objectField :: Formatter -> ObjectField -> Text +objectField formatter (ObjectField name v) + = Text.Lazy.fromStrict name <> colon <> value formatter v + where + colon + | Pretty _ <- formatter = ": " + | 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 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 @@ braces = between '{' '}' quotes :: Text -> Text quotes = between '"' '"' -spaces :: (a -> Text) -> [a] -> Text -spaces f = intercalate "\SP" . fmap f - -parensCommas :: (a -> Text) -> [a] -> Text -parensCommas f = parens . intercalate "," . fmap f - -bracketsCommas :: (a -> Text) -> [a] -> Text -bracketsCommas f = brackets . intercalate "," . fmap f - -bracesCommas :: (a -> Text) -> [a] -> Text -bracesCommas f = braces . intercalate "," . fmap f +spaces :: forall a. (a -> Text) -> [a] -> Text +spaces f = Text.Lazy.intercalate "\SP" . fmap f + +parensCommas :: forall a. Formatter -> (a -> Text) -> [a] -> Text +parensCommas formatter f + = parens + . Text.Lazy.intercalate (eitherFormat formatter ", " ",") + . fmap f + +bracketsCommas :: Formatter -> (a -> Text) -> [a] -> Text +bracketsCommas formatter f + = brackets + . Text.Lazy.intercalate (eitherFormat formatter ", " ",") + . 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 index 9dbfb36..5a815b8 100644 --- 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 @@ import qualified Language.GraphQL.Schema as Schema -- -- 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." + +-- | 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 -> AST.Core.Document -> m Aeson.Value -document schema (op :| []) = operation schema op -document _ _ = return $ singleError "Multiple operations not supported yet." +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)) @@ -1,4 +1,4 @@ -resolver: lts-13.29 +resolver: lts-14.0 packages: - '.' extra-deps: [] diff --git a/stack.yaml.lock b/stack.yaml.lock deleted file mode 100644 index d2178fe..0000000 --- a/stack.yaml.lock +++ /dev/null @@ -1,12 +0,0 @@ -# This file was autogenerated by Stack. -# You should not edit this file by hand. -# For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files - -packages: [] -snapshots: -- completed: - size: 500539 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/29.yaml - sha256: 006398c5e92d1d64737b7e98ae4d63987c36808814504d1451f56ebd98093f75 - original: lts-13.29 diff --git a/tests/Language/GraphQL/EncoderSpec.hs b/tests/Language/GraphQL/EncoderSpec.hs new file mode 100644 index 0000000..d2d4a00 --- /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 index 99a00f7..ae3c2c4 100644 --- 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 Test.Hspec.Expectations ( expectationFailure 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 index 46fd10e..89903b7 100644 --- 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 index 4f8553d..24f5c26 100644 --- a/tests/data/kitchen-sink.min.graphql +++ b/tests/data/kitchen-sink.min.graphql @@ -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} |