Compare commits
13 Commits
Author | SHA1 | Date |
---|---|---|
Eugen Wissner | 3497784984 | |
Eugen Wissner | 587aab005e | |
Eugen Wissner | 625d7100ca | |
Sam Nolan | 73e21661b4 | |
Eugen Wissner | 7b92e5bcfd | |
Eugen Wissner | 115aa02672 | |
Eugen Wissner | 31c516927d | |
Eugen Wissner | 1dd6b7b013 | |
Eugen Wissner | b77da3d492 | |
Eugen Wissner | 73fc334bf8 | |
Eugen Wissner | 417ff5da7d | |
Eugen Wissner | 0e3b6184be | |
Eugen Wissner | 51d39b69e8 |
44
CHANGELOG.md
44
CHANGELOG.md
|
@ -1,6 +1,49 @@
|
|||
# Change Log
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## [0.6.0.0] - 2019-11-27
|
||||
### 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.
|
||||
- `Language.GraphQL.AST.Core.Object` is now just a HashMap.
|
||||
- `Language.GraphQL.AST.Transform` is isn't exposed publically anymore.
|
||||
- `Language.GraphQL.Schema.resolve` accepts a selection `Seq` (`Data.Sequence`)
|
||||
instead of a list. Selections are stored as sequences internally as well.
|
||||
- Add a reader instance to the resolver's monad stack. The Reader contains
|
||||
a Name/Value hashmap, which will contain resolver arguments.
|
||||
|
||||
### Added
|
||||
- Nested fragment support.
|
||||
|
||||
### Fixed
|
||||
- Consume ignored tokens after `$` and `!`. I mistakenly assumed that
|
||||
`$variable` is a single token, same as `Type!` is a single token. This is not
|
||||
the case, for example `Variable` is defined as `$ Name`, so these are two
|
||||
tokens, therefore whitespaces and commas after `$` and `!` should be
|
||||
consumed.
|
||||
|
||||
### Improved
|
||||
- `Language.GraphQL.AST.Parser.type_`: Try type parsers in a variable
|
||||
definition in a different order to avoid using `but`.
|
||||
|
||||
### Removed
|
||||
- `Language.GraphQL.AST.Arguments`. Use `[Language.GraphQL.AST.Argument]`
|
||||
instead.
|
||||
- `Language.GraphQL.AST.Directives`. Use `[Language.GraphQL.AST.Directives]`
|
||||
instead.
|
||||
- `Language.GraphQL.AST.VariableDefinitions`. Use
|
||||
`[Language.GraphQL.AST.VariableDefinition]` instead.
|
||||
- `Language.GraphQL.AST.FragmentName`. Use `Language.GraphQL.AST.Name` instead.
|
||||
- `Language.GraphQL.Execute.Schema` - It was a resolver list, not a schema.
|
||||
- `Language.GraphQL.Schema`: `enum`, `enumA`, `wrappedEnum` and `wrappedEnumA`.
|
||||
Use `scalar`, `scalarA`, `wrappedScalar` and `wrappedScalarA` instead.
|
||||
|
||||
|
||||
## [0.5.1.0] - 2019-10-22
|
||||
### Deprecated
|
||||
- `Language.GraphQL.AST.Arguments`. Use `[Language.GraphQL.AST.Argument]`
|
||||
|
@ -105,6 +148,7 @@ All notable changes to this project will be documented in this file.
|
|||
### Added
|
||||
- Data types for the GraphQL language.
|
||||
|
||||
[0.6.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.1.0...v0.6.0.0
|
||||
[0.5.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.1...v0.5.1.0
|
||||
[0.5.0.1]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.0...v0.5.0.1
|
||||
[0.5.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.4.0.0...v0.5.0.0
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
name: graphql
|
||||
version: 0.5.1.0
|
||||
version: 0.6.0.0
|
||||
synopsis: Haskell GraphQL implementation
|
||||
description:
|
||||
This package provides a rudimentary parser for the
|
||||
|
@ -28,6 +28,7 @@ data-files:
|
|||
dependencies:
|
||||
- aeson
|
||||
- base >= 4.7 && < 5
|
||||
- containers
|
||||
- megaparsec
|
||||
- text
|
||||
- transformers
|
||||
|
@ -35,6 +36,8 @@ dependencies:
|
|||
|
||||
library:
|
||||
source-dirs: src
|
||||
other-modules:
|
||||
- Language.GraphQL.AST.Transform
|
||||
|
||||
tests:
|
||||
tasty:
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
|
@ -5,14 +5,11 @@
|
|||
module Language.GraphQL.AST
|
||||
( Alias
|
||||
, Argument(..)
|
||||
, Arguments
|
||||
, Definition(..)
|
||||
, Directive(..)
|
||||
, Directives
|
||||
, Document
|
||||
, Field(..)
|
||||
, FragmentDefinition(..)
|
||||
, FragmentName
|
||||
, FragmentSpread(..)
|
||||
, InlineFragment(..)
|
||||
, Name
|
||||
|
@ -27,22 +24,23 @@ module Language.GraphQL.AST
|
|||
, TypeCondition
|
||||
, Value(..)
|
||||
, VariableDefinition(..)
|
||||
, VariableDefinitions
|
||||
) where
|
||||
|
||||
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)
|
||||
|
||||
-- * Operations
|
||||
|
||||
-- | Top-level definition of a document, either an operation or a fragment.
|
||||
|
@ -68,7 +66,7 @@ data OperationType = Query | Mutation deriving (Eq, Show)
|
|||
|
||||
-- * Selections
|
||||
|
||||
-- | "Top-level" selection, selection on a operation.
|
||||
-- | "Top-level" selection, selection on an operation or fragment.
|
||||
type SelectionSet = NonEmpty Selection
|
||||
|
||||
-- | Field selection.
|
||||
|
@ -83,18 +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 "user". "id" and "name" don't have any
|
||||
-- arguments.
|
||||
data Field
|
||||
= Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- * Arguments
|
||||
-- | 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
|
||||
|
||||
-- | Argument list.
|
||||
{-# DEPRECATED Arguments "Use [Argument] instead" #-}
|
||||
type Arguments = [Argument]
|
||||
|
||||
-- | Argument.
|
||||
-- | 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
|
||||
|
@ -111,21 +147,18 @@ data FragmentDefinition
|
|||
= FragmentDefinition Name TypeCondition [Directive] SelectionSet
|
||||
deriving (Eq, Show)
|
||||
|
||||
{-# DEPRECATED FragmentName "Use Name instead" #-}
|
||||
type FragmentName = Name
|
||||
|
||||
-- * Input values
|
||||
-- * 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.
|
||||
|
@ -133,17 +166,12 @@ data Value = ValueVariable Name
|
|||
-- A list of 'ObjectField's represents a GraphQL object type.
|
||||
data ObjectField = ObjectField Name Value deriving (Eq, Show)
|
||||
|
||||
-- * Variables
|
||||
|
||||
-- | Variable definition list.
|
||||
{-# DEPRECATED VariableDefinitions "Use [VariableDefinition] instead" #-}
|
||||
type VariableDefinitions = [VariableDefinition]
|
||||
|
||||
-- | Variable definition.
|
||||
data VariableDefinition = VariableDefinition Name Type (Maybe Value)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- * Input types
|
||||
-- | Type condition.
|
||||
type TypeCondition = Name
|
||||
|
||||
-- | Type representation.
|
||||
data Type = TypeNamed Name
|
||||
|
@ -151,17 +179,7 @@ data Type = TypeNamed Name
|
|||
| TypeNonNull NonNullType
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
-- | Helper type to represent Non-Null types and lists of such types.
|
||||
data NonNullType = NonNullTypeNamed Name
|
||||
| NonNullTypeList Type
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- * Directives
|
||||
|
||||
-- | Directive list.
|
||||
{-# DEPRECATED Directives "Use [Directive] instead" #-}
|
||||
type Directives = [Directive]
|
||||
|
||||
-- | Directive.
|
||||
data Directive = Directive Name [Argument] deriving (Eq, Show)
|
||||
|
|
|
@ -6,7 +6,6 @@ module Language.GraphQL.AST.Core
|
|||
, Field(..)
|
||||
, Fragment(..)
|
||||
, Name
|
||||
, ObjectField(..)
|
||||
, Operation(..)
|
||||
, Selection(..)
|
||||
, TypeCondition
|
||||
|
@ -14,12 +13,12 @@ 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.Sequence (Seq)
|
||||
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
|
||||
|
@ -28,87 +27,21 @@ type Document = NonEmpty Operation
|
|||
--
|
||||
-- Currently only queries and mutations are supported.
|
||||
data Operation
|
||||
= Query (Maybe Text) (NonEmpty Selection)
|
||||
| Mutation (Maybe Text) (NonEmpty Selection)
|
||||
= Query (Maybe Text) (Seq Selection)
|
||||
| Mutation (Maybe Text) (Seq 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.
|
||||
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 GraphQL field.
|
||||
data Field
|
||||
= Field (Maybe Alias) Name [Argument] (Seq Selection)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | 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)
|
||||
= Fragment TypeCondition (Seq Selection)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Single selection element.
|
||||
|
@ -116,3 +49,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
|
||||
|
|
|
@ -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,12 +21,12 @@ 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.
|
||||
--
|
||||
-- Use 'pretty' and 'minified' to construct the formatter.
|
||||
-- | Instructs the encoder whether the GraphQL document should be minified or
|
||||
-- pretty printed.
|
||||
--
|
||||
-- Use 'pretty' or 'minified' to construct the formatter.
|
||||
data Formatter
|
||||
= Minified
|
||||
| Pretty Word
|
||||
|
@ -39,38 +39,38 @@ pretty = Pretty 0
|
|||
minified :: Formatter
|
||||
minified = Minified
|
||||
|
||||
-- | Converts a 'Document' into a string.
|
||||
document :: Formatter -> Document -> Text
|
||||
-- | Converts a 'Full.Document' into a string.
|
||||
document :: Formatter -> Full.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
|
||||
-- | Converts a 'Full.Definition' into a string.
|
||||
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
|
||||
|
@ -165,26 +165,26 @@ fragmentDefinition formatter (FragmentDefinition name tc dirs sels)
|
|||
|
||||
-- * Miscellaneous
|
||||
|
||||
-- | Converts a 'Directive' into a string.
|
||||
directive :: Formatter -> Directive -> Text
|
||||
directive formatter (Directive name args)
|
||||
-- | Converts a 'Full.Directive' into a string.
|
||||
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
|
||||
-- | Converts a 'Full.Value' into a string.
|
||||
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,26 +208,26 @@ 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
|
||||
| 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
|
||||
-- | Converts a 'Full.Type' a type into a string.
|
||||
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
|
||||
|
|
@ -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
|
||||
|
@ -89,12 +89,12 @@ symbol :: T.Text -> Parser T.Text
|
|||
symbol = Lexer.symbol spaceConsumer
|
||||
|
||||
-- | Parser for "!".
|
||||
bang :: Parser Char
|
||||
bang = char '!'
|
||||
bang :: Parser T.Text
|
||||
bang = symbol "!"
|
||||
|
||||
-- | Parser for "$".
|
||||
dollar :: Parser Char
|
||||
dollar = char '$'
|
||||
dollar :: Parser T.Text
|
||||
dollar = symbol "$"
|
||||
|
||||
-- | Parser for "@".
|
||||
at :: Parser Char
|
|
@ -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
|
||||
|
@ -152,9 +152,9 @@ defaultValue = equals *> value
|
|||
-- * Input Types
|
||||
|
||||
type_ :: Parser Type
|
||||
type_ = try (TypeNamed <$> name <* but "!")
|
||||
<|> TypeList <$> brackets type_
|
||||
<|> TypeNonNull <$> nonNullType
|
||||
type_ = try (TypeNonNull <$> nonNullType)
|
||||
<|> TypeList <$> brackets type_
|
||||
<|> TypeNamed <$> name
|
||||
<?> "type_ error!"
|
||||
|
||||
nonNullType :: Parser NonNullType
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
|
||||
-- | After the document is parsed, before getting executed the AST is
|
||||
-- transformed into a similar, simpler AST. This module is responsible for
|
||||
|
@ -7,130 +8,143 @@ module Language.GraphQL.AST.Transform
|
|||
( document
|
||||
) where
|
||||
|
||||
import Control.Applicative (empty)
|
||||
import Data.Bifunctor (first)
|
||||
import Data.Either (partitionEithers)
|
||||
import Data.Foldable (fold, foldMap)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Control.Arrow (first)
|
||||
import Control.Monad (foldM, unless)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
|
||||
import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Monoid (Alt(Alt,getAlt), (<>))
|
||||
import Data.Sequence (Seq, (<|), (><))
|
||||
import qualified Language.GraphQL.AST as Full
|
||||
import qualified Language.GraphQL.AST.Core as Core
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
|
||||
-- | Replaces a fragment name by a list of 'Core.Field'. If the name doesn't
|
||||
-- match an empty list is returned.
|
||||
type Fragmenter = Core.Name -> [Core.Field]
|
||||
-- | Associates a fragment name with a list of 'Core.Field's.
|
||||
data Replacement = Replacement
|
||||
{ fragments :: HashMap Core.Name (Seq Core.Selection)
|
||||
, fragmentDefinitions :: HashMap Full.Name Full.FragmentDefinition
|
||||
}
|
||||
|
||||
type TransformT a = StateT Replacement (ReaderT Schema.Subs Maybe) a
|
||||
|
||||
-- | Rewrites the original syntax tree into an intermediate representation used
|
||||
-- for query execution.
|
||||
document :: Schema.Subs -> Full.Document -> Maybe Core.Document
|
||||
document subs doc = operations subs fr ops
|
||||
document subs document' =
|
||||
flip runReaderT subs
|
||||
$ evalStateT (collectFragments >> operations operationDefinitions)
|
||||
$ Replacement HashMap.empty fragmentTable
|
||||
where
|
||||
(fr, ops) = first foldFrags
|
||||
. partitionEithers
|
||||
. NonEmpty.toList
|
||||
$ defrag subs
|
||||
<$> doc
|
||||
|
||||
foldFrags :: [Fragmenter] -> Fragmenter
|
||||
foldFrags fs n = getAlt $ foldMap (Alt . ($ n)) fs
|
||||
(fragmentTable, operationDefinitions) = foldr defragment mempty document'
|
||||
defragment (Full.DefinitionOperation definition) acc =
|
||||
(definition :) <$> acc
|
||||
defragment (Full.DefinitionFragment definition) acc =
|
||||
let (Full.FragmentDefinition name _ _ _) = definition
|
||||
in first (HashMap.insert name definition) acc
|
||||
|
||||
-- * Operation
|
||||
|
||||
-- TODO: Replace Maybe by MonadThrow CustomError
|
||||
operations
|
||||
:: Schema.Subs
|
||||
-> Fragmenter
|
||||
-> [Full.OperationDefinition]
|
||||
-> Maybe Core.Document
|
||||
operations subs fr = NonEmpty.nonEmpty . fmap (operation subs fr)
|
||||
operations :: [Full.OperationDefinition] -> TransformT Core.Document
|
||||
operations operations' = do
|
||||
coreOperations <- traverse operation operations'
|
||||
lift . lift $ NonEmpty.nonEmpty coreOperations
|
||||
|
||||
operation
|
||||
:: Schema.Subs
|
||||
-> Fragmenter
|
||||
-> Full.OperationDefinition
|
||||
-> Core.Operation
|
||||
operation subs fr (Full.OperationSelectionSet sels) =
|
||||
operation subs fr $ Full.OperationDefinition Full.Query empty empty empty sels
|
||||
operation :: Full.OperationDefinition -> TransformT Core.Operation
|
||||
operation (Full.OperationSelectionSet sels) =
|
||||
operation $ Full.OperationDefinition Full.Query mempty mempty mempty sels
|
||||
-- TODO: Validate Variable definitions with substituter
|
||||
operation subs fr (Full.OperationDefinition Full.Query name _vars _dirs sels) =
|
||||
Core.Query name $ appendSelection subs fr sels
|
||||
operation subs fr (Full.OperationDefinition Full.Mutation name _vars _dirs sels) =
|
||||
Core.Mutation name $ appendSelection subs fr sels
|
||||
operation (Full.OperationDefinition Full.Query name _vars _dirs sels) =
|
||||
Core.Query name <$> appendSelection sels
|
||||
operation (Full.OperationDefinition Full.Mutation name _vars _dirs sels) =
|
||||
Core.Mutation name <$> appendSelection sels
|
||||
|
||||
selection
|
||||
:: Schema.Subs
|
||||
-> Fragmenter
|
||||
-> Full.Selection
|
||||
-> Either [Core.Selection] Core.Selection
|
||||
selection subs fr (Full.SelectionField fld)
|
||||
= Right $ Core.SelectionField $ field subs fr fld
|
||||
selection _ fr (Full.SelectionFragmentSpread (Full.FragmentSpread name _))
|
||||
= Left $ Core.SelectionField <$> fr name
|
||||
selection subs fr (Full.SelectionInlineFragment fragment)
|
||||
selection ::
|
||||
Full.Selection ->
|
||||
TransformT (Either (Seq Core.Selection) Core.Selection)
|
||||
selection (Full.SelectionField fld) = Right . Core.SelectionField <$> field fld
|
||||
selection (Full.SelectionFragmentSpread (Full.FragmentSpread name _)) = do
|
||||
fragments' <- gets fragments
|
||||
Left <$> maybe lookupDefinition liftJust (HashMap.lookup name fragments')
|
||||
where
|
||||
lookupDefinition :: TransformT (Seq Core.Selection)
|
||||
lookupDefinition = do
|
||||
fragmentDefinitions' <- gets fragmentDefinitions
|
||||
found <- lift . lift $ HashMap.lookup name fragmentDefinitions'
|
||||
fragmentDefinition found
|
||||
selection (Full.SelectionInlineFragment fragment)
|
||||
| (Full.InlineFragment (Just typeCondition) _ selectionSet) <- fragment
|
||||
= Right
|
||||
$ Core.SelectionFragment
|
||||
$ Core.Fragment typeCondition
|
||||
$ appendSelection subs fr selectionSet
|
||||
. Core.SelectionFragment
|
||||
. Core.Fragment typeCondition
|
||||
<$> appendSelection selectionSet
|
||||
| (Full.InlineFragment Nothing _ selectionSet) <- fragment
|
||||
= Left $ NonEmpty.toList $ appendSelection subs fr selectionSet
|
||||
= Left <$> appendSelection selectionSet
|
||||
|
||||
-- * Fragment replacement
|
||||
|
||||
-- | Extract Fragments into a single Fragmenter function and a Operation
|
||||
-- Definition.
|
||||
defrag
|
||||
:: Schema.Subs
|
||||
-> Full.Definition
|
||||
-> Either Fragmenter Full.OperationDefinition
|
||||
defrag _ (Full.DefinitionOperation op) =
|
||||
Right op
|
||||
defrag subs (Full.DefinitionFragment fragDef) =
|
||||
Left $ fragmentDefinition subs fragDef
|
||||
-- | Extract fragment definitions into a single 'HashMap'.
|
||||
collectFragments :: TransformT ()
|
||||
collectFragments = do
|
||||
fragDefs <- gets fragmentDefinitions
|
||||
let nextValue = head $ HashMap.elems fragDefs
|
||||
unless (HashMap.null fragDefs) $ do
|
||||
_ <- fragmentDefinition nextValue
|
||||
collectFragments
|
||||
|
||||
fragmentDefinition :: Schema.Subs -> Full.FragmentDefinition -> Fragmenter
|
||||
fragmentDefinition subs (Full.FragmentDefinition name _tc _dirs sels) name'
|
||||
| name == name' = selection' <$> do
|
||||
selections <- NonEmpty.toList $ selection subs mempty <$> sels
|
||||
either id pure selections
|
||||
| otherwise = empty
|
||||
fragmentDefinition ::
|
||||
Full.FragmentDefinition ->
|
||||
TransformT (Seq Core.Selection)
|
||||
fragmentDefinition (Full.FragmentDefinition name _tc _dirs selections) = do
|
||||
modify deleteFragmentDefinition
|
||||
newValue <- appendSelection selections
|
||||
modify $ insertFragment newValue
|
||||
liftJust newValue
|
||||
where
|
||||
selection' (Core.SelectionField field') = field'
|
||||
selection' _ = error "Fragments within fragments are not supported yet"
|
||||
deleteFragmentDefinition (Replacement fragments' fragmentDefinitions') =
|
||||
Replacement fragments' $ HashMap.delete name fragmentDefinitions'
|
||||
insertFragment newValue (Replacement fragments' fragmentDefinitions') =
|
||||
let newFragments = HashMap.insert name newValue fragments'
|
||||
in Replacement newFragments fragmentDefinitions'
|
||||
|
||||
field :: Schema.Subs -> Fragmenter -> Full.Field -> Core.Field
|
||||
field subs fr (Full.Field a n args _dirs sels) =
|
||||
Core.Field a n (fold $ argument subs `traverse` args) (foldr go empty sels)
|
||||
where
|
||||
go :: Full.Selection -> [Core.Selection] -> [Core.Selection]
|
||||
go (Full.SelectionFragmentSpread (Full.FragmentSpread name _dirs)) = ((Core.SelectionField <$> fr name) <>)
|
||||
go sel = (either id pure (selection subs fr sel) <>)
|
||||
field :: Full.Field -> TransformT Core.Field
|
||||
field (Full.Field a n args _dirs sels) = do
|
||||
arguments <- traverse argument args
|
||||
selection' <- appendSelection sels
|
||||
return $ Core.Field a n arguments selection'
|
||||
|
||||
argument :: Schema.Subs -> Full.Argument -> Maybe Core.Argument
|
||||
argument subs (Full.Argument n v) = Core.Argument n <$> value subs v
|
||||
argument :: Full.Argument -> TransformT Core.Argument
|
||||
argument (Full.Argument n v) = Core.Argument n <$> value 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 :: Full.Value -> TransformT Core.Value
|
||||
value (Full.Variable n) = do
|
||||
substitute' <- lift ask
|
||||
lift . lift $ substitute' 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 (Full.List l) =
|
||||
Core.List <$> traverse value l
|
||||
value (Full.Object o) =
|
||||
Core.Object . HashMap.fromList <$> traverse objectField o
|
||||
|
||||
objectField :: Schema.Subs -> Full.ObjectField -> Maybe Core.ObjectField
|
||||
objectField subs (Full.ObjectField n v) = Core.ObjectField n <$> value subs v
|
||||
objectField :: Full.ObjectField -> TransformT (Core.Name, Core.Value)
|
||||
objectField (Full.ObjectField n v) = (n,) <$> value v
|
||||
|
||||
appendSelection ::
|
||||
Schema.Subs ->
|
||||
Fragmenter ->
|
||||
NonEmpty Full.Selection ->
|
||||
NonEmpty Core.Selection
|
||||
appendSelection subs fr = NonEmpty.fromList
|
||||
. foldr (either (++) (:) . selection subs fr) []
|
||||
Traversable t =>
|
||||
t Full.Selection ->
|
||||
TransformT (Seq Core.Selection)
|
||||
appendSelection = foldM go mempty
|
||||
where
|
||||
go acc sel = append acc <$> selection sel
|
||||
append acc (Left list) = list >< acc
|
||||
append acc (Right one) = one <| acc
|
||||
|
||||
liftJust :: forall a. a -> TransformT a
|
||||
liftJust = lift . lift . Just
|
||||
|
|
|
@ -8,6 +8,7 @@ module Language.GraphQL.Execute
|
|||
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.Foldable (toList)
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.Text (Text)
|
||||
|
@ -71,6 +72,6 @@ operation :: MonadIO m
|
|||
-> AST.Core.Operation
|
||||
-> m Aeson.Value
|
||||
operation schema (AST.Core.Query _ flds)
|
||||
= runCollectErrs (Schema.resolve (NE.toList schema) (NE.toList flds))
|
||||
= runCollectErrs (Schema.resolve (toList schema) flds)
|
||||
operation schema (AST.Core.Mutation _ flds)
|
||||
= runCollectErrs (Schema.resolve (NE.toList schema) (NE.toList flds))
|
||||
= runCollectErrs (Schema.resolve (toList schema) flds)
|
||||
|
|
|
@ -4,17 +4,12 @@
|
|||
-- functions for defining and manipulating schemas.
|
||||
module Language.GraphQL.Schema
|
||||
( Resolver
|
||||
, Schema
|
||||
, Subs
|
||||
, object
|
||||
, objectA
|
||||
, scalar
|
||||
, scalarA
|
||||
, enum
|
||||
, enumA
|
||||
, resolve
|
||||
, wrappedEnum
|
||||
, wrappedEnumA
|
||||
, wrappedObject
|
||||
, wrappedObjectA
|
||||
, wrappedScalar
|
||||
|
@ -28,23 +23,19 @@ module Language.GraphQL.Schema
|
|||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad.Trans.Except (runExceptT)
|
||||
import Control.Monad.Trans.Reader (runReaderT)
|
||||
import Data.Foldable (find, fold)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Sequence (Seq)
|
||||
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
|
||||
|
||||
{-# DEPRECATED Schema "Use NonEmpty (Resolver m) instead" #-}
|
||||
-- | A GraphQL schema.
|
||||
-- @m@ is usually expected to be an instance of 'MonadIO'.
|
||||
type Schema m = NonEmpty (Resolver m)
|
||||
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
|
||||
|
@ -69,7 +60,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
|
||||
|
@ -77,7 +68,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.
|
||||
|
@ -91,54 +82,31 @@ 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
|
||||
|
||||
{-# DEPRECATED enum "Use scalar instead" #-}
|
||||
enum :: MonadIO m => Name -> ActionT m [Text] -> Resolver m
|
||||
enum name = enumA name . const
|
||||
|
||||
{-# DEPRECATED enumA "Use scalarA instead" #-}
|
||||
enumA :: MonadIO m => Name -> ([Argument] -> ActionT m [Text]) -> Resolver m
|
||||
enumA name f = Resolver name $ resolveFieldValue f resolveRight
|
||||
where
|
||||
resolveRight fld resolver = withField (return resolver) fld
|
||||
|
||||
{-# DEPRECATED wrappedEnumA "Use wrappedScalarA instead" #-}
|
||||
wrappedEnumA :: MonadIO m
|
||||
=> Name -> ([Argument] -> ActionT m (Wrapping [Text])) -> Resolver m
|
||||
wrappedEnumA name f = Resolver name $ resolveFieldValue f resolveRight
|
||||
where
|
||||
resolveRight fld (Named resolver) = withField (return resolver) fld
|
||||
resolveRight fld Null
|
||||
= return $ HashMap.singleton (aliasOrName fld) Aeson.Null
|
||||
resolveRight fld (List resolver) = withField (return resolver) fld
|
||||
|
||||
{-# DEPRECATED wrappedEnum "Use wrappedScalar instead" #-}
|
||||
wrappedEnum :: MonadIO m => Name -> ActionT m (Wrapping [Text]) -> Resolver m
|
||||
wrappedEnum name = wrappedEnumA name . const
|
||||
|
||||
resolveFieldValue :: MonadIO m
|
||||
=> ([Argument] -> ActionT m a)
|
||||
-> (Field -> a -> CollectErrsT m (HashMap Text Aeson.Value))
|
||||
-> Field
|
||||
-> CollectErrsT m (HashMap Text Aeson.Value)
|
||||
resolveFieldValue f resolveRight fld@(Field _ _ args _) = do
|
||||
result <- lift $ runExceptT . runActionT $ f args
|
||||
result <- lift $ reader . runExceptT . runActionT $ f args
|
||||
either resolveLeft (resolveRight fld) result
|
||||
where
|
||||
reader = flip runReaderT $ Context mempty
|
||||
resolveLeft err = do
|
||||
_ <- addErrMsg err
|
||||
return $ HashMap.singleton (aliasOrName fld) Aeson.Null
|
||||
|
@ -153,7 +121,7 @@ withField v fld
|
|||
-- 'Resolver' to each 'Field'. Resolves into a value containing the
|
||||
-- resolved 'Field', or a null value and error information.
|
||||
resolve :: MonadIO m
|
||||
=> [Resolver m] -> [Selection] -> CollectErrsT m Aeson.Value
|
||||
=> [Resolver m] -> Seq Selection -> CollectErrsT m Aeson.Value
|
||||
resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
|
||||
where
|
||||
resolveTypeName (Resolver "__typename" f) = do
|
||||
|
|
|
@ -1,6 +1,7 @@
|
|||
-- | Monad transformer stack used by the @GraphQL@ resolvers.
|
||||
module Language.GraphQL.Trans
|
||||
( ActionT(..)
|
||||
, Context(Context)
|
||||
) where
|
||||
|
||||
import Control.Applicative (Alternative(..))
|
||||
|
@ -8,10 +9,19 @@ import Control.Monad (MonadPlus(..))
|
|||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Monad.Trans.Class (MonadTrans(..))
|
||||
import Control.Monad.Trans.Except (ExceptT)
|
||||
import Control.Monad.Trans.Reader (ReaderT)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Core (Name, Value)
|
||||
|
||||
-- | Monad transformer stack used by the resolvers to provide error handling.
|
||||
newtype ActionT m a = ActionT { runActionT :: ExceptT Text m a }
|
||||
-- | Resolution context holds resolver arguments.
|
||||
newtype Context = Context (HashMap Name Value)
|
||||
|
||||
-- | Monad transformer stack used by the resolvers to provide error handling
|
||||
-- and resolution context (resolver arguments).
|
||||
newtype ActionT m a = ActionT
|
||||
{ runActionT :: ExceptT Text (ReaderT Context m) a
|
||||
}
|
||||
|
||||
instance Functor m => Functor (ActionT m) where
|
||||
fmap f = ActionT . fmap f . runActionT
|
||||
|
@ -25,7 +35,7 @@ instance Monad m => Monad (ActionT m) where
|
|||
(ActionT action) >>= f = ActionT $ action >>= runActionT . f
|
||||
|
||||
instance MonadTrans ActionT where
|
||||
lift = ActionT . lift
|
||||
lift = ActionT . lift . lift
|
||||
|
||||
instance MonadIO m => MonadIO (ActionT m) where
|
||||
liftIO = lift . liftIO
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
resolver: lts-14.11
|
||||
resolver: lts-14.16
|
||||
|
||||
packages:
|
||||
- .
|
||||
|
|
|
@ -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` "\"\\\"\""
|
|
@ -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)
|
||||
|
@ -71,8 +71,8 @@ spec = describe "Lexer" $ do
|
|||
parse float "" "-1.123e4567" `shouldParse` (-1.123e4567)
|
||||
|
||||
it "lexes punctuation" $ do
|
||||
parse bang "" "!" `shouldParse` '!'
|
||||
parse dollar "" "$" `shouldParse` '$'
|
||||
parse bang "" "!" `shouldParse` "!"
|
||||
parse dollar "" "$" `shouldParse` "$"
|
||||
runBetween parens `shouldSucceedOn` "()"
|
||||
parse spread "" "..." `shouldParse` "..."
|
||||
parse colon "" ":" `shouldParse` ":"
|
|
@ -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)
|
||||
|
@ -24,3 +24,9 @@ spec = describe "Parser" $ do
|
|||
parse document "" `shouldSucceedOn` [r|{
|
||||
hello(text: "Argument")
|
||||
}|]
|
||||
|
||||
it "accepts two required arguments" $
|
||||
parse document "" `shouldSucceedOn` [r|
|
||||
mutation auth($username: String!, $password: String!){
|
||||
test
|
||||
}|]
|
|
@ -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` "\"\\\"\""
|
|
@ -10,7 +10,13 @@ import Data.List.NonEmpty (NonEmpty(..))
|
|||
import Data.Text (Text)
|
||||
import Language.GraphQL
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import Test.Hspec (Spec, describe, it, shouldBe, shouldNotSatisfy)
|
||||
import Test.Hspec ( Spec
|
||||
, describe
|
||||
, it
|
||||
, shouldBe
|
||||
, shouldSatisfy
|
||||
, shouldNotSatisfy
|
||||
)
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
size :: Schema.Resolver IO
|
||||
|
@ -37,6 +43,10 @@ inlineQuery = [r|{
|
|||
}
|
||||
}|]
|
||||
|
||||
hasErrors :: Value -> Bool
|
||||
hasErrors (Object object') = HashMap.member "errors" object'
|
||||
hasErrors _ = True
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Inline fragment executor" $ do
|
||||
it "chooses the first selection if the type matches" $ do
|
||||
|
@ -92,6 +102,63 @@ spec = describe "Inline fragment executor" $ do
|
|||
|
||||
actual <- graphql (size :| []) query
|
||||
actual `shouldNotSatisfy` hasErrors
|
||||
where
|
||||
hasErrors (Object object') = HashMap.member "errors" object'
|
||||
hasErrors _ = True
|
||||
|
||||
it "evaluates nested fragments" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
|
||||
fragment hatFragment on Hat {
|
||||
...circumferenceFragment
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "evaluates fragments defined in any order" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
...hatFragment
|
||||
}
|
||||
|
||||
fragment hatFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "rejects recursive" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
...circumferenceFragment
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
actual `shouldSatisfy` hasErrors
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue