graphql 0.1 → 0.2

raw patch · 7 files changed

+525/−149 lines, 7 filesdep +attoparsecdep +bytestringdep +graphqldep ~basedep ~textPVP ok

version bump matches the API change (PVP)

Dependencies added: attoparsec, bytestring, graphql, tasty, tasty-golden

Dependency ranges changed: base, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• Data/GraphQL.hs +0/−140
• Data/GraphQL/AST.hs +143/−0
• Data/GraphQL/Parser.hs +322/−0
• README.md +5/−2
• graphql.cabal +25/−7
• tests/golden.hs +21/−0

@@ -1,6 +1,15 @@ # Change Log All notable changes to this project will be documented in this file. +## [0.2] - 2015-09-14+### Added+- Rudimentary parser for `GraphQL` which successfully parses the sample file+  `kitchen-sink.graphql` from `graphql-js` tests.+- Golden test for `kitchen-sink.grahql` parsing.+### Changed+- Many optional data types in `GraphQl` didn't need to be wrapped in a `Maybe`.+- Some `newtype`s became type synonyms for easier parsing.+ ## [0.1] - 2015-09-12 ### Added - Data types for the GraphQL language.

@@ -1,140 +0,0 @@-module Data.GraphQL where--import Data.Text (Text)---- * Name--type Name = Text---- * Document--newtype Document = Document [Definition] deriving (Eq,Show)--data Definition = DefinitionOperation OperationDefinition-                | DefinitionFragment  FragmentDefinition-                | DefinitionType      TypeDefinition-                  deriving (Eq,Show)--data OperationDefinition =-    Query        (Maybe [VariableDefinition]) (Maybe [Directive]) SelectionSet-  | Mutation     (Maybe [VariableDefinition]) (Maybe [Directive]) SelectionSet-  | Subscription (Maybe [VariableDefinition]) (Maybe [Directive]) SelectionSet-    deriving (Eq,Show)--data VariableDefinition = VariableDefinition Variable Type (Maybe DefaultValue)-                          deriving (Eq,Show)--newtype Variable = Variable Name deriving (Eq,Show)--newtype SelectionSet = SelectionSet [Selection] deriving (Eq,Show)--data Selection = SelectionField Field-               | SelectionFragmentSpread FragmentSpread-               | SelectionInlineFragment InlineFragment-                 deriving (Eq,Show)--data Field = Field (Maybe Alias) Name (Maybe [Argument])-                                      (Maybe [Directive])-                                      (Maybe SelectionSet)-             deriving (Eq,Show)--type Alias = Name--data Argument = Argument Name Value deriving (Eq,Show)---- * Fragments--data FragmentSpread = FragmentSpread Name (Maybe [Directive])-                      deriving (Eq,Show)--data InlineFragment =-    InlineFragment TypeCondition (Maybe [Directive]) SelectionSet-    deriving (Eq,Show)--data FragmentDefinition =-    FragmentDefinition Name TypeCondition (Maybe [Directive]) SelectionSet-    deriving (Eq,Show)--type TypeCondition = NamedType---- * Values--data Value = ValueVariable Variable-           | ValueInt Int-           | ValueFloat Float-           | ValueString Text-           | ValueBoolean Bool-           | ValueEnum Name-           | ValueList ListValue-           | ValueObject ObjectValue-             deriving (Eq,Show)--newtype ListValue = ListValue [Value] deriving (Eq,Show)--newtype ObjectValue = ObjectValue [ObjectField] deriving (Eq,Show)--data ObjectField = ObjectField Name Value deriving (Eq,Show)--type DefaultValue = Value---- * Directives--data Directive = Directive Name (Maybe [Argument]) deriving (Eq,Show)---- * Type Reference--data Type = TypeNamed NamedType-          | TypeList ListType-          | TypeNonNull NonNullType-            deriving (Eq,Show)--newtype NamedType = NamedType Name deriving (Eq,Show)--newtype ListType = ListType Type deriving (Eq,Show)--data NonNullType = NonNullTypeNamed NamedType-                 | NonNullTypeList  ListType-                   deriving (Eq,Show)---- * Type definition--data TypeDefinition = TypeDefinitionObject        ObjectTypeDefinition-                    | TypeDefinitionInterface     InterfaceTypeDefinition-                    | TypeDefinitionUnion         UnionTypeDefinition-                    | TypeDefinitionScalar        ScalarTypeDefinition-                    | TypeDefinitionEnum          EnumTypeDefinition-                    | TypeDefinitionInputObject   InputObjectTypeDefinition-                    | TypeDefinitionTypeExtension TypeExtensionDefinition-                      deriving (Eq,Show)--data ObjectTypeDefinition = ObjectTypeDefinition Name (Maybe Interfaces) [FieldDefinition]-                            deriving (Eq,Show)--type Interfaces = [NamedType]--data FieldDefinition = FieldDefinition Name [InputValueDefinition]-                       deriving (Eq,Show)--data InputValueDefinition = InputValueDefinition Name Type (Maybe DefaultValue)-                            deriving (Eq,Show)--data InterfaceTypeDefinition = InterfaceTypeDefinition Name [FieldDefinition]-                               deriving (Eq,Show)--data UnionTypeDefinition = UnionTypeDefinition Name [NamedType]-                           deriving (Eq,Show)--data ScalarTypeDefinition = ScalarTypeDefinition Name-                            deriving (Eq,Show)--data EnumTypeDefinition = EnumTypeDefinition Name [EnumValueDefinition]-                          deriving (Eq,Show)--newtype EnumValueDefinition = EnumValueDefinition Name-                              deriving (Eq,Show)--data InputObjectTypeDefinition = InputObjectTypeDefinition Name [InputValueDefinition]-                                 deriving (Eq,Show)--newtype TypeExtensionDefinition = TypeExtensionDefinition ObjectTypeDefinition-                                  deriving (Eq,Show)

@@ -0,0 +1,143 @@+module Data.GraphQL.AST where++import Data.Text (Text)++-- * Name++type Name = Text++-- * Document++newtype Document = Document [Definition] deriving (Eq,Show)++data Definition = DefinitionOperation OperationDefinition+                | DefinitionFragment  FragmentDefinition+                | 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 VariableDefinition = VariableDefinition Variable Type (Maybe DefaultValue)+                          deriving (Eq,Show)++newtype Variable = Variable Name deriving (Eq,Show)++type SelectionSet = [Selection]++data Selection = SelectionField Field+               | SelectionFragmentSpread FragmentSpread+               | SelectionInlineFragment InlineFragment+                 deriving (Eq,Show)++data Field = Field Alias Name [Argument]+                              [Directive]+                              SelectionSet+             deriving (Eq,Show)++type Alias = Name++data Argument = Argument Name Value deriving (Eq,Show)++-- * Fragments++data FragmentSpread = FragmentSpread Name [Directive]+                      deriving (Eq,Show)++data InlineFragment =+    InlineFragment TypeCondition [Directive] SelectionSet+    deriving (Eq,Show)++data FragmentDefinition =+    FragmentDefinition Name TypeCondition [Directive] SelectionSet+    deriving (Eq,Show)++type TypeCondition = NamedType++-- * Values++data Value = ValueVariable Variable+           | ValueInt Int -- TODO: Should this be `Integer`?+           | ValueFloat Double -- TODO: Should this be `Scientific`?+           | ValueBoolean Bool+           | ValueString Text+           | ValueEnum Name+           | ValueList ListValue+           | ValueObject ObjectValue+             deriving (Eq,Show)++newtype ListValue = ListValue [Value] deriving (Eq,Show)++newtype ObjectValue = ObjectValue [ObjectField] deriving (Eq,Show)++data ObjectField = ObjectField Name Value deriving (Eq,Show)++type DefaultValue = Value++-- * Directives++data Directive = Directive Name [Argument] deriving (Eq,Show)++-- * Type Reference++data Type = TypeNamed NamedType+          | TypeList ListType+          | TypeNonNull NonNullType+            deriving (Eq,Show)++newtype NamedType = NamedType Name deriving (Eq,Show)++newtype ListType = ListType Type deriving (Eq,Show)++data NonNullType = NonNullTypeNamed NamedType+                 | NonNullTypeList  ListType+                   deriving (Eq,Show)++-- * Type definition++data TypeDefinition = TypeDefinitionObject        ObjectTypeDefinition+                    | TypeDefinitionInterface     InterfaceTypeDefinition+                    | TypeDefinitionUnion         UnionTypeDefinition+                    | TypeDefinitionScalar        ScalarTypeDefinition+                    | TypeDefinitionEnum          EnumTypeDefinition+                    | TypeDefinitionInputObject   InputObjectTypeDefinition+                    | TypeDefinitionTypeExtension TypeExtensionDefinition+                      deriving (Eq,Show)++data ObjectTypeDefinition = ObjectTypeDefinition Name Interfaces [FieldDefinition]+                            deriving (Eq,Show)++type Interfaces = [NamedType]++data FieldDefinition = FieldDefinition Name ArgumentsDefinition Type+                       deriving (Eq,Show)++type ArgumentsDefinition = [InputValueDefinition]++data InputValueDefinition = InputValueDefinition Name Type (Maybe DefaultValue)+                            deriving (Eq,Show)++data InterfaceTypeDefinition = InterfaceTypeDefinition Name [FieldDefinition]+                               deriving (Eq,Show)++data UnionTypeDefinition = UnionTypeDefinition Name [NamedType]+                           deriving (Eq,Show)++data ScalarTypeDefinition = ScalarTypeDefinition Name+                            deriving (Eq,Show)++data EnumTypeDefinition = EnumTypeDefinition Name [EnumValueDefinition]+                          deriving (Eq,Show)++newtype EnumValueDefinition = EnumValueDefinition Name+                              deriving (Eq,Show)++data InputObjectTypeDefinition = InputObjectTypeDefinition Name [InputValueDefinition]+                                 deriving (Eq,Show)++newtype TypeExtensionDefinition = TypeExtensionDefinition ObjectTypeDefinition+                                  deriving (Eq,Show)

@@ -0,0 +1,322 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+module Data.GraphQL.Parser where++import Prelude hiding (takeWhile)+import Control.Applicative ((<|>), empty, many, optional)+import Control.Monad (when)+import Data.Char++import Data.Text (Text, pack)+import Data.Attoparsec.Text+  ( Parser+  , (<?>)+  , anyChar+  , decimal+  , double+  , endOfLine+  , many1+  , manyTill+  , option+  , peekChar+  , satisfy+  , sepBy1+  , signed+  )++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)++-- * Document++document :: Parser Document+document = whiteSpace+     *> (Document <$> many1 definition)+    -- Try SelectionSet when no definition+    <|> (Document . pure+                  . DefinitionOperation+                  . Query mempty empty empty+                <$> selectionSet)+    <?> "document error!"++definition :: Parser Definition+definition = DefinitionOperation <$> operationDefinition+         <|> DefinitionFragment  <$> fragmentDefinition+         <|> DefinitionType      <$> typeDefinition+         <?> "definition error!"++operationDefinition :: Parser OperationDefinition+operationDefinition =+        op Query "query"+    <|> op Mutation "mutation"+    <?> "operationDefinition error!"+  where+    op f n = f <$ tok n <*> tok name+                        <*> optempty variableDefinitions+                        <*> optempty directives+                        <*> selectionSet++variableDefinitions :: Parser [VariableDefinition]+variableDefinitions = parens (many1 variableDefinition)++variableDefinition :: Parser VariableDefinition+variableDefinition =+    VariableDefinition <$> variable+                       <*  tok ":"+                       <*> type_+                       <*> optional defaultValue++defaultValue :: Parser DefaultValue+defaultValue = tok "=" *> value++variable :: Parser Variable+variable = Variable <$ tok "$" <*> name++selectionSet :: Parser SelectionSet+selectionSet = braces $ many1 selection++selection :: Parser Selection+selection = SelectionField <$> field+            -- Inline first to catch `on` case+        <|> SelectionInlineFragment <$> inlineFragment+        <|> SelectionFragmentSpread <$> fragmentSpread+        <?> "selection error!"++field :: Parser Field+field = Field <$> optempty alias+              <*> name+              <*> optempty arguments+              <*> optempty directives+              <*> optempty selectionSet++alias :: Parser Alias+alias = name <* tok ":"++arguments :: Parser [Argument]+arguments = parens $ many1 argument++argument :: Parser Argument+argument = Argument <$> name <* tok ":" <*> value++-- * Fragments++fragmentSpread :: Parser FragmentSpread+-- TODO: Make sure it fails when `... on`.+-- See https://facebook.github.io/graphql/#FragmentSpread+fragmentSpread = FragmentSpread+    <$  tok "..."+    <*> name+    <*> optempty directives++-- InlineFragment tried first in order to guard against 'on' keyword+inlineFragment :: Parser InlineFragment+inlineFragment = InlineFragment+    <$  tok "..."+    <*  tok "on"+    <*> typeCondition+    <*> optempty directives+    <*> selectionSet++fragmentDefinition :: Parser FragmentDefinition+fragmentDefinition = FragmentDefinition+    <$  tok "fragment"+    <*> name+    <*  tok "on"+    <*> typeCondition+    <*> optempty directives+    <*> selectionSet++typeCondition :: Parser TypeCondition+typeCondition = namedType++-- * Values++-- This will try to pick the first type it can parse. If you are working with+-- 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+    -- `true` and `false` have been tried before+    <|> ValueEnum    <$> name+    <|> ValueList    <$> listValue+    <|> ValueObject  <$> objectValue++-- Notice it can be empty+listValue :: Parser ListValue+listValue = ListValue <$> brackets (many value)++-- Notice it can be empty+objectValue :: Parser ObjectValue+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]+directives = many1 directive++directive :: Parser Directive+directive = Directive+    <$  tok "@"+    <*> name+    <*> optempty arguments++-- * Type Reference++type_ :: Parser Type+type_ = TypeNamed   <$> namedType+    <|> TypeList    <$> listType+    <|> TypeNonNull <$> nonNullType++namedType :: Parser NamedType+namedType = NamedType <$> name++listType :: Parser ListType+listType = ListType <$> brackets type_++nonNullType :: Parser NonNullType+nonNullType = NonNullTypeNamed <$> namedType <* tok "!"+          <|> NonNullTypeList  <$> listType  <* tok "!"++-- * Type Definition++typeDefinition :: Parser TypeDefinition+typeDefinition =+        TypeDefinitionObject        <$> objectTypeDefinition+    <|> TypeDefinitionInterface     <$> interfaceTypeDefinition+    <|> TypeDefinitionUnion         <$> unionTypeDefinition+    <|> TypeDefinitionScalar        <$> scalarTypeDefinition+    <|> TypeDefinitionEnum          <$> enumTypeDefinition+    <|> TypeDefinitionInputObject   <$> inputObjectTypeDefinition+    <|> TypeDefinitionTypeExtension <$> typeExtensionDefinition+    <?> "typeDefinition error!"++objectTypeDefinition :: Parser ObjectTypeDefinition+objectTypeDefinition = ObjectTypeDefinition+    <$  tok "type"+    <*> name+    <*> optempty interfaces+    <*> fieldDefinitions+    <?> "objectTypeDefinition error!"++interfaces :: Parser Interfaces+interfaces = tok "implements" *> many1 namedType++fieldDefinitions :: Parser [FieldDefinition]+fieldDefinitions = braces $ many1 fieldDefinition++fieldDefinition :: Parser FieldDefinition+fieldDefinition = FieldDefinition+    <$> name+    <*> optempty argumentsDefinition+    <*  tok ":"+    <*> type_++argumentsDefinition :: Parser ArgumentsDefinition+argumentsDefinition = inputValueDefinitions++inputValueDefinitions :: Parser [InputValueDefinition]+inputValueDefinitions = parens $ many1 inputValueDefinition++inputValueDefinition :: Parser InputValueDefinition+inputValueDefinition = InputValueDefinition+    <$> name+    <*  tok ":"+    <*> type_+    <*> optional defaultValue++interfaceTypeDefinition :: Parser InterfaceTypeDefinition+interfaceTypeDefinition = InterfaceTypeDefinition+    <$  tok "interface"+    <*> name+    <*> fieldDefinitions++unionTypeDefinition :: Parser UnionTypeDefinition+unionTypeDefinition = UnionTypeDefinition+    <$  tok "union"+    <*> name+    <*  tok "="+    <*> unionMembers++unionMembers :: Parser [NamedType]+unionMembers = namedType `sepBy1` tok "|"++scalarTypeDefinition :: Parser ScalarTypeDefinition+scalarTypeDefinition = ScalarTypeDefinition+    <$  tok "scalar"+    <*> name++enumTypeDefinition :: Parser EnumTypeDefinition+enumTypeDefinition = EnumTypeDefinition+    <$  tok "enum"+    <*> name+    <*> enumValueDefinitions++enumValueDefinitions :: Parser [EnumValueDefinition]+enumValueDefinitions = braces $ many1 enumValueDefinition++enumValueDefinition :: Parser EnumValueDefinition+enumValueDefinition = EnumValueDefinition <$> name++inputObjectTypeDefinition :: Parser InputObjectTypeDefinition+inputObjectTypeDefinition = InputObjectTypeDefinition+    <$  tok "input"+    <*> name+    <*> inputValueDefinitions++typeExtensionDefinition :: Parser TypeExtensionDefinition+typeExtensionDefinition = TypeExtensionDefinition+    <$  tok "extend"+    <*> objectTypeDefinition++-- * Internal++tok :: Parser a -> Parser a+tok p = p <* whiteSpace++parens :: Parser a -> Parser a+parens = between "(" ")"++braces :: Parser a -> Parser a+braces = between "{" "}"++quotes :: Parser a -> Parser a+quotes = between "\"" "\""++brackets :: Parser a -> Parser a+brackets = between "[" "]"++between :: Parser Text -> Parser Text -> Parser a -> Parser a+between open close p = tok open *> p <* tok close++-- `empty` /= `pure mempty` for `Parser`.+optempty :: Monoid a => Parser a -> Parser a+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 ()

@@ -7,11 +7,14 @@ [`graphql-js`](https://github.com/graphql/graphql-js). Next releases should include: -- [ ] Parser for the GraphQL language.-- [ ] Data types for the GraphQL Schema language.+- [x] GraphQL AST+- [x] Parser for the GraphQL language. See TODO for caveats.+- [ ] GraphQL Schema AST. - [ ] Parser for the GraphQL Schema language. - [ ] Interpreter of GraphQL requests. - [ ] Utilities to define GraphQL types and schema.++See the TODO file for more concrete tasks.  ## Contact 

@@ -1,9 +1,9 @@ name:                graphql-version:             0.1-synopsis:            GraphQL Haskell implementation+version:             0.2+synopsis:            Haskell GraphQL implementation description:-  For now this package provides the data types for the GraphQL language.-  Further releases will cover more aspects of the GraphQL specification.+  This package provides a rudimentary parser for the+  <https://facebook.github.io/graphql/ GraphQL> language. homepage:            https://github.com/jdnavarro/graphql-haskell bug-reports:         https://github.com/jdnavarro/graphql-haskell/issues license:             BSD3@@ -13,14 +13,32 @@ copyright:           Copyright (C) 2015 J. Daniel Navarro category:            Web build-type:          Simple-extra-source-files:  README.md CHANGELOG.md stack.yaml cabal-version:       >=1.10+tested-with:         GHC == 7.10+extra-source-files:  README.md CHANGELOG.md stack.yaml  library-  exposed-modules:     Data.GraphQL+  default-language:    Haskell2010+  ghc-options:         -Wall+  exposed-modules:     Data.GraphQL.AST+                       Data.GraphQL.Parser   build-depends:       base >= 4.7 && < 5,-                       text >=0.11.3.1+                       text >=0.11.3.1,+                       attoparsec >=0.10.4.0++test-suite golden   default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  main-is:             golden.hs+  ghc-options:         -Wall+  build-depends:       base >= 4.6 && <5,+                       bytestring,+                       text,+                       attoparsec,+                       tasty >=0.10,+                       tasty-golden,+                       graphql  source-repository head   type:     git

@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++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 Data.GraphQL.Parser (document)++main :: IO ()+main = defaultMain+     $ goldenVsString "kitchen-sink.graphql"+                      "./tests/data/kitchen-sink.graphql.golden"+                      (parse "./tests/data/kitchen-sink.graphql")+  where+    parse = fmap (parseOnly document) . TIO.readFile+        >=> pure . either B8.pack (flip B8.snoc '\n' . B8.pack . show)+