Compare commits
15 Commits
Author | SHA1 | Date |
---|---|---|
Danny Navarro | 6ce2004264 | |
Danny Navarro | af42e5577c | |
Danny Navarro | a4db99ea5d | |
Danny Navarro | 06b3302862 | |
Danny Navarro | 4508364266 | |
Danny Navarro | 99b4d86702 | |
Danny Navarro | da97387042 | |
Danny Navarro | e74ee640a8 | |
Danny Navarro | 3d97b3e2ff | |
Danny Navarro | 88ca3d1866 | |
Danny Navarro | 899fa1b531 | |
Danny Navarro | cb9977141d | |
Danny Navarro | 4f4e31805a | |
Danny Navarro | d88acf3d0e | |
Danny Navarro | c9c1137ceb |
15
CHANGELOG.md
15
CHANGELOG.md
|
@ -1,6 +1,20 @@
|
|||
# Change Log
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## [0.3] - 2015-09-22
|
||||
### Changed
|
||||
- Exact match numeric types to spec.
|
||||
- Names follow now the spec.
|
||||
- AST slightly different for better readability or easier parsing.
|
||||
- Replace golden test for test to validate parsing/encoding.
|
||||
|
||||
### Added
|
||||
- Parsing errors in all cases where `Alternative` is used.
|
||||
- GraphQL encoder.
|
||||
|
||||
### Fixed
|
||||
- Expect braces `inputValueDefinitions` instead of parens when parsing.
|
||||
|
||||
## [0.2.1] - 2015-09-16
|
||||
### Fixed
|
||||
- Include data files for golden tests in Cabal package.
|
||||
|
@ -19,5 +33,6 @@ All notable changes to this project will be documented in this file.
|
|||
### Added
|
||||
- Data types for the GraphQL language.
|
||||
|
||||
[0.3]: https://github.com/jdnavarro/graphql-haskell/compare/v0.2.1...v0.3
|
||||
[0.2.1]: https://github.com/jdnavarro/graphql-haskell/compare/v0.2...v0.2.1
|
||||
[0.2]: https://github.com/jdnavarro/graphql-haskell/compare/v0.1...v0.2
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
module Data.GraphQL.AST where
|
||||
|
||||
import Data.Int (Int32)
|
||||
import Data.Text (Text)
|
||||
|
||||
-- * Name
|
||||
|
@ -15,12 +16,12 @@ data Definition = DefinitionOperation OperationDefinition
|
|||
| DefinitionType TypeDefinition
|
||||
deriving (Eq,Show)
|
||||
|
||||
data OperationDefinition =
|
||||
Query Name [VariableDefinition] [Directive] SelectionSet
|
||||
| Mutation Name [VariableDefinition] [Directive] SelectionSet
|
||||
-- Not official yet
|
||||
-- -- | Subscription Name [VariableDefinition] [Directive] SelectionSet
|
||||
deriving (Eq,Show)
|
||||
data OperationDefinition = Query Node
|
||||
| Mutation Node
|
||||
deriving (Eq,Show)
|
||||
|
||||
data Node = Node Name [VariableDefinition] [Directive] SelectionSet
|
||||
deriving (Eq,Show)
|
||||
|
||||
data VariableDefinition = VariableDefinition Variable Type (Maybe DefaultValue)
|
||||
deriving (Eq,Show)
|
||||
|
@ -61,15 +62,18 @@ type TypeCondition = NamedType
|
|||
-- * Values
|
||||
|
||||
data Value = ValueVariable Variable
|
||||
| ValueInt Int -- TODO: Should this be `Integer`?
|
||||
| ValueFloat Double -- TODO: Should this be `Scientific`?
|
||||
| ValueInt Int32
|
||||
-- GraphQL Float is double precison
|
||||
| ValueFloat Double
|
||||
| ValueBoolean Bool
|
||||
| ValueString Text
|
||||
| ValueString StringValue
|
||||
| ValueEnum Name
|
||||
| ValueList ListValue
|
||||
| ValueObject ObjectValue
|
||||
deriving (Eq,Show)
|
||||
|
||||
newtype StringValue = StringValue Text deriving (Eq,Show)
|
||||
|
||||
newtype ListValue = ListValue [Value] deriving (Eq,Show)
|
||||
|
||||
newtype ObjectValue = ObjectValue [ObjectField] deriving (Eq,Show)
|
||||
|
|
|
@ -0,0 +1,246 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Data.GraphQL.Encoder where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>))
|
||||
import Data.Monoid (Monoid, mconcat, mempty)
|
||||
#endif
|
||||
import Data.Monoid ((<>))
|
||||
|
||||
import Data.Text (Text, cons, intercalate, pack, snoc)
|
||||
|
||||
import Data.GraphQL.AST
|
||||
|
||||
-- * Document
|
||||
|
||||
-- TODO: Use query shorthand
|
||||
document :: Document -> Text
|
||||
document (Document defs) = (`snoc` '\n') . mconcat $ definition <$> defs
|
||||
|
||||
definition :: Definition -> Text
|
||||
definition (DefinitionOperation x) = operationDefinition x
|
||||
definition (DefinitionFragment x) = fragmentDefinition x
|
||||
definition (DefinitionType x) = typeDefinition x
|
||||
|
||||
operationDefinition :: OperationDefinition -> Text
|
||||
operationDefinition (Query n) = "query " <> node n
|
||||
operationDefinition (Mutation n) = "mutation " <> node n
|
||||
|
||||
node :: Node -> Text
|
||||
node (Node name vds ds ss) =
|
||||
name
|
||||
<> optempty variableDefinitions vds
|
||||
<> optempty directives ds
|
||||
<> selectionSet ss
|
||||
|
||||
variableDefinitions :: [VariableDefinition] -> Text
|
||||
variableDefinitions = parensCommas variableDefinition
|
||||
|
||||
variableDefinition :: VariableDefinition -> Text
|
||||
variableDefinition (VariableDefinition var ty dv) =
|
||||
variable var <> ":" <> type_ ty <> maybe mempty defaultValue dv
|
||||
|
||||
defaultValue :: DefaultValue -> Text
|
||||
defaultValue val = "=" <> value val
|
||||
|
||||
variable :: Variable -> Text
|
||||
variable (Variable name) = "$" <> name
|
||||
|
||||
selectionSet :: SelectionSet -> Text
|
||||
selectionSet = bracesCommas selection
|
||||
|
||||
selection :: Selection -> Text
|
||||
selection (SelectionField x) = field x
|
||||
selection (SelectionInlineFragment x) = inlineFragment x
|
||||
selection (SelectionFragmentSpread x) = fragmentSpread x
|
||||
|
||||
field :: Field -> Text
|
||||
field (Field alias name args ds ss) =
|
||||
optempty (`snoc` ':') alias
|
||||
<> name
|
||||
<> optempty arguments args
|
||||
<> optempty directives ds
|
||||
<> optempty selectionSet ss
|
||||
|
||||
arguments :: [Argument] -> Text
|
||||
arguments = parensCommas argument
|
||||
|
||||
argument :: Argument -> Text
|
||||
argument (Argument name v) = name <> ":" <> value v
|
||||
|
||||
-- * Fragments
|
||||
|
||||
fragmentSpread :: FragmentSpread -> Text
|
||||
fragmentSpread (FragmentSpread name ds) =
|
||||
"..." <> name <> optempty directives ds
|
||||
|
||||
inlineFragment :: InlineFragment -> Text
|
||||
inlineFragment (InlineFragment (NamedType tc) ds ss) =
|
||||
"... on " <> tc
|
||||
<> optempty directives ds
|
||||
<> optempty selectionSet ss
|
||||
|
||||
fragmentDefinition :: FragmentDefinition -> Text
|
||||
fragmentDefinition (FragmentDefinition name (NamedType tc) ds ss) =
|
||||
"fragment " <> name <> " on " <> tc
|
||||
<> optempty directives ds
|
||||
<> selectionSet ss
|
||||
|
||||
-- * Values
|
||||
|
||||
value :: Value -> Text
|
||||
value (ValueVariable x) = variable x
|
||||
-- TODO: This will be replaced with `decimal` Buidler
|
||||
value (ValueInt x) = pack $ show x
|
||||
-- TODO: This will be replaced with `decimal` Buidler
|
||||
value (ValueFloat x) = pack $ show x
|
||||
value (ValueBoolean x) = booleanValue x
|
||||
value (ValueString x) = stringValue x
|
||||
value (ValueEnum x) = x
|
||||
value (ValueList x) = listValue x
|
||||
value (ValueObject x) = objectValue x
|
||||
|
||||
booleanValue :: Bool -> Text
|
||||
booleanValue True = "true"
|
||||
booleanValue False = "false"
|
||||
|
||||
-- TODO: Escape characters
|
||||
stringValue :: StringValue -> Text
|
||||
stringValue (StringValue v) = quotes v
|
||||
|
||||
listValue :: ListValue -> Text
|
||||
listValue (ListValue vs) = bracketsCommas value vs
|
||||
|
||||
objectValue :: ObjectValue -> Text
|
||||
objectValue (ObjectValue ofs) = bracesCommas objectField ofs
|
||||
|
||||
objectField :: ObjectField -> Text
|
||||
objectField (ObjectField name v) = name <> ":" <> value v
|
||||
|
||||
-- * Directives
|
||||
|
||||
directives :: [Directive] -> Text
|
||||
directives = spaces directive
|
||||
|
||||
directive :: Directive -> Text
|
||||
directive (Directive name args) = "@" <> name <> optempty arguments args
|
||||
|
||||
-- * Type Reference
|
||||
|
||||
type_ :: Type -> Text
|
||||
type_ (TypeNamed (NamedType x)) = x
|
||||
type_ (TypeList x) = listType x
|
||||
type_ (TypeNonNull x) = nonNullType x
|
||||
|
||||
namedType :: NamedType -> Text
|
||||
namedType (NamedType name) = name
|
||||
|
||||
listType :: ListType -> Text
|
||||
listType (ListType ty) = brackets (type_ ty)
|
||||
|
||||
nonNullType :: NonNullType -> Text
|
||||
nonNullType (NonNullTypeNamed (NamedType x)) = x <> "!"
|
||||
nonNullType (NonNullTypeList x) = listType x <> "!"
|
||||
|
||||
typeDefinition :: TypeDefinition -> Text
|
||||
typeDefinition (TypeDefinitionObject x) = objectTypeDefinition x
|
||||
typeDefinition (TypeDefinitionInterface x) = interfaceTypeDefinition x
|
||||
typeDefinition (TypeDefinitionUnion x) = unionTypeDefinition x
|
||||
typeDefinition (TypeDefinitionScalar x) = scalarTypeDefinition x
|
||||
typeDefinition (TypeDefinitionEnum x) = enumTypeDefinition x
|
||||
typeDefinition (TypeDefinitionInputObject x) = inputObjectTypeDefinition x
|
||||
typeDefinition (TypeDefinitionTypeExtension x) = typeExtensionDefinition x
|
||||
|
||||
objectTypeDefinition :: ObjectTypeDefinition -> Text
|
||||
objectTypeDefinition (ObjectTypeDefinition name ifaces fds) =
|
||||
"type " <> name
|
||||
<> optempty (spaced . interfaces) ifaces
|
||||
<> optempty fieldDefinitions fds
|
||||
|
||||
interfaces :: Interfaces -> Text
|
||||
interfaces = ("implements " <>) . spaces namedType
|
||||
|
||||
fieldDefinitions :: [FieldDefinition] -> Text
|
||||
fieldDefinitions = bracesCommas fieldDefinition
|
||||
|
||||
fieldDefinition :: FieldDefinition -> Text
|
||||
fieldDefinition (FieldDefinition name args ty) =
|
||||
name <> optempty argumentsDefinition args
|
||||
<> ":"
|
||||
<> type_ ty
|
||||
|
||||
argumentsDefinition :: ArgumentsDefinition -> Text
|
||||
argumentsDefinition = parensCommas inputValueDefinition
|
||||
|
||||
interfaceTypeDefinition :: InterfaceTypeDefinition -> Text
|
||||
interfaceTypeDefinition (InterfaceTypeDefinition name fds) =
|
||||
"interface " <> name <> fieldDefinitions fds
|
||||
|
||||
unionTypeDefinition :: UnionTypeDefinition -> Text
|
||||
unionTypeDefinition (UnionTypeDefinition name ums) =
|
||||
"union " <> name <> "=" <> unionMembers ums
|
||||
|
||||
unionMembers :: [NamedType] -> Text
|
||||
unionMembers = intercalate "|" . fmap namedType
|
||||
|
||||
scalarTypeDefinition :: ScalarTypeDefinition -> Text
|
||||
scalarTypeDefinition (ScalarTypeDefinition name) = "scalar " <> name
|
||||
|
||||
enumTypeDefinition :: EnumTypeDefinition -> Text
|
||||
enumTypeDefinition (EnumTypeDefinition name evds) =
|
||||
"enum " <> name
|
||||
<> bracesCommas enumValueDefinition evds
|
||||
|
||||
enumValueDefinition :: EnumValueDefinition -> Text
|
||||
enumValueDefinition (EnumValueDefinition name) = name
|
||||
|
||||
inputObjectTypeDefinition :: InputObjectTypeDefinition -> Text
|
||||
inputObjectTypeDefinition (InputObjectTypeDefinition name ivds) =
|
||||
"input " <> name <> inputValueDefinitions ivds
|
||||
|
||||
inputValueDefinitions :: [InputValueDefinition] -> Text
|
||||
inputValueDefinitions = bracesCommas inputValueDefinition
|
||||
|
||||
inputValueDefinition :: InputValueDefinition -> Text
|
||||
inputValueDefinition (InputValueDefinition name ty dv) =
|
||||
name <> ":" <> type_ ty <> maybe mempty defaultValue dv
|
||||
|
||||
typeExtensionDefinition :: TypeExtensionDefinition -> Text
|
||||
typeExtensionDefinition (TypeExtensionDefinition otd) =
|
||||
"extend " <> objectTypeDefinition otd
|
||||
|
||||
-- * Internal
|
||||
|
||||
spaced :: Text -> Text
|
||||
spaced = cons '\SP'
|
||||
|
||||
between :: Char -> Char -> Text -> Text
|
||||
between open close = cons open . (`snoc` close)
|
||||
|
||||
parens :: Text -> Text
|
||||
parens = between '(' ')'
|
||||
|
||||
brackets :: Text -> Text
|
||||
brackets = between '[' ']'
|
||||
|
||||
braces :: Text -> Text
|
||||
braces = between '{' '}'
|
||||
|
||||
quotes :: Text -> Text
|
||||
quotes = between '"' '"'
|
||||
|
||||
spaces :: (a -> Text) -> [a] -> Text
|
||||
spaces f = intercalate "\SP" . fmap f
|
||||
|
||||
parensCommas :: (a -> Text) -> [a] -> Text
|
||||
parensCommas f = parens . intercalate "," . fmap f
|
||||
|
||||
bracketsCommas :: (a -> Text) -> [a] -> Text
|
||||
bracketsCommas f = brackets . intercalate "," . fmap f
|
||||
|
||||
bracesCommas :: (a -> Text) -> [a] -> Text
|
||||
bracesCommas f = braces . intercalate "," . fmap f
|
||||
|
||||
optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
|
||||
optempty f xs = if xs == mempty then mempty else f xs
|
|
@ -1,6 +1,5 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
module Data.GraphQL.Parser where
|
||||
|
||||
import Prelude hiding (takeWhile)
|
||||
|
@ -11,8 +10,10 @@ import Data.Monoid (Monoid, mempty)
|
|||
#endif
|
||||
import Control.Applicative ((<|>), empty, many, optional)
|
||||
import Control.Monad (when)
|
||||
import Data.Char
|
||||
import Data.Text (Text, pack)
|
||||
import Data.Char (isDigit, isSpace)
|
||||
import Data.Foldable (traverse_)
|
||||
|
||||
import Data.Text (Text, append)
|
||||
import Data.Attoparsec.Text
|
||||
( Parser
|
||||
, (<?>)
|
||||
|
@ -20,25 +21,27 @@ import Data.Attoparsec.Text
|
|||
, decimal
|
||||
, double
|
||||
, endOfLine
|
||||
, inClass
|
||||
, many1
|
||||
, manyTill
|
||||
, option
|
||||
, peekChar
|
||||
, satisfy
|
||||
, sepBy1
|
||||
, signed
|
||||
, takeWhile
|
||||
, takeWhile1
|
||||
)
|
||||
|
||||
import Data.GraphQL.AST
|
||||
|
||||
-- * Name
|
||||
|
||||
-- XXX: Handle starting `_` and no number at the beginning:
|
||||
-- https://facebook.github.io/graphql/#sec-Names
|
||||
-- TODO: Use takeWhile1 instead for efficiency. With takeWhile1 there is no
|
||||
-- parsing failure.
|
||||
name :: Parser Name
|
||||
name = tok $ pack <$> many1 (satisfy isAlphaNum)
|
||||
name = tok $ append <$> takeWhile1 isA_z
|
||||
<*> takeWhile ((||) <$> isDigit <*> isA_z)
|
||||
where
|
||||
-- `isAlpha` handles many more Unicode Chars
|
||||
isA_z = inClass $ '_' : ['A'..'Z'] ++ ['a'..'z']
|
||||
|
||||
-- * Document
|
||||
|
||||
|
@ -48,7 +51,8 @@ document = whiteSpace
|
|||
-- Try SelectionSet when no definition
|
||||
<|> (Document . pure
|
||||
. DefinitionOperation
|
||||
. Query mempty empty empty
|
||||
. Query
|
||||
. Node mempty empty empty
|
||||
<$> selectionSet)
|
||||
<?> "document error!"
|
||||
|
||||
|
@ -60,14 +64,15 @@ definition = DefinitionOperation <$> operationDefinition
|
|||
|
||||
operationDefinition :: Parser OperationDefinition
|
||||
operationDefinition =
|
||||
op Query "query"
|
||||
<|> op Mutation "mutation"
|
||||
Query <$ tok "query" <*> node
|
||||
<|> Mutation <$ tok "mutation" <*> node
|
||||
<?> "operationDefinition error!"
|
||||
where
|
||||
op f n = f <$ tok n <*> tok name
|
||||
<*> optempty variableDefinitions
|
||||
<*> optempty directives
|
||||
<*> selectionSet
|
||||
|
||||
node :: Parser Node
|
||||
node = Node <$> name
|
||||
<*> optempty variableDefinitions
|
||||
<*> optempty directives
|
||||
<*> selectionSet
|
||||
|
||||
variableDefinitions :: Parser [VariableDefinition]
|
||||
variableDefinitions = parens (many1 variableDefinition)
|
||||
|
@ -148,16 +153,24 @@ typeCondition = namedType
|
|||
-- explicit types use the `typedValue` parser.
|
||||
value :: Parser Value
|
||||
value = ValueVariable <$> variable
|
||||
-- TODO: Handle arbitrary precision.
|
||||
<|> ValueInt <$> tok (signed decimal)
|
||||
<|> ValueFloat <$> tok (signed double)
|
||||
<|> ValueBoolean <$> bool
|
||||
-- TODO: Handle escape characters, unicode, etc
|
||||
<|> ValueString <$> quotes name
|
||||
-- TODO: Handle maxBound, Int32 in spec.
|
||||
<|> ValueInt <$> tok (signed decimal)
|
||||
<|> ValueFloat <$> tok (signed double)
|
||||
<|> ValueBoolean <$> booleanValue
|
||||
<|> ValueString <$> stringValue
|
||||
-- `true` and `false` have been tried before
|
||||
<|> ValueEnum <$> name
|
||||
<|> ValueList <$> listValue
|
||||
<|> ValueObject <$> objectValue
|
||||
<|> ValueEnum <$> name
|
||||
<|> ValueList <$> listValue
|
||||
<|> ValueObject <$> objectValue
|
||||
<?> "value error!"
|
||||
|
||||
booleanValue :: Parser Bool
|
||||
booleanValue = True <$ tok "true"
|
||||
<|> False <$ tok "false"
|
||||
|
||||
-- TODO: Escape characters. Look at `jsstring_` in aeson package.
|
||||
stringValue :: Parser StringValue
|
||||
stringValue = StringValue <$> quotes (takeWhile (/= '"'))
|
||||
|
||||
-- Notice it can be empty
|
||||
listValue :: Parser ListValue
|
||||
|
@ -170,10 +183,6 @@ objectValue = ObjectValue <$> braces (many objectField)
|
|||
objectField :: Parser ObjectField
|
||||
objectField = ObjectField <$> name <* tok ":" <*> value
|
||||
|
||||
bool :: Parser Bool
|
||||
bool = True <$ tok "true"
|
||||
<|> False <$ tok "false"
|
||||
|
||||
-- * Directives
|
||||
|
||||
directives :: Parser [Directive]
|
||||
|
@ -188,9 +197,10 @@ directive = Directive
|
|||
-- * Type Reference
|
||||
|
||||
type_ :: Parser Type
|
||||
type_ = TypeNamed <$> namedType
|
||||
<|> TypeList <$> listType
|
||||
type_ = TypeList <$> listType
|
||||
<|> TypeNonNull <$> nonNullType
|
||||
<|> TypeNamed <$> namedType
|
||||
<?> "type_ error!"
|
||||
|
||||
namedType :: Parser NamedType
|
||||
namedType = NamedType <$> name
|
||||
|
@ -201,6 +211,7 @@ listType = ListType <$> brackets type_
|
|||
nonNullType :: Parser NonNullType
|
||||
nonNullType = NonNullTypeNamed <$> namedType <* tok "!"
|
||||
<|> NonNullTypeList <$> listType <* tok "!"
|
||||
<?> "nonNullType error!"
|
||||
|
||||
-- * Type Definition
|
||||
|
||||
|
@ -221,7 +232,6 @@ objectTypeDefinition = ObjectTypeDefinition
|
|||
<*> name
|
||||
<*> optempty interfaces
|
||||
<*> fieldDefinitions
|
||||
<?> "objectTypeDefinition error!"
|
||||
|
||||
interfaces :: Parser Interfaces
|
||||
interfaces = tok "implements" *> many1 namedType
|
||||
|
@ -237,17 +247,7 @@ fieldDefinition = FieldDefinition
|
|||
<*> type_
|
||||
|
||||
argumentsDefinition :: Parser ArgumentsDefinition
|
||||
argumentsDefinition = inputValueDefinitions
|
||||
|
||||
inputValueDefinitions :: Parser [InputValueDefinition]
|
||||
inputValueDefinitions = parens $ many1 inputValueDefinition
|
||||
|
||||
inputValueDefinition :: Parser InputValueDefinition
|
||||
inputValueDefinition = InputValueDefinition
|
||||
<$> name
|
||||
<* tok ":"
|
||||
<*> type_
|
||||
<*> optional defaultValue
|
||||
argumentsDefinition = parens $ many1 inputValueDefinition
|
||||
|
||||
interfaceTypeDefinition :: Parser InterfaceTypeDefinition
|
||||
interfaceTypeDefinition = InterfaceTypeDefinition
|
||||
|
@ -288,6 +288,16 @@ inputObjectTypeDefinition = InputObjectTypeDefinition
|
|||
<*> name
|
||||
<*> inputValueDefinitions
|
||||
|
||||
inputValueDefinitions :: Parser [InputValueDefinition]
|
||||
inputValueDefinitions = braces $ many1 inputValueDefinition
|
||||
|
||||
inputValueDefinition :: Parser InputValueDefinition
|
||||
inputValueDefinition = InputValueDefinition
|
||||
<$> name
|
||||
<* tok ":"
|
||||
<*> type_
|
||||
<*> optional defaultValue
|
||||
|
||||
typeExtensionDefinition :: Parser TypeExtensionDefinition
|
||||
typeExtensionDefinition = TypeExtensionDefinition
|
||||
<$ tok "extend"
|
||||
|
@ -320,8 +330,7 @@ optempty = option mempty
|
|||
-- ** WhiteSpace
|
||||
--
|
||||
whiteSpace :: Parser ()
|
||||
whiteSpace = peekChar >>= \case
|
||||
Just c -> if isSpace c || c == ','
|
||||
then anyChar *> whiteSpace
|
||||
else when (c == '#') $ manyTill anyChar endOfLine *> whiteSpace
|
||||
_ -> return ()
|
||||
whiteSpace = peekChar >>= traverse_ (\c ->
|
||||
if isSpace c || c == ','
|
||||
then anyChar *> whiteSpace
|
||||
else when (c == '#') $ manyTill anyChar endOfLine *> whiteSpace)
|
||||
|
|
|
@ -9,9 +9,11 @@ but the idea is to be a Haskell port of
|
|||
should include:
|
||||
|
||||
- [x] GraphQL AST
|
||||
- [x] Parser for the GraphQL language. See TODO for caveats.
|
||||
- [x] Parser for the GraphQL language. See TODO for limitations.
|
||||
- [x] Printer for GraphQL. This is not pretty yet.
|
||||
- [ ] GraphQL Schema AST.
|
||||
- [ ] Parser for the GraphQL Schema language.
|
||||
- [ ] Printer for the GraphQL Schema language.
|
||||
- [ ] Interpreter of GraphQL requests.
|
||||
- [ ] Utilities to define GraphQL types and schema.
|
||||
|
||||
|
@ -21,6 +23,6 @@ See the TODO file for more concrete tasks.
|
|||
|
||||
Suggestions, contributions and bug reports are welcome.
|
||||
|
||||
Feel free to contact me, jdnavarro, on the #haskell channel on the
|
||||
[GraphQL Slack Server](https://graphql.slack.com). You can obtain an
|
||||
Feel free to contact on Slack in [#haskell on
|
||||
GraphQL](https://graphql.slack.com/messages/haskell/). You can obtain an
|
||||
invitation [here](https://graphql-slack.herokuapp.com/).
|
||||
|
|
24
TODO
24
TODO
|
@ -1,21 +1,21 @@
|
|||
## AST
|
||||
- Docs
|
||||
- Simplify unnecessary `newtypes` with type synonyms
|
||||
- Simplify wrapper type constructors. Some types can be just constructors.
|
||||
- Data type accessors
|
||||
- Deal with Strictness/unboxing
|
||||
- Deal with Location
|
||||
- Deal with strictness/unboxing
|
||||
- Deal with location
|
||||
|
||||
## Parser
|
||||
- Secure Names
|
||||
- Optimize `name` and `whiteSpace`: `take...`, `T.fold`, ...
|
||||
- Docs
|
||||
- Handle escape characters in string literals
|
||||
- Guard for `on` in `FragmentSpread`
|
||||
- Tests!
|
||||
- Handle `[Const]` grammar parameter. Need examples
|
||||
- Arbitrary precision for number values?
|
||||
- Handle errors. Perhaps port to `parsers` or use a lexer and
|
||||
`regex-applicative`
|
||||
- Handle `maxBound` Int values.
|
||||
- Diagnostics. Perhaps port to `parsers` and use `trifecta` for diagnostics,
|
||||
and `attoparsec` for performance.
|
||||
- Optimize `whiteSpace`, perhaps front the main parser with a lexer.
|
||||
|
||||
## Tests
|
||||
|
||||
- Golden data within package, `path_graphql` macro.
|
||||
- Pretty Print golden result
|
||||
## Printer
|
||||
- Add pretty printer.
|
||||
- Docs
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
name: graphql
|
||||
version: 0.2.1
|
||||
version: 0.3
|
||||
synopsis: Haskell GraphQL implementation
|
||||
description:
|
||||
This package provides a rudimentary parser for the
|
||||
|
@ -17,29 +17,30 @@ cabal-version: >=1.10
|
|||
tested-with: GHC == 7.8.4, GHC == 7.10.2
|
||||
extra-source-files: README.md CHANGELOG.md stack.yaml
|
||||
data-files: tests/data/*.graphql
|
||||
tests/data/*.graphql.golden
|
||||
tests/data/*.min.graphql
|
||||
|
||||
library
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
exposed-modules: Data.GraphQL.AST
|
||||
Data.GraphQL.Encoder
|
||||
Data.GraphQL.Parser
|
||||
build-depends: base >= 4.7 && < 5,
|
||||
build-depends: base >=4.7 && < 5,
|
||||
text >=0.11.3.1,
|
||||
attoparsec >=0.10.4.0
|
||||
|
||||
test-suite golden
|
||||
test-suite tasty
|
||||
default-language: Haskell2010
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: tests
|
||||
main-is: golden.hs
|
||||
main-is: tasty.hs
|
||||
ghc-options: -Wall
|
||||
build-depends: base >= 4.6 && <5,
|
||||
bytestring,
|
||||
text,
|
||||
attoparsec,
|
||||
other-modules: Paths_graphql
|
||||
build-depends: base >=4.6 && <5,
|
||||
text >=0.11.3.1,
|
||||
attoparsec >=0.10.4.0,
|
||||
tasty >=0.10,
|
||||
tasty-golden,
|
||||
tasty-hunit >=0.9,
|
||||
graphql
|
||||
|
||||
source-repository head
|
||||
|
|
|
@ -1 +0,0 @@
|
|||
Document [DefinitionOperation (Query "queryName" [VariableDefinition (Variable "foo") (TypeNamed (NamedType "ComplexType")) Nothing,VariableDefinition (Variable "site") (TypeNamed (NamedType "Site")) (Just (ValueEnum "MOBILE"))] [] [SelectionField (Field "whoever123is" "node" [Argument "id" (ValueList (ListValue [ValueInt 123,ValueInt 456]))] [] [SelectionField (Field "" "id" [] [] []),SelectionInlineFragment (InlineFragment (NamedType "User") [Directive "defer" []] [SelectionField (Field "" "field2" [] [] [SelectionField (Field "" "id" [] [] []),SelectionField (Field "alias" "field1" [Argument "first" (ValueInt 10),Argument "after" (ValueVariable (Variable "foo"))] [Directive "include" [Argument "if" (ValueVariable (Variable "foo"))]] [SelectionField (Field "" "id" [] [] []),SelectionFragmentSpread (FragmentSpread "frag" [])])])])])]),DefinitionOperation (Mutation "likeStory" [] [] [SelectionField (Field "" "like" [Argument "story" (ValueInt 123)] [Directive "defer" []] [SelectionField (Field "" "story" [] [] [SelectionField (Field "" "id" [] [] [])])])]),DefinitionFragment (FragmentDefinition "frag" (NamedType "Friend") [] [SelectionField (Field "" "foo" [Argument "size" (ValueVariable (Variable "size")),Argument "bar" (ValueVariable (Variable "b")),Argument "obj" (ValueObject (ObjectValue [ObjectField "key" (ValueString "value")]))] [] [])])]
|
|
@ -0,0 +1 @@
|
|||
query queryName($foo:ComplexType,$site:Site=MOBILE){whoever123is:node(id:[123,456]){id,... on User@defer{field2{id,alias:field1(first:10,after:$foo)@include(if:$foo){id,...frag}}}}}mutation likeStory{like(story:123)@defer{story{id}}}fragment frag on Friend{foo(size:$size,bar:$b,obj:{key:"value"})}
|
|
@ -1,25 +0,0 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Main where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>), (<*>), pure)
|
||||
#endif
|
||||
import Control.Monad ((>=>))
|
||||
import Data.Attoparsec.Text (parseOnly)
|
||||
import Data.ByteString.Lazy.Char8 as B8
|
||||
import qualified Data.Text.IO as TIO
|
||||
import Test.Tasty (defaultMain)
|
||||
import Test.Tasty.Golden (goldenVsString)
|
||||
|
||||
import Paths_graphql (getDataFileName)
|
||||
import Data.GraphQL.Parser (document)
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain
|
||||
=<< goldenVsString "kitchen-sink.graphql"
|
||||
<$> getDataFileName "tests/data/kitchen-sink.graphql.graphql.golden"
|
||||
<*> (parse <$> getDataFileName "tests/data/kitchen-sink.graphql")
|
||||
where
|
||||
parse = fmap (parseOnly document) . TIO.readFile
|
||||
>=> pure . either B8.pack (flip B8.snoc '\n' . B8.pack . show)
|
|
@ -0,0 +1,28 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Main where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>), (<*>))
|
||||
#endif
|
||||
|
||||
import Data.Attoparsec.Text (parseOnly)
|
||||
import qualified Data.Text.IO as Text
|
||||
import Test.Tasty (defaultMain)
|
||||
import Test.Tasty.HUnit
|
||||
|
||||
import qualified Data.GraphQL.Parser as Parser
|
||||
import qualified Data.GraphQL.Encoder as Encoder
|
||||
|
||||
import Paths_graphql (getDataFileName)
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain =<< testCase "Kitchen Sink"
|
||||
<$> (assertEqual "Encode" <$> expected <*> actual)
|
||||
where
|
||||
expected = Text.readFile
|
||||
=<< getDataFileName "tests/data/kitchen-sink.min.graphql"
|
||||
|
||||
actual = either (error "Parsing error!") Encoder.document
|
||||
<$> parseOnly Parser.document
|
||||
<$> expected
|
Loading…
Reference in New Issue