Move related modules to Language.GraphQL.AST
Fixes #18. - `Language.GraphQL.Encoder` moved to `Language.GraphQL.AST.Encoder`. - `Language.GraphQL.Parser` moved to `Language.GraphQL.AST.Parser`. - `Language.GraphQL.Lexer` moved to `Language.GraphQL.AST.Lexer`. - All `Language.GraphQL.AST.Value` data constructor prefixes were removed. The module should be imported qualified. - All `Language.GraphQL.AST.Core.Value` data constructor prefixes were removed. The module should be imported qualified. - `Language.GraphQL.AST.Transform` is now isn't exposed publically anymore.
This commit is contained in:
parent
417ff5da7d
commit
73fc334bf8
16
CHANGELOG.md
16
CHANGELOG.md
|
|
@ -1,6 +1,22 @@
|
|||
# Change Log
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased
|
||||
### Changed
|
||||
- `Language.GraphQL.Encoder` moved to `Language.GraphQL.AST.Encoder`.
|
||||
- `Language.GraphQL.Parser` moved to `Language.GraphQL.AST.Parser`.
|
||||
- `Language.GraphQL.Lexer` moved to `Language.GraphQL.AST.Lexer`.
|
||||
- All `Language.GraphQL.AST.Value` data constructor prefixes were removed. The
|
||||
module should be imported qualified.
|
||||
- All `Language.GraphQL.AST.Core.Value` data constructor prefixes were removed.
|
||||
The module should be imported qualified.
|
||||
- Make `Language.GraphQL.AST.Core.Object` is now just a HashMap.
|
||||
- `Language.GraphQL.AST.Transform` is now isn't exposed publically anymore.
|
||||
|
||||
### Fixed
|
||||
- (Unsupported) nested fragments doesn't throw a runtime error but return a
|
||||
transformation error.
|
||||
|
||||
## [0.5.1.0] - 2019-10-22
|
||||
### Deprecated
|
||||
- `Language.GraphQL.AST.Arguments`. Use `[Language.GraphQL.AST.Argument]`
|
||||
|
|
|
|||
|
|
@ -35,6 +35,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)
|
||||
|
||||
|
|
|
|||
|
|
@ -29,16 +29,15 @@ module Language.GraphQL.AST
|
|||
import Data.Int (Int32)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.AST.Core ( Alias
|
||||
, Name
|
||||
, TypeCondition
|
||||
)
|
||||
|
||||
-- * Document
|
||||
|
||||
-- | GraphQL document.
|
||||
type Document = NonEmpty Definition
|
||||
|
||||
-- | Name
|
||||
type Name = Text
|
||||
|
||||
-- | Directive.
|
||||
data Directive = Directive Name [Argument] deriving (Eq, Show)
|
||||
|
||||
|
|
@ -82,12 +81,56 @@ data Selection
|
|||
|
||||
-- * Field
|
||||
|
||||
-- | GraphQL field.
|
||||
-- | Single GraphQL field.
|
||||
--
|
||||
-- The only required property of a field is its name. Optionally it can also
|
||||
-- have an alias, arguments or a list of subfields.
|
||||
--
|
||||
-- Given the following query:
|
||||
--
|
||||
-- @
|
||||
-- {
|
||||
-- zuck: user(id: 4) {
|
||||
-- id
|
||||
-- name
|
||||
-- }
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- * "user", "id" and "name" are field names.
|
||||
-- * "user" has two subfields, "id" and "name".
|
||||
-- * "zuck" is an alias for "user". "id" and "name" have no aliases.
|
||||
-- * "id: 4" is an argument for "name". "id" and "name don't have any
|
||||
-- arguments.
|
||||
data Field
|
||||
= Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Argument.
|
||||
-- | Alternative field name.
|
||||
--
|
||||
-- @
|
||||
-- {
|
||||
-- smallPic: profilePic(size: 64)
|
||||
-- bigPic: profilePic(size: 1024)
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- Here "smallPic" and "bigPic" are aliases for the same field, "profilePic",
|
||||
-- used to distinquish between profile pictures with different arguments
|
||||
-- (sizes).
|
||||
type Alias = Name
|
||||
|
||||
-- | Single argument.
|
||||
--
|
||||
-- @
|
||||
-- {
|
||||
-- user(id: 4) {
|
||||
-- name
|
||||
-- }
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- Here "id" is an argument for the field "user" and its value is 4.
|
||||
data Argument = Argument Name Value deriving (Eq,Show)
|
||||
|
||||
-- * Fragments
|
||||
|
|
@ -107,15 +150,15 @@ data FragmentDefinition
|
|||
-- * Inputs
|
||||
|
||||
-- | Input value.
|
||||
data Value = ValueVariable Name
|
||||
| ValueInt Int32
|
||||
| ValueFloat Double
|
||||
| ValueString Text
|
||||
| ValueBoolean Bool
|
||||
| ValueNull
|
||||
| ValueEnum Name
|
||||
| ValueList [Value]
|
||||
| ValueObject [ObjectField]
|
||||
data Value = Variable Name
|
||||
| Int Int32
|
||||
| Float Double
|
||||
| String Text
|
||||
| Boolean Bool
|
||||
| Null
|
||||
| Enum Name
|
||||
| List [Value]
|
||||
| Object [ObjectField]
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Key-value pair.
|
||||
|
|
@ -127,13 +170,15 @@ data ObjectField = ObjectField Name Value deriving (Eq, Show)
|
|||
data VariableDefinition = VariableDefinition Name Type (Maybe Value)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Type condition.
|
||||
type TypeCondition = Name
|
||||
|
||||
-- | Type representation.
|
||||
data Type = TypeNamed Name
|
||||
| TypeList Type
|
||||
| TypeNonNull NonNullType
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
-- | Helper type to represent Non-Null types and lists of such types.
|
||||
data NonNullType = NonNullTypeNamed Name
|
||||
| NonNullTypeList Type
|
||||
|
|
|
|||
|
|
@ -6,7 +6,6 @@ module Language.GraphQL.AST.Core
|
|||
, Field(..)
|
||||
, Fragment(..)
|
||||
, Name
|
||||
, ObjectField(..)
|
||||
, Operation(..)
|
||||
, Selection(..)
|
||||
, TypeCondition
|
||||
|
|
@ -14,12 +13,11 @@ module Language.GraphQL.AST.Core
|
|||
) where
|
||||
|
||||
import Data.Int (Int32)
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.String
|
||||
import Data.String (IsString(..))
|
||||
import Data.Text (Text)
|
||||
|
||||
-- | Name
|
||||
type Name = Text
|
||||
import Language.GraphQL.AST (Alias, Name, TypeCondition)
|
||||
|
||||
-- | GraphQL document is a non-empty list of operations.
|
||||
type Document = NonEmpty Operation
|
||||
|
|
@ -32,80 +30,12 @@ data Operation
|
|||
| Mutation (Maybe Text) (NonEmpty Selection)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | A single GraphQL field.
|
||||
--
|
||||
-- Only required property of a field, is its name. Optionally it can also have
|
||||
-- an alias, arguments or a list of subfields.
|
||||
--
|
||||
-- Given the following query:
|
||||
--
|
||||
-- @
|
||||
-- {
|
||||
-- zuck: user(id: 4) {
|
||||
-- id
|
||||
-- name
|
||||
-- }
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- * "user", "id" and "name" are field names.
|
||||
-- * "user" has two subfields, "id" and "name".
|
||||
-- * "zuck" is an alias for "user". "id" and "name" have no aliases.
|
||||
-- * "id: 4" is an argument for "name". "id" and "name don't have any
|
||||
-- arguments.
|
||||
-- | Single GraphQL field.
|
||||
data Field = Field (Maybe Alias) Name [Argument] [Selection] deriving (Eq, Show)
|
||||
|
||||
-- | Alternative field name.
|
||||
--
|
||||
-- @
|
||||
-- {
|
||||
-- smallPic: profilePic(size: 64)
|
||||
-- bigPic: profilePic(size: 1024)
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- Here "smallPic" and "bigPic" are aliases for the same field, "profilePic",
|
||||
-- used to distinquish between profile pictures with different arguments
|
||||
-- (sizes).
|
||||
type Alias = Name
|
||||
|
||||
-- | Single argument.
|
||||
--
|
||||
-- @
|
||||
-- {
|
||||
-- user(id: 4) {
|
||||
-- name
|
||||
-- }
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- Here "id" is an argument for the field "user" and its value is 4.
|
||||
data Argument = Argument Name Value deriving (Eq, Show)
|
||||
|
||||
-- | Represents accordingly typed GraphQL values.
|
||||
data Value
|
||||
= ValueInt Int32
|
||||
-- GraphQL Float is double precision
|
||||
| ValueFloat Double
|
||||
| ValueString Text
|
||||
| ValueBoolean Bool
|
||||
| ValueNull
|
||||
| ValueEnum Name
|
||||
| ValueList [Value]
|
||||
| ValueObject [ObjectField]
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance IsString Value where
|
||||
fromString = ValueString . fromString
|
||||
|
||||
-- | Key-value pair.
|
||||
--
|
||||
-- A list of 'ObjectField's represents a GraphQL object type.
|
||||
data ObjectField = ObjectField Name Value deriving (Eq, Show)
|
||||
|
||||
-- | Type condition.
|
||||
type TypeCondition = Name
|
||||
|
||||
-- | Represents fragments and inline fragments.
|
||||
data Fragment
|
||||
= Fragment TypeCondition (NonEmpty Selection)
|
||||
|
|
@ -116,3 +46,18 @@ data Selection
|
|||
= SelectionFragment Fragment
|
||||
| SelectionField Field
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Represents accordingly typed GraphQL values.
|
||||
data Value
|
||||
= Int Int32
|
||||
| Float Double -- ^ GraphQL Float is double precision
|
||||
| String Text
|
||||
| Boolean Bool
|
||||
| Null
|
||||
| Enum Name
|
||||
| List [Value]
|
||||
| Object (HashMap Name Value)
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance IsString Value where
|
||||
fromString = String . fromString
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
{-# LANGUAGE ExplicitForAll #-}
|
||||
|
||||
-- | This module defines a minifier and a printer for the @GraphQL@ language.
|
||||
module Language.GraphQL.Encoder
|
||||
module Language.GraphQL.AST.Encoder
|
||||
( Formatter
|
||||
, definition
|
||||
, directive
|
||||
|
|
@ -21,7 +21,7 @@ import qualified Data.Text.Lazy as Text.Lazy
|
|||
import Data.Text.Lazy.Builder (toLazyText)
|
||||
import Data.Text.Lazy.Builder.Int (decimal)
|
||||
import Data.Text.Lazy.Builder.RealFloat (realFloat)
|
||||
import Language.GraphQL.AST
|
||||
import qualified Language.GraphQL.AST as Full
|
||||
|
||||
-- | Instructs the encoder whether a GraphQL should be minified or pretty
|
||||
-- printed.
|
||||
|
|
@ -40,7 +40,7 @@ minified :: Formatter
|
|||
minified = Minified
|
||||
|
||||
-- | Converts a 'Document' into a string.
|
||||
document :: Formatter -> Document -> Text
|
||||
document :: Formatter -> Full.Document -> Text
|
||||
document formatter defs
|
||||
| Pretty _ <- formatter = Text.Lazy.intercalate "\n" encodeDocument
|
||||
| Minified <-formatter = Text.Lazy.snoc (mconcat encodeDocument) '\n'
|
||||
|
|
@ -48,29 +48,29 @@ document formatter defs
|
|||
encodeDocument = NonEmpty.toList $ definition formatter <$> defs
|
||||
|
||||
-- | Converts a 'Definition' into a string.
|
||||
definition :: Formatter -> Definition -> Text
|
||||
definition :: Formatter -> Full.Definition -> Text
|
||||
definition formatter x
|
||||
| Pretty _ <- formatter = Text.Lazy.snoc (encodeDefinition x) '\n'
|
||||
| Minified <- formatter = encodeDefinition x
|
||||
where
|
||||
encodeDefinition (DefinitionOperation operation)
|
||||
encodeDefinition (Full.DefinitionOperation operation)
|
||||
= operationDefinition formatter operation
|
||||
encodeDefinition (DefinitionFragment fragment)
|
||||
encodeDefinition (Full.DefinitionFragment fragment)
|
||||
= fragmentDefinition formatter fragment
|
||||
|
||||
operationDefinition :: Formatter -> OperationDefinition -> Text
|
||||
operationDefinition formatter (OperationSelectionSet sels)
|
||||
operationDefinition :: Formatter -> Full.OperationDefinition -> Text
|
||||
operationDefinition formatter (Full.OperationSelectionSet sels)
|
||||
= selectionSet formatter sels
|
||||
operationDefinition formatter (OperationDefinition Query name vars dirs sels)
|
||||
operationDefinition formatter (Full.OperationDefinition Full.Query name vars dirs sels)
|
||||
= "query " <> node formatter name vars dirs sels
|
||||
operationDefinition formatter (OperationDefinition Mutation name vars dirs sels)
|
||||
operationDefinition formatter (Full.OperationDefinition Full.Mutation name vars dirs sels)
|
||||
= "mutation " <> node formatter name vars dirs sels
|
||||
|
||||
node :: Formatter
|
||||
-> Maybe Name
|
||||
-> [VariableDefinition]
|
||||
-> [Directive]
|
||||
-> SelectionSet
|
||||
-> Maybe Full.Name
|
||||
-> [Full.VariableDefinition]
|
||||
-> [Full.Directive]
|
||||
-> Full.SelectionSet
|
||||
-> Text
|
||||
node formatter name vars dirs sels
|
||||
= Text.Lazy.fromStrict (fold name)
|
||||
|
|
@ -79,39 +79,39 @@ node formatter name vars dirs sels
|
|||
<> eitherFormat formatter " " mempty
|
||||
<> selectionSet formatter sels
|
||||
|
||||
variableDefinitions :: Formatter -> [VariableDefinition] -> Text
|
||||
variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Text
|
||||
variableDefinitions formatter
|
||||
= parensCommas formatter $ variableDefinition formatter
|
||||
|
||||
variableDefinition :: Formatter -> VariableDefinition -> Text
|
||||
variableDefinition formatter (VariableDefinition var ty dv)
|
||||
variableDefinition :: Formatter -> Full.VariableDefinition -> Text
|
||||
variableDefinition formatter (Full.VariableDefinition var ty dv)
|
||||
= variable var
|
||||
<> eitherFormat formatter ": " ":"
|
||||
<> type' ty
|
||||
<> maybe mempty (defaultValue formatter) dv
|
||||
|
||||
defaultValue :: Formatter -> Value -> Text
|
||||
defaultValue :: Formatter -> Full.Value -> Text
|
||||
defaultValue formatter val
|
||||
= eitherFormat formatter " = " "="
|
||||
<> value formatter val
|
||||
|
||||
variable :: Name -> Text
|
||||
variable :: Full.Name -> Text
|
||||
variable var = "$" <> Text.Lazy.fromStrict var
|
||||
|
||||
selectionSet :: Formatter -> SelectionSet -> Text
|
||||
selectionSet :: Formatter -> Full.SelectionSet -> Text
|
||||
selectionSet formatter
|
||||
= bracesList formatter (selection formatter)
|
||||
. NonEmpty.toList
|
||||
|
||||
selectionSetOpt :: Formatter -> SelectionSetOpt -> Text
|
||||
selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Text
|
||||
selectionSetOpt formatter = bracesList formatter $ selection formatter
|
||||
|
||||
selection :: Formatter -> Selection -> Text
|
||||
selection :: Formatter -> Full.Selection -> Text
|
||||
selection formatter = Text.Lazy.append indent . f
|
||||
where
|
||||
f (SelectionField x) = field incrementIndent x
|
||||
f (SelectionInlineFragment x) = inlineFragment incrementIndent x
|
||||
f (SelectionFragmentSpread x) = fragmentSpread incrementIndent x
|
||||
f (Full.SelectionField x) = field incrementIndent x
|
||||
f (Full.SelectionInlineFragment x) = inlineFragment incrementIndent x
|
||||
f (Full.SelectionFragmentSpread x) = fragmentSpread incrementIndent x
|
||||
incrementIndent
|
||||
| Pretty n <- formatter = Pretty $ n + 1
|
||||
| otherwise = Minified
|
||||
|
|
@ -119,8 +119,8 @@ selection formatter = Text.Lazy.append indent . f
|
|||
| Pretty n <- formatter = Text.Lazy.replicate (fromIntegral $ n + 1) " "
|
||||
| otherwise = mempty
|
||||
|
||||
field :: Formatter -> Field -> Text
|
||||
field formatter (Field alias name args dirs selso)
|
||||
field :: Formatter -> Full.Field -> Text
|
||||
field formatter (Full.Field alias name args dirs selso)
|
||||
= optempty (`Text.Lazy.append` colon) (Text.Lazy.fromStrict $ fold alias)
|
||||
<> Text.Lazy.fromStrict name
|
||||
<> optempty (arguments formatter) args
|
||||
|
|
@ -132,31 +132,31 @@ field formatter (Field alias name args dirs selso)
|
|||
| null selso = mempty
|
||||
| otherwise = eitherFormat formatter " " mempty <> selectionSetOpt formatter selso
|
||||
|
||||
arguments :: Formatter -> [Argument] -> Text
|
||||
arguments :: Formatter -> [Full.Argument] -> Text
|
||||
arguments formatter = parensCommas formatter $ argument formatter
|
||||
|
||||
argument :: Formatter -> Argument -> Text
|
||||
argument formatter (Argument name v)
|
||||
argument :: Formatter -> Full.Argument -> Text
|
||||
argument formatter (Full.Argument name v)
|
||||
= Text.Lazy.fromStrict name
|
||||
<> eitherFormat formatter ": " ":"
|
||||
<> value formatter v
|
||||
|
||||
-- * Fragments
|
||||
|
||||
fragmentSpread :: Formatter -> FragmentSpread -> Text
|
||||
fragmentSpread formatter (FragmentSpread name ds)
|
||||
fragmentSpread :: Formatter -> Full.FragmentSpread -> Text
|
||||
fragmentSpread formatter (Full.FragmentSpread name ds)
|
||||
= "..." <> Text.Lazy.fromStrict name <> optempty (directives formatter) ds
|
||||
|
||||
inlineFragment :: Formatter -> InlineFragment -> Text
|
||||
inlineFragment formatter (InlineFragment tc dirs sels)
|
||||
inlineFragment :: Formatter -> Full.InlineFragment -> Text
|
||||
inlineFragment formatter (Full.InlineFragment tc dirs sels)
|
||||
= "... on "
|
||||
<> Text.Lazy.fromStrict (fold tc)
|
||||
<> directives formatter dirs
|
||||
<> eitherFormat formatter " " mempty
|
||||
<> selectionSet formatter sels
|
||||
|
||||
fragmentDefinition :: Formatter -> FragmentDefinition -> Text
|
||||
fragmentDefinition formatter (FragmentDefinition name tc dirs sels)
|
||||
fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Text
|
||||
fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
|
||||
= "fragment " <> Text.Lazy.fromStrict name
|
||||
<> " on " <> Text.Lazy.fromStrict tc
|
||||
<> optempty (directives formatter) dirs
|
||||
|
|
@ -166,25 +166,25 @@ fragmentDefinition formatter (FragmentDefinition name tc dirs sels)
|
|||
-- * Miscellaneous
|
||||
|
||||
-- | Converts a 'Directive' into a string.
|
||||
directive :: Formatter -> Directive -> Text
|
||||
directive formatter (Directive name args)
|
||||
directive :: Formatter -> Full.Directive -> Text
|
||||
directive formatter (Full.Directive name args)
|
||||
= "@" <> Text.Lazy.fromStrict name <> optempty (arguments formatter) args
|
||||
|
||||
directives :: Formatter -> [Directive] -> Text
|
||||
directives :: Formatter -> [Full.Directive] -> Text
|
||||
directives formatter@(Pretty _) = Text.Lazy.cons ' ' . spaces (directive formatter)
|
||||
directives Minified = spaces (directive Minified)
|
||||
|
||||
-- | Converts a 'Value' into a string.
|
||||
value :: Formatter -> Value -> Text
|
||||
value _ (ValueVariable x) = variable x
|
||||
value _ (ValueInt x) = toLazyText $ decimal x
|
||||
value _ (ValueFloat x) = toLazyText $ realFloat x
|
||||
value _ (ValueBoolean x) = booleanValue x
|
||||
value _ ValueNull = mempty
|
||||
value _ (ValueString x) = stringValue $ Text.Lazy.fromStrict x
|
||||
value _ (ValueEnum x) = Text.Lazy.fromStrict x
|
||||
value formatter (ValueList x) = listValue formatter x
|
||||
value formatter (ValueObject x) = objectValue formatter x
|
||||
value :: Formatter -> Full.Value -> Text
|
||||
value _ (Full.Variable x) = variable x
|
||||
value _ (Full.Int x) = toLazyText $ decimal x
|
||||
value _ (Full.Float x) = toLazyText $ realFloat x
|
||||
value _ (Full.Boolean x) = booleanValue x
|
||||
value _ Full.Null = mempty
|
||||
value _ (Full.String x) = stringValue $ Text.Lazy.fromStrict x
|
||||
value _ (Full.Enum x) = Text.Lazy.fromStrict x
|
||||
value formatter (Full.List x) = listValue formatter x
|
||||
value formatter (Full.Object x) = objectValue formatter x
|
||||
|
||||
booleanValue :: Bool -> Text
|
||||
booleanValue True = "true"
|
||||
|
|
@ -196,10 +196,10 @@ stringValue
|
|||
. Text.Lazy.replace "\"" "\\\""
|
||||
. Text.Lazy.replace "\\" "\\\\"
|
||||
|
||||
listValue :: Formatter -> [Value] -> Text
|
||||
listValue :: Formatter -> [Full.Value] -> Text
|
||||
listValue formatter = bracketsCommas formatter $ value formatter
|
||||
|
||||
objectValue :: Formatter -> [ObjectField] -> Text
|
||||
objectValue :: Formatter -> [Full.ObjectField] -> Text
|
||||
objectValue formatter = intercalate $ objectField formatter
|
||||
where
|
||||
intercalate f
|
||||
|
|
@ -208,8 +208,8 @@ objectValue formatter = intercalate $ objectField formatter
|
|||
. fmap f
|
||||
|
||||
|
||||
objectField :: Formatter -> ObjectField -> Text
|
||||
objectField formatter (ObjectField name v)
|
||||
objectField :: Formatter -> Full.ObjectField -> Text
|
||||
objectField formatter (Full.ObjectField name v)
|
||||
= Text.Lazy.fromStrict name <> colon <> value formatter v
|
||||
where
|
||||
colon
|
||||
|
|
@ -217,17 +217,17 @@ objectField formatter (ObjectField name v)
|
|||
| Minified <- formatter = ":"
|
||||
|
||||
-- | Converts a 'Type' a type into a string.
|
||||
type' :: Type -> Text
|
||||
type' (TypeNamed x) = Text.Lazy.fromStrict x
|
||||
type' (TypeList x) = listType x
|
||||
type' (TypeNonNull x) = nonNullType x
|
||||
type' :: Full.Type -> Text
|
||||
type' (Full.TypeNamed x) = Text.Lazy.fromStrict x
|
||||
type' (Full.TypeList x) = listType x
|
||||
type' (Full.TypeNonNull x) = nonNullType x
|
||||
|
||||
listType :: Type -> Text
|
||||
listType :: Full.Type -> Text
|
||||
listType x = brackets (type' x)
|
||||
|
||||
nonNullType :: NonNullType -> Text
|
||||
nonNullType (NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!"
|
||||
nonNullType (NonNullTypeList x) = listType x <> "!"
|
||||
nonNullType :: Full.NonNullType -> Text
|
||||
nonNullType (Full.NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!"
|
||||
nonNullType (Full.NonNullTypeList x) = listType x <> "!"
|
||||
|
||||
-- * Internal
|
||||
|
||||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -1,3 +1,5 @@
|
|||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
-- | After the document is parsed, before getting executed the AST is
|
||||
-- transformed into a similar, simpler AST. This module is responsible for
|
||||
-- this transformation.
|
||||
|
|
@ -113,20 +115,20 @@ argument :: Schema.Subs -> Full.Argument -> Maybe Core.Argument
|
|||
argument subs (Full.Argument n v) = Core.Argument n <$> value subs v
|
||||
|
||||
value :: Schema.Subs -> Full.Value -> Maybe Core.Value
|
||||
value subs (Full.ValueVariable n) = subs n
|
||||
value _ (Full.ValueInt i) = pure $ Core.ValueInt i
|
||||
value _ (Full.ValueFloat f) = pure $ Core.ValueFloat f
|
||||
value _ (Full.ValueString x) = pure $ Core.ValueString x
|
||||
value _ (Full.ValueBoolean b) = pure $ Core.ValueBoolean b
|
||||
value _ Full.ValueNull = pure Core.ValueNull
|
||||
value _ (Full.ValueEnum e) = pure $ Core.ValueEnum e
|
||||
value subs (Full.ValueList l) =
|
||||
Core.ValueList <$> traverse (value subs) l
|
||||
value subs (Full.ValueObject o) =
|
||||
Core.ValueObject <$> traverse (objectField subs) o
|
||||
value subs (Full.Variable n) = subs n
|
||||
value _ (Full.Int i) = pure $ Core.Int i
|
||||
value _ (Full.Float f) = pure $ Core.Float f
|
||||
value _ (Full.String x) = pure $ Core.String x
|
||||
value _ (Full.Boolean b) = pure $ Core.Boolean b
|
||||
value _ Full.Null = pure Core.Null
|
||||
value _ (Full.Enum e) = pure $ Core.Enum e
|
||||
value subs (Full.List l) =
|
||||
Core.List <$> traverse (value subs) l
|
||||
value subs (Full.Object o) =
|
||||
Core.Object . HashMap.fromList <$> traverse (objectField subs) o
|
||||
|
||||
objectField :: Schema.Subs -> Full.ObjectField -> Maybe Core.ObjectField
|
||||
objectField subs (Full.ObjectField n v) = Core.ObjectField n <$> value subs v
|
||||
objectField :: Schema.Subs -> Full.ObjectField -> Maybe (Core.Name, Core.Value)
|
||||
objectField subs (Full.ObjectField n v) = (n,) <$> value subs v
|
||||
|
||||
appendSelectionOpt ::
|
||||
Traversable t =>
|
||||
|
|
|
|||
|
|
@ -30,10 +30,10 @@ import Data.HashMap.Strict (HashMap)
|
|||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Language.GraphQL.AST.Core
|
||||
import Language.GraphQL.Error
|
||||
import Language.GraphQL.Trans
|
||||
import Language.GraphQL.Type
|
||||
import Language.GraphQL.AST.Core
|
||||
import qualified Language.GraphQL.Type as Type
|
||||
|
||||
-- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error
|
||||
-- information (if an error has occurred). @m@ is usually expected to be an
|
||||
|
|
@ -58,7 +58,7 @@ objectA name f = Resolver name $ resolveFieldValue f resolveRight
|
|||
|
||||
-- | Like 'object' but also taking 'Argument's and can be null or a list of objects.
|
||||
wrappedObjectA :: MonadIO m
|
||||
=> Name -> ([Argument] -> ActionT m (Wrapping [Resolver m])) -> Resolver m
|
||||
=> Name -> ([Argument] -> ActionT m (Type.Wrapping [Resolver m])) -> Resolver m
|
||||
wrappedObjectA name f = Resolver name $ resolveFieldValue f resolveRight
|
||||
where
|
||||
resolveRight fld@(Field _ _ _ sels) resolver
|
||||
|
|
@ -66,7 +66,7 @@ wrappedObjectA name f = Resolver name $ resolveFieldValue f resolveRight
|
|||
|
||||
-- | Like 'object' but can be null or a list of objects.
|
||||
wrappedObject :: MonadIO m
|
||||
=> Name -> ActionT m (Wrapping [Resolver m]) -> Resolver m
|
||||
=> Name -> ActionT m (Type.Wrapping [Resolver m]) -> Resolver m
|
||||
wrappedObject name = wrappedObjectA name . const
|
||||
|
||||
-- | A scalar represents a primitive value, like a string or an integer.
|
||||
|
|
@ -80,19 +80,19 @@ scalarA name f = Resolver name $ resolveFieldValue f resolveRight
|
|||
where
|
||||
resolveRight fld result = withField (return result) fld
|
||||
|
||||
-- | Lika 'scalar' but also taking 'Argument's and can be null or a list of scalars.
|
||||
-- | Like 'scalar' but also taking 'Argument's and can be null or a list of scalars.
|
||||
wrappedScalarA :: (MonadIO m, Aeson.ToJSON a)
|
||||
=> Name -> ([Argument] -> ActionT m (Wrapping a)) -> Resolver m
|
||||
=> Name -> ([Argument] -> ActionT m (Type.Wrapping a)) -> Resolver m
|
||||
wrappedScalarA name f = Resolver name $ resolveFieldValue f resolveRight
|
||||
where
|
||||
resolveRight fld (Named result) = withField (return result) fld
|
||||
resolveRight fld Null
|
||||
resolveRight fld (Type.Named result) = withField (return result) fld
|
||||
resolveRight fld Type.Null
|
||||
= return $ HashMap.singleton (aliasOrName fld) Aeson.Null
|
||||
resolveRight fld (List result) = withField (return result) fld
|
||||
resolveRight fld (Type.List result) = withField (return result) fld
|
||||
|
||||
-- | Like 'scalar' but can be null or a list of scalars.
|
||||
wrappedScalar :: (MonadIO m, Aeson.ToJSON a)
|
||||
=> Name -> ActionT m (Wrapping a) -> Resolver m
|
||||
=> Name -> ActionT m (Type.Wrapping a) -> Resolver m
|
||||
wrappedScalar name = wrappedScalarA name . const
|
||||
|
||||
resolveFieldValue :: MonadIO m
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
@ -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)
|
||||
|
|
@ -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` "\"\\\"\""
|
||||
|
|
@ -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