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:
Eugen Wissner 2019-11-03 10:42:10 +01:00
parent 417ff5da7d
commit 73fc334bf8
18 changed files with 240 additions and 234 deletions

View File

@ -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]`

View File

@ -35,6 +35,8 @@ dependencies:
library:
source-dirs: src
other-modules:
- Language.GraphQL.AST.Transform
tests:
tasty:

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 =>

View File

@ -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

View File

@ -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

View File

@ -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` "\"\\\"\""

View File

@ -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)

View File

@ -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)

View File

@ -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` "\"\\\"\""

View File

@ -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)

View File

@ -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

View File

@ -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