Compare commits
10 Commits
Author | SHA1 | Date |
---|---|---|
Eugen Wissner | f54e9451d2 | |
Eugen Wissner | 045b6d15fb | |
Eugen Wissner | 6604fba7f4 | |
Eugen Wissner | a3354e7f58 | |
Eugen Wissner | f9dd363457 | |
Eugen Wissner | 7a8a90aba8 | |
Eugen Wissner | 989e418cc2 | |
Eugen Wissner | 4812c8f039 | |
Eugen Wissner | d690d22ce8 | |
Eugen Wissner | 15568a3b99 |
|
@ -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/
|
||||
|
|
18
CHANGELOG.md
18
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
|
||||
|
|
39
README.md
39
README.md
|
@ -4,25 +4,38 @@
|
|||
[![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
|
||||
invitation [here](https://graphql-slack.herokuapp.com/).
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
objectField :: Formatter -> ObjectField -> Text
|
||||
objectField formatter (ObjectField name v)
|
||||
= Text.Lazy.fromStrict name <> colon <> value formatter v
|
||||
where
|
||||
colon
|
||||
| Pretty _ <- formatter = ": "
|
||||
| Minified <- formatter = ":"
|
||||
|
||||
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
|
||||
-- | 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
|
||||
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
|
||||
|
|
|
@ -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."
|
||||
|
||||
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))
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
resolver: lts-13.29
|
||||
resolver: lts-14.0
|
||||
packages:
|
||||
- '.'
|
||||
extra-deps: []
|
||||
|
|
|
@ -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
|
|
@ -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` "\"\\\"\""
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
}
|
||||
|
|
|
@ -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}
|
||||
|
|
Loading…
Reference in New Issue