prescientmoon/graphql
1
0
Fork 0
forked from OSS/graphql
Code Pull Requests Activity

Move related modules to Language.GraphQL.AST

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
CHANGELOG.md
View File

@ -1,6 +1,22 @@
# Change Log # Change Log
All notable changes to this project will be documented in this file. 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 ## [0.5.1.0] - 2019-10-22
### Deprecated ### Deprecated
- `Language.GraphQL.AST.Arguments`. Use `[Language.GraphQL.AST.Argument]` - `Language.GraphQL.AST.Arguments`. Use `[Language.GraphQL.AST.Argument]`

2
package.yaml
View File

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

2
src/Language/GraphQL.hs
View File

@ -10,7 +10,7 @@ import Data.List.NonEmpty (NonEmpty)
import qualified Data.Text as T import qualified Data.Text as T
import Language.GraphQL.Error import Language.GraphQL.Error
import Language.GraphQL.Execute import Language.GraphQL.Execute
import Language.GraphQL.Parser import Language.GraphQL.AST.Parser
import qualified Language.GraphQL.Schema as Schema import qualified Language.GraphQL.Schema as Schema
import Text.Megaparsec (parse) import Text.Megaparsec (parse)

77
src/Language/GraphQL/AST.hs
View File

@ -29,16 +29,15 @@ module Language.GraphQL.AST
import Data.Int (Int32) import Data.Int (Int32)
import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text) import Data.Text (Text)
import Language.GraphQL.AST.Core ( Alias
, Name
, TypeCondition
)
-- * Document -- * Document
-- | GraphQL document. -- | GraphQL document.
type Document = NonEmpty Definition type Document = NonEmpty Definition
-- | Name
type Name = Text
-- | Directive. -- | Directive.
data Directive = Directive Name [Argument] deriving (Eq, Show) data Directive = Directive Name [Argument] deriving (Eq, Show)
@ -82,12 +81,56 @@ data Selection
-- * Field -- * 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 data Field
= Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt = Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt
deriving (Eq, Show) 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) data Argument = Argument Name Value deriving (Eq,Show)
-- * Fragments -- * Fragments
@ -107,15 +150,15 @@ data FragmentDefinition
-- * Inputs -- * Inputs
-- | Input value. -- | Input value.
data Value = ValueVariable Name data Value = Variable Name
| ValueInt Int32 | Int Int32
| ValueFloat Double | Float Double
| ValueString Text | String Text
| ValueBoolean Bool | Boolean Bool
| ValueNull | Null
| ValueEnum Name | Enum Name
| ValueList [Value] | List [Value]
| ValueObject [ObjectField] | Object [ObjectField]
deriving (Eq, Show) deriving (Eq, Show)
-- | Key-value pair. -- | Key-value pair.
@ -127,13 +170,15 @@ data ObjectField = ObjectField Name Value deriving (Eq, Show)
data VariableDefinition = VariableDefinition Name Type (Maybe Value) data VariableDefinition = VariableDefinition Name Type (Maybe Value)
deriving (Eq, Show) deriving (Eq, Show)
-- | Type condition.
type TypeCondition = Name
-- | Type representation. -- | Type representation.
data Type = TypeNamed Name data Type = TypeNamed Name
| TypeList Type | TypeList Type
| TypeNonNull NonNullType | TypeNonNull NonNullType
deriving (Eq, Show) deriving (Eq, Show)
-- | Helper type to represent Non-Null types and lists of such types. -- | Helper type to represent Non-Null types and lists of such types.
data NonNullType = NonNullTypeNamed Name data NonNullType = NonNullTypeNamed Name
| NonNullTypeList Type | NonNullTypeList Type

93
src/Language/GraphQL/AST/Core.hs
View File

@ -6,7 +6,6 @@ module Language.GraphQL.AST.Core
, Field(..) , Field(..)
, Fragment(..) , Fragment(..)
, Name , Name
, ObjectField(..)
, Operation(..) , Operation(..)
, Selection(..) , Selection(..)
, TypeCondition , TypeCondition
@ -14,12 +13,11 @@ module Language.GraphQL.AST.Core
) where ) where
import Data.Int (Int32) import Data.Int (Int32)
import Data.HashMap.Strict (HashMap)
import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty (NonEmpty)
import Data.String import Data.String (IsString(..))
import Data.Text (Text) import Data.Text (Text)
import Language.GraphQL.AST (Alias, Name, TypeCondition)
-- | Name
type Name = Text
-- | GraphQL document is a non-empty list of operations. -- | GraphQL document is a non-empty list of operations.
type Document = NonEmpty Operation type Document = NonEmpty Operation
@ -32,80 +30,12 @@ data Operation
| Mutation (Maybe Text) (NonEmpty Selection) | Mutation (Maybe Text) (NonEmpty Selection)
deriving (Eq, Show) deriving (Eq, Show)
-- | A single GraphQL field. -- | 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) 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. -- | 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) 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. -- | Represents fragments and inline fragments.
data Fragment data Fragment
= Fragment TypeCondition (NonEmpty Selection) = Fragment TypeCondition (NonEmpty Selection)
@ -116,3 +46,18 @@ data Selection
= SelectionFragment Fragment = SelectionFragment Fragment
| SelectionField Field | SelectionField Field
deriving (Eq, Show) 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

122
src/Language/GraphQL/Encoder.hs → src/Language/GraphQL/AST/Encoder.hs
View File

@ -2,7 +2,7 @@
{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE ExplicitForAll #-}
-- | This module defines a minifier and a printer for the @GraphQL@ language. -- | This module defines a minifier and a printer for the @GraphQL@ language.
module Language.GraphQL.Encoder module Language.GraphQL.AST.Encoder
( Formatter ( Formatter
, definition , definition
, directive , directive
@ -21,7 +21,7 @@ import qualified Data.Text.Lazy as Text.Lazy
import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy.Builder.Int (decimal) import Data.Text.Lazy.Builder.Int (decimal)
import Data.Text.Lazy.Builder.RealFloat (realFloat) 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 -- | Instructs the encoder whether a GraphQL should be minified or pretty
-- printed. -- printed.
@ -40,7 +40,7 @@ minified :: Formatter
minified = Minified minified = Minified
-- | Converts a 'Document' into a string. -- | Converts a 'Document' into a string.
document :: Formatter -> Document -> Text document :: Formatter -> Full.Document -> Text
document formatter defs document formatter defs
| Pretty _ <- formatter = Text.Lazy.intercalate "\n" encodeDocument | Pretty _ <- formatter = Text.Lazy.intercalate "\n" encodeDocument
| Minified <-formatter = Text.Lazy.snoc (mconcat encodeDocument) '\n' | Minified <-formatter = Text.Lazy.snoc (mconcat encodeDocument) '\n'
@ -48,29 +48,29 @@ document formatter defs
encodeDocument = NonEmpty.toList $ definition formatter <$> defs encodeDocument = NonEmpty.toList $ definition formatter <$> defs
-- | Converts a 'Definition' into a string. -- | Converts a 'Definition' into a string.
definition :: Formatter -> Definition -> Text definition :: Formatter -> Full.Definition -> Text
definition formatter x definition formatter x
| Pretty _ <- formatter = Text.Lazy.snoc (encodeDefinition x) '\n' | Pretty _ <- formatter = Text.Lazy.snoc (encodeDefinition x) '\n'
| Minified <- formatter = encodeDefinition x | Minified <- formatter = encodeDefinition x
where where
encodeDefinition (DefinitionOperation operation) encodeDefinition (Full.DefinitionOperation operation)
= operationDefinition formatter operation = operationDefinition formatter operation
encodeDefinition (DefinitionFragment fragment) encodeDefinition (Full.DefinitionFragment fragment)
= fragmentDefinition formatter fragment = fragmentDefinition formatter fragment
operationDefinition :: Formatter -> OperationDefinition -> Text operationDefinition :: Formatter -> Full.OperationDefinition -> Text
operationDefinition formatter (OperationSelectionSet sels) operationDefinition formatter (Full.OperationSelectionSet sels)
= selectionSet formatter 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 = "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 = "mutation " <> node formatter name vars dirs sels
node :: Formatter node :: Formatter
-> Maybe Name -> Maybe Full.Name
-> [VariableDefinition] -> [Full.VariableDefinition]
-> [Directive] -> [Full.Directive]
-> SelectionSet -> Full.SelectionSet
-> Text -> Text
node formatter name vars dirs sels node formatter name vars dirs sels
= Text.Lazy.fromStrict (fold name) = Text.Lazy.fromStrict (fold name)
@ -79,39 +79,39 @@ node formatter name vars dirs sels
<> eitherFormat formatter " " mempty <> eitherFormat formatter " " mempty
<> selectionSet formatter sels <> selectionSet formatter sels
variableDefinitions :: Formatter -> [VariableDefinition] -> Text variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Text
variableDefinitions formatter variableDefinitions formatter
= parensCommas formatter $ variableDefinition formatter = parensCommas formatter $ variableDefinition formatter
variableDefinition :: Formatter -> VariableDefinition -> Text variableDefinition :: Formatter -> Full.VariableDefinition -> Text
variableDefinition formatter (VariableDefinition var ty dv) variableDefinition formatter (Full.VariableDefinition var ty dv)
= variable var = variable var
<> eitherFormat formatter ": " ":" <> eitherFormat formatter ": " ":"
<> type' ty <> type' ty
<> maybe mempty (defaultValue formatter) dv <> maybe mempty (defaultValue formatter) dv
defaultValue :: Formatter -> Value -> Text defaultValue :: Formatter -> Full.Value -> Text
defaultValue formatter val defaultValue formatter val
= eitherFormat formatter " = " "=" = eitherFormat formatter " = " "="
<> value formatter val <> value formatter val
variable :: Name -> Text variable :: Full.Name -> Text
variable var = "$" <> Text.Lazy.fromStrict var variable var = "$" <> Text.Lazy.fromStrict var
selectionSet :: Formatter -> SelectionSet -> Text selectionSet :: Formatter -> Full.SelectionSet -> Text
selectionSet formatter selectionSet formatter
= bracesList formatter (selection formatter) = bracesList formatter (selection formatter)
. NonEmpty.toList . NonEmpty.toList
selectionSetOpt :: Formatter -> SelectionSetOpt -> Text selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Text
selectionSetOpt formatter = bracesList formatter $ selection formatter selectionSetOpt formatter = bracesList formatter $ selection formatter
selection :: Formatter -> Selection -> Text selection :: Formatter -> Full.Selection -> Text
selection formatter = Text.Lazy.append indent . f selection formatter = Text.Lazy.append indent . f
where where
f (SelectionField x) = field incrementIndent x f (Full.SelectionField x) = field incrementIndent x
f (SelectionInlineFragment x) = inlineFragment incrementIndent x f (Full.SelectionInlineFragment x) = inlineFragment incrementIndent x
f (SelectionFragmentSpread x) = fragmentSpread incrementIndent x f (Full.SelectionFragmentSpread x) = fragmentSpread incrementIndent x
incrementIndent incrementIndent
| Pretty n <- formatter = Pretty $ n + 1 | Pretty n <- formatter = Pretty $ n + 1
| otherwise = Minified | otherwise = Minified
@ -119,8 +119,8 @@ selection formatter = Text.Lazy.append indent . f
| Pretty n <- formatter = Text.Lazy.replicate (fromIntegral $ n + 1) " " | Pretty n <- formatter = Text.Lazy.replicate (fromIntegral $ n + 1) " "
| otherwise = mempty | otherwise = mempty
field :: Formatter -> Field -> Text field :: Formatter -> Full.Field -> Text
field formatter (Field alias name args dirs selso) field formatter (Full.Field alias name args dirs selso)
= optempty (`Text.Lazy.append` colon) (Text.Lazy.fromStrict $ fold alias) = optempty (`Text.Lazy.append` colon) (Text.Lazy.fromStrict $ fold alias)
<> Text.Lazy.fromStrict name <> Text.Lazy.fromStrict name
<> optempty (arguments formatter) args <> optempty (arguments formatter) args
@ -132,31 +132,31 @@ field formatter (Field alias name args dirs selso)
| null selso = mempty | null selso = mempty
| otherwise = eitherFormat formatter " " mempty <> selectionSetOpt formatter selso | otherwise = eitherFormat formatter " " mempty <> selectionSetOpt formatter selso
arguments :: Formatter -> [Argument] -> Text arguments :: Formatter -> [Full.Argument] -> Text
arguments formatter = parensCommas formatter $ argument formatter arguments formatter = parensCommas formatter $ argument formatter
argument :: Formatter -> Argument -> Text argument :: Formatter -> Full.Argument -> Text
argument formatter (Argument name v) argument formatter (Full.Argument name v)
= Text.Lazy.fromStrict name = Text.Lazy.fromStrict name
<> eitherFormat formatter ": " ":" <> eitherFormat formatter ": " ":"
<> value formatter v <> value formatter v
-- * Fragments -- * Fragments
fragmentSpread :: Formatter -> FragmentSpread -> Text fragmentSpread :: Formatter -> Full.FragmentSpread -> Text
fragmentSpread formatter (FragmentSpread name ds) fragmentSpread formatter (Full.FragmentSpread name ds)
= "..." <> Text.Lazy.fromStrict name <> optempty (directives formatter) ds = "..." <> Text.Lazy.fromStrict name <> optempty (directives formatter) ds
inlineFragment :: Formatter -> InlineFragment -> Text inlineFragment :: Formatter -> Full.InlineFragment -> Text
inlineFragment formatter (InlineFragment tc dirs sels) inlineFragment formatter (Full.InlineFragment tc dirs sels)
= "... on " = "... on "
<> Text.Lazy.fromStrict (fold tc) <> Text.Lazy.fromStrict (fold tc)
<> directives formatter dirs <> directives formatter dirs
<> eitherFormat formatter " " mempty <> eitherFormat formatter " " mempty
<> selectionSet formatter sels <> selectionSet formatter sels
fragmentDefinition :: Formatter -> FragmentDefinition -> Text fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Text
fragmentDefinition formatter (FragmentDefinition name tc dirs sels) fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
= "fragment " <> Text.Lazy.fromStrict name = "fragment " <> Text.Lazy.fromStrict name
<> " on " <> Text.Lazy.fromStrict tc <> " on " <> Text.Lazy.fromStrict tc
<> optempty (directives formatter) dirs <> optempty (directives formatter) dirs
@ -166,25 +166,25 @@ fragmentDefinition formatter (FragmentDefinition name tc dirs sels)
-- * Miscellaneous -- * Miscellaneous
-- | Converts a 'Directive' into a string. -- | Converts a 'Directive' into a string.
directive :: Formatter -> Directive -> Text directive :: Formatter -> Full.Directive -> Text
directive formatter (Directive name args) directive formatter (Full.Directive name args)
= "@" <> Text.Lazy.fromStrict name <> optempty (arguments formatter) 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 formatter@(Pretty _) = Text.Lazy.cons ' ' . spaces (directive formatter)
directives Minified = spaces (directive Minified) directives Minified = spaces (directive Minified)
-- | Converts a 'Value' into a string. -- | Converts a 'Value' into a string.
value :: Formatter -> Value -> Text value :: Formatter -> Full.Value -> Text
value _ (ValueVariable x) = variable x value _ (Full.Variable x) = variable x
value _ (ValueInt x) = toLazyText $ decimal x value _ (Full.Int x) = toLazyText $ decimal x
value _ (ValueFloat x) = toLazyText $ realFloat x value _ (Full.Float x) = toLazyText $ realFloat x
value _ (ValueBoolean x) = booleanValue x value _ (Full.Boolean x) = booleanValue x
value _ ValueNull = mempty value _ Full.Null = mempty
value _ (ValueString x) = stringValue $ Text.Lazy.fromStrict x value _ (Full.String x) = stringValue $ Text.Lazy.fromStrict x
value _ (ValueEnum x) = Text.Lazy.fromStrict x value _ (Full.Enum x) = Text.Lazy.fromStrict x
value formatter (ValueList x) = listValue formatter x value formatter (Full.List x) = listValue formatter x
value formatter (ValueObject x) = objectValue formatter x value formatter (Full.Object x) = objectValue formatter x
booleanValue :: Bool -> Text booleanValue :: Bool -> Text
booleanValue True = "true" booleanValue True = "true"
@ -196,10 +196,10 @@ stringValue
. Text.Lazy.replace "\"" "\\\"" . Text.Lazy.replace "\"" "\\\""
. Text.Lazy.replace "\\" "\\\\" . Text.Lazy.replace "\\" "\\\\"
listValue :: Formatter -> [Value] -> Text listValue :: Formatter -> [Full.Value] -> Text
listValue formatter = bracketsCommas formatter $ value formatter listValue formatter = bracketsCommas formatter $ value formatter
objectValue :: Formatter -> [ObjectField] -> Text objectValue :: Formatter -> [Full.ObjectField] -> Text
objectValue formatter = intercalate $ objectField formatter objectValue formatter = intercalate $ objectField formatter
where where
intercalate f intercalate f
@ -208,8 +208,8 @@ objectValue formatter = intercalate $ objectField formatter
. fmap f . fmap f
objectField :: Formatter -> ObjectField -> Text objectField :: Formatter -> Full.ObjectField -> Text
objectField formatter (ObjectField name v) objectField formatter (Full.ObjectField name v)
= Text.Lazy.fromStrict name <> colon <> value formatter v = Text.Lazy.fromStrict name <> colon <> value formatter v
where where
colon colon
@ -217,17 +217,17 @@ objectField formatter (ObjectField name v)
| Minified <- formatter = ":" | Minified <- formatter = ":"
-- | Converts a 'Type' a type into a string. -- | Converts a 'Type' a type into a string.
type' :: Type -> Text type' :: Full.Type -> Text
type' (TypeNamed x) = Text.Lazy.fromStrict x type' (Full.TypeNamed x) = Text.Lazy.fromStrict x
type' (TypeList x) = listType x type' (Full.TypeList x) = listType x
type' (TypeNonNull x) = nonNullType x type' (Full.TypeNonNull x) = nonNullType x
listType :: Type -> Text listType :: Full.Type -> Text
listType x = brackets (type' x) listType x = brackets (type' x)
nonNullType :: NonNullType -> Text nonNullType :: Full.NonNullType -> Text
nonNullType (NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!" nonNullType (Full.NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!"
nonNullType (NonNullTypeList x) = listType x <> "!" nonNullType (Full.NonNullTypeList x) = listType x <> "!"
-- * Internal -- * Internal

2
src/Language/GraphQL/Lexer.hs → src/Language/GraphQL/AST/Lexer.hs
View File

@ -3,7 +3,7 @@
-- | This module defines a bunch of small parsers used to parse individual -- | This module defines a bunch of small parsers used to parse individual
-- lexemes. -- lexemes.
module Language.GraphQL.Lexer module Language.GraphQL.AST.Lexer
( Parser ( Parser
, amp , amp
, at , at

24
src/Language/GraphQL/Parser.hs → src/Language/GraphQL/AST/Parser.hs
View File

@ -2,7 +2,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-- | @GraphQL@ document parser. -- | @GraphQL@ document parser.
module Language.GraphQL.Parser module Language.GraphQL.AST.Parser
( document ( document
) where ) where
@ -11,7 +11,7 @@ import Control.Applicative ( Alternative(..)
) )
import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty (NonEmpty(..))
import Language.GraphQL.AST import Language.GraphQL.AST
import Language.GraphQL.Lexer import Language.GraphQL.AST.Lexer
import Text.Megaparsec ( lookAhead import Text.Megaparsec ( lookAhead
, option , option
, try , try
@ -105,16 +105,16 @@ typeCondition = symbol "on" *> name
-- * Input Values -- * Input Values
value :: Parser Value value :: Parser Value
value = ValueVariable <$> variable value = Variable <$> variable
<|> ValueFloat <$> try float <|> Float <$> try float
<|> ValueInt <$> integer <|> Int <$> integer
<|> ValueBoolean <$> booleanValue <|> Boolean <$> booleanValue
<|> ValueNull <$ symbol "null" <|> Null <$ symbol "null"
<|> ValueString <$> blockString <|> String <$> blockString
<|> ValueString <$> string <|> String <$> string
<|> ValueEnum <$> try enumValue <|> Enum <$> try enumValue
<|> ValueList <$> listValue <|> List <$> listValue
<|> ValueObject <$> objectValue <|> Object <$> objectValue
<?> "value error!" <?> "value error!"
where where
booleanValue :: Parser Bool booleanValue :: Parser Bool

28
src/Language/GraphQL/AST/Transform.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE TupleSections #-}
-- | After the document is parsed, before getting executed the AST is -- | After the document is parsed, before getting executed the AST is
-- transformed into a similar, simpler AST. This module is responsible for -- transformed into a similar, simpler AST. This module is responsible for
-- this transformation. -- 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 argument subs (Full.Argument n v) = Core.Argument n <$> value subs v
value :: Schema.Subs -> Full.Value -> Maybe Core.Value value :: Schema.Subs -> Full.Value -> Maybe Core.Value
value subs (Full.ValueVariable n) = subs n value subs (Full.Variable n) = subs n
value _ (Full.ValueInt i) = pure $ Core.ValueInt i value _ (Full.Int i) = pure $ Core.Int i
value _ (Full.ValueFloat f) = pure $ Core.ValueFloat f value _ (Full.Float f) = pure $ Core.Float f
value _ (Full.ValueString x) = pure $ Core.ValueString x value _ (Full.String x) = pure $ Core.String x
value _ (Full.ValueBoolean b) = pure $ Core.ValueBoolean b value _ (Full.Boolean b) = pure $ Core.Boolean b
value _ Full.ValueNull = pure Core.ValueNull value _ Full.Null = pure Core.Null
value _ (Full.ValueEnum e) = pure $ Core.ValueEnum e value _ (Full.Enum e) = pure $ Core.Enum e
value subs (Full.ValueList l) = value subs (Full.List l) =
Core.ValueList <$> traverse (value subs) l Core.List <$> traverse (value subs) l
value subs (Full.ValueObject o) = value subs (Full.Object o) =
Core.ValueObject <$> traverse (objectField subs) o Core.Object . HashMap.fromList <$> traverse (objectField subs) o
objectField :: Schema.Subs -> Full.ObjectField -> Maybe Core.ObjectField objectField :: Schema.Subs -> Full.ObjectField -> Maybe (Core.Name, Core.Value)
objectField subs (Full.ObjectField n v) = Core.ObjectField n <$> value subs v objectField subs (Full.ObjectField n v) = (n,) <$> value subs v
appendSelectionOpt :: appendSelectionOpt ::
Traversable t => Traversable t =>

20
src/Language/GraphQL/Schema.hs
View File

@ -30,10 +30,10 @@ import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Language.GraphQL.AST.Core
import Language.GraphQL.Error import Language.GraphQL.Error
import Language.GraphQL.Trans import Language.GraphQL.Trans
import Language.GraphQL.Type import qualified Language.GraphQL.Type as Type
import Language.GraphQL.AST.Core
-- | Resolves a 'Field' into an @Aeson.@'Data.Aeson.Types.Object' with error -- | 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 -- 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. -- | Like 'object' but also taking 'Argument's and can be null or a list of objects.
wrappedObjectA :: MonadIO m 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 wrappedObjectA name f = Resolver name $ resolveFieldValue f resolveRight
where where
resolveRight fld@(Field _ _ _ sels) resolver 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. -- | Like 'object' but can be null or a list of objects.
wrappedObject :: MonadIO m 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 wrappedObject name = wrappedObjectA name . const
-- | A scalar represents a primitive value, like a string or an integer. -- | 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 where
resolveRight fld result = withField (return result) fld 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) 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 wrappedScalarA name f = Resolver name $ resolveFieldValue f resolveRight
where where
resolveRight fld (Named result) = withField (return result) fld resolveRight fld (Type.Named result) = withField (return result) fld
resolveRight fld Null resolveRight fld Type.Null
= return $ HashMap.singleton (aliasOrName fld) Aeson.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. -- | Like 'scalar' but can be null or a list of scalars.
wrappedScalar :: (MonadIO m, Aeson.ToJSON a) 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 wrappedScalar name = wrappedScalarA name . const
resolveFieldValue :: MonadIO m resolveFieldValue :: MonadIO m

6
src/Language/GraphQL/Type.hs
View File

@ -1,11 +1,9 @@
-- | Definitions for @GraphQL@ type system. -- | Definitions for @GraphQL@ input types.
module Language.GraphQL.Type module Language.GraphQL.Type
( Wrapping(..) ( Wrapping(..)
) where ) where
import Data.Aeson as Aeson ( ToJSON import Data.Aeson as Aeson (ToJSON, toJSON)
, toJSON
)
import qualified Data.Aeson as Aeson import qualified Data.Aeson as Aeson
-- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping -- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping

19
tests/Language/GraphQL/AST/EncoderSpec.hs Normal file
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` "\"\\\"\""

4
tests/Language/GraphQL/LexerSpec.hs → tests/Language/GraphQL/AST/LexerSpec.hs
View File

@ -1,12 +1,12 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.LexerSpec module Language.GraphQL.AST.LexerSpec
( spec ( spec
) where ) where
import Data.Text (Text) import Data.Text (Text)
import Data.Void (Void) import Data.Void (Void)
import Language.GraphQL.Lexer import Language.GraphQL.AST.Lexer
import Test.Hspec (Spec, context, describe, it) import Test.Hspec (Spec, context, describe, it)
import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn) import Test.Hspec.Megaparsec (shouldParse, shouldSucceedOn)
import Text.Megaparsec (ParseErrorBundle, parse) import Text.Megaparsec (ParseErrorBundle, parse)

4
tests/Language/GraphQL/ParserSpec.hs → tests/Language/GraphQL/AST/ParserSpec.hs
View File

@ -1,10 +1,10 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.ParserSpec module Language.GraphQL.AST.ParserSpec
( spec ( spec
) where ) where
import Language.GraphQL.Parser (document) import Language.GraphQL.AST.Parser
import Test.Hspec (Spec, describe, it) import Test.Hspec (Spec, describe, it)
import Test.Hspec.Megaparsec (shouldSucceedOn) import Test.Hspec.Megaparsec (shouldSucceedOn)
import Text.Megaparsec (parse) import Text.Megaparsec (parse)

21
tests/Language/GraphQL/EncoderSpec.hs
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` "\"\\\"\""

4
tests/Test/KitchenSinkSpec.hs
View File

@ -7,8 +7,8 @@ module Test.KitchenSinkSpec
import qualified Data.Text.IO as Text.IO import qualified Data.Text.IO as Text.IO
import qualified Data.Text.Lazy.IO as Text.Lazy.IO import qualified Data.Text.Lazy.IO as Text.Lazy.IO
import qualified Data.Text.Lazy as Lazy (Text) import qualified Data.Text.Lazy as Lazy (Text)
import qualified Language.GraphQL.Encoder as Encoder import qualified Language.GraphQL.AST.Encoder as Encoder
import qualified Language.GraphQL.Parser as Parser import qualified Language.GraphQL.AST.Parser as Parser
import Paths_graphql (getDataFileName) import Paths_graphql (getDataFileName)
import Test.Hspec (Spec, describe, it) import Test.Hspec (Spec, describe, it)
import Test.Hspec.Megaparsec (parseSatisfies) import Test.Hspec.Megaparsec (parseSatisfies)

10
tests/Test/StarWars/Data.hs
View File

@ -26,7 +26,7 @@ import Control.Monad.Trans.Except (throwE)
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Text (Text) import Data.Text (Text)
import Language.GraphQL.Trans import Language.GraphQL.Trans
import Language.GraphQL.Type import qualified Language.GraphQL.Type as Type
-- * Data -- * Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
@ -191,8 +191,8 @@ getDroid' _ = empty
getFriends :: Character -> [Character] getFriends :: Character -> [Character]
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
getEpisode :: Int -> Maybe (Wrapping Text) getEpisode :: Int -> Maybe (Type.Wrapping Text)
getEpisode 4 = pure $ Named "NEWHOPE" getEpisode 4 = pure $ Type.Named "NEWHOPE"
getEpisode 5 = pure $ Named "EMPIRE" getEpisode 5 = pure $ Type.Named "EMPIRE"
getEpisode 6 = pure $ Named "JEDI" getEpisode 6 = pure $ Type.Named "JEDI"
getEpisode _ = empty getEpisode _ = empty

20
tests/Test/StarWars/Schema.hs
View File

@ -15,7 +15,7 @@ import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import qualified Language.GraphQL.Schema as Schema import qualified Language.GraphQL.Schema as Schema
import Language.GraphQL.Trans import Language.GraphQL.Trans
import Language.GraphQL.Type import qualified Language.GraphQL.Type as Type
import Test.StarWars.Data import Test.StarWars.Data
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js -- 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 :: MonadIO m => Schema.Resolver m
hero = Schema.objectA "hero" $ \case hero = Schema.objectA "hero" $ \case
[] -> character artoo [] -> character artoo
[Schema.Argument "episode" (Schema.ValueEnum "NEWHOPE")] -> character $ getHero 4 [Schema.Argument "episode" (Schema.Enum "NEWHOPE")] -> character $ getHero 4
[Schema.Argument "episode" (Schema.ValueEnum "EMPIRE" )] -> character $ getHero 5 [Schema.Argument "episode" (Schema.Enum "EMPIRE" )] -> character $ getHero 5
[Schema.Argument "episode" (Schema.ValueEnum "JEDI" )] -> character $ getHero 6 [Schema.Argument "episode" (Schema.Enum "JEDI" )] -> character $ getHero 6
_ -> ActionT $ throwE "Invalid arguments." _ -> ActionT $ throwE "Invalid arguments."
human :: MonadIO m => Schema.Resolver m human :: MonadIO m => Schema.Resolver m
human = Schema.wrappedObjectA "human" $ \case 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 humanCharacter <- lift $ return $ getHuman i >>= Just
case humanCharacter of case humanCharacter of
Nothing -> return Null Nothing -> return Type.Null
Just e -> Named <$> character e Just e -> Type.Named <$> character e
_ -> ActionT $ throwE "Invalid arguments." _ -> ActionT $ throwE "Invalid arguments."
droid :: MonadIO m => Schema.Resolver m droid :: MonadIO m => Schema.Resolver m
droid = Schema.objectA "droid" $ \case 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." _ -> ActionT $ throwE "Invalid arguments."
character :: MonadIO m => Character -> ActionT m [Schema.Resolver m] character :: MonadIO m => Character -> ActionT m [Schema.Resolver m]
@ -50,8 +50,8 @@ character char = return
[ Schema.scalar "id" $ return $ id_ char [ Schema.scalar "id" $ return $ id_ char
, Schema.scalar "name" $ return $ name char , Schema.scalar "name" $ return $ name char
, Schema.wrappedObject "friends" , Schema.wrappedObject "friends"
$ traverse character $ List $ Named <$> getFriends char $ traverse character $ Type.List $ Type.Named <$> getFriends char
, Schema.wrappedScalar "appearsIn" $ return . List , Schema.wrappedScalar "appearsIn" $ return . Type.List
$ catMaybes (getEpisode <$> appearsIn char) $ catMaybes (getEpisode <$> appearsIn char)
, Schema.scalar "secretBackstory" $ secretBackstory char , Schema.scalar "secretBackstory" $ secretBackstory char
, Schema.scalar "homePlanet" $ return $ either mempty homePlanet char , Schema.scalar "homePlanet" $ return $ either mempty homePlanet char