Replace AST.Selection data constructors

This commit is contained in:
Eugen Wissner 2019-12-25 06:45:29 +01:00
parent bdf711d69f
commit 62f3c34bfe
7 changed files with 114 additions and 113 deletions

View File

@ -1,6 +1,19 @@
# Change Log
All notable changes to this project will be documented in this file.
## [Unreleased]
### Changed
- Renamed `AST.Definition` into `AST.ExecutableDefinition`.
TypeSystemDefinition and TypeSystemExtension can also be definitions.
- Defined `AST.Definition` as
`newtype Definition = ExecutableDefinition ExecutableDefinition` for now. It
should be soon extended to contain missing definition types.
- Removed types `AST.Field`, `AST.InlineFragment` and `AST.FragmentSpread`.
These types are only used in `AST.Selection` and `AST.Selection` contains now
3 corresponding data constructors, `Field`, `InlineFragment` and
`FragmentSpread`, instead of separate types. It simplifies pattern matching
and doesn't make the code less typesafe.
## [0.6.1.0] - 2019-12-23
### Fixed
- Parsing multiple string arguments, such as
@ -162,6 +175,7 @@ All notable changes to this project will be documented in this file.
### Added
- Data types for the GraphQL language.
[Unreleased]: https://github.com/caraus-ecms/graphql/compare/v0.6.1.0...HEAD
[0.6.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.6.0.0...v0.6.1.0
[0.6.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.1.0...v0.6.0.0
[0.5.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.1...v0.5.1.0

View File

@ -8,10 +8,8 @@ module Language.GraphQL.AST
, Definition(..)
, Directive(..)
, Document
, Field(..)
, ExecutableDefinition(..)
, FragmentDefinition(..)
, FragmentSpread(..)
, InlineFragment(..)
, Name
, NonNullType(..)
, ObjectField(..)
@ -35,6 +33,10 @@ import Data.Text (Text)
-- | GraphQL document.
type Document = NonEmpty Definition
-- | All kinds of definitions that can occur in a GraphQL document.
newtype Definition = ExecutableDefinition ExecutableDefinition
deriving (Eq, Show)
-- | Name
type Name = Text
@ -44,7 +46,7 @@ data Directive = Directive Name [Argument] deriving (Eq, Show)
-- * Operations
-- | Top-level definition of a document, either an operation or a fragment.
data Definition
data ExecutableDefinition
= DefinitionOperation OperationDefinition
| DefinitionFragment FragmentDefinition
deriving (Eq, Show)
@ -72,13 +74,6 @@ type SelectionSet = NonEmpty Selection
-- | Field selection.
type SelectionSetOpt = [Selection]
-- | Single selection element.
data Selection
= SelectionField Field
| SelectionFragmentSpread FragmentSpread
| SelectionInlineFragment InlineFragment
deriving (Eq, Show)
-- * Field
-- | Single GraphQL field.
@ -102,8 +97,10 @@ data Selection
-- * "zuck" is an alias for "user". "id" and "name" have no aliases.
-- * "id: 4" is an argument for "user". "id" and "name" don't have any
-- arguments.
data Field
data Selection
= Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt
| FragmentSpread Name [Directive]
| InlineFragment (Maybe TypeCondition) [Directive] SelectionSet
deriving (Eq, Show)
-- | Alternative field name.
@ -133,15 +130,6 @@ type Alias = Name
-- Here "id" is an argument for the field "user" and its value is 4.
data Argument = Argument Name Value deriving (Eq,Show)
-- * Fragments
-- | Fragment spread.
data FragmentSpread = FragmentSpread Name [Directive] deriving (Eq, Show)
-- | Inline fragment.
data InlineFragment = InlineFragment (Maybe TypeCondition) [Directive] SelectionSet
deriving (Eq, Show)
-- | Fragment definition.
data FragmentDefinition
= FragmentDefinition Name TypeCondition [Directive] SelectionSet

View File

@ -49,10 +49,11 @@ document formatter defs
| Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument
| Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
where
encodeDocument = NonEmpty.toList $ definition formatter <$> defs
encodeDocument = foldr executableDefinition [] defs
executableDefinition (Full.ExecutableDefinition x) acc = definition formatter x : acc
-- | Converts a 'Full.Definition' into a string.
definition :: Formatter -> Full.Definition -> Lazy.Text
definition :: Formatter -> Full.ExecutableDefinition -> Lazy.Text
definition formatter x
| Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
| Minified <- formatter = encodeDefinition x
@ -116,11 +117,12 @@ indent indentation = Lazy.Text.replicate (fromIntegral indentation) " "
selection :: Formatter -> Full.Selection -> Lazy.Text
selection formatter = Lazy.Text.append indent' . encodeSelection
where
encodeSelection (Full.SelectionField field') = field incrementIndent field'
encodeSelection (Full.SelectionInlineFragment fragment) =
inlineFragment incrementIndent fragment
encodeSelection (Full.SelectionFragmentSpread spread) =
fragmentSpread incrementIndent spread
encodeSelection (Full.Field alias name args directives' selections) =
field incrementIndent alias name args directives' selections
encodeSelection (Full.InlineFragment typeCondition directives' selections) =
inlineFragment incrementIndent typeCondition directives' selections
encodeSelection (Full.FragmentSpread name directives') =
fragmentSpread incrementIndent name directives'
incrementIndent
| Pretty indentation <- formatter = Pretty $ indentation + 1
| otherwise = Minified
@ -131,8 +133,14 @@ selection formatter = Lazy.Text.append indent' . encodeSelection
colon :: Formatter -> Lazy.Text
colon formatter = eitherFormat formatter ": " ":"
field :: Formatter -> Full.Field -> Lazy.Text
field formatter (Full.Field alias name args dirs set)
field :: Formatter ->
Maybe Full.Name ->
Full.Name ->
[Full.Argument] ->
[Full.Directive] ->
[Full.Selection] ->
Lazy.Text
field formatter alias name args dirs set
= optempty prependAlias (fold alias)
<> Lazy.Text.fromStrict name
<> optempty (arguments formatter) args
@ -154,13 +162,18 @@ argument formatter (Full.Argument name value')
-- * Fragments
fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text
fragmentSpread formatter (Full.FragmentSpread name ds)
= "..." <> Lazy.Text.fromStrict name <> optempty (directives formatter) ds
fragmentSpread :: Formatter -> Full.Name -> [Full.Directive] -> Lazy.Text
fragmentSpread formatter name directives'
= "..." <> Lazy.Text.fromStrict name
<> optempty (directives formatter) directives'
inlineFragment :: Formatter -> Full.InlineFragment -> Lazy.Text
inlineFragment formatter (Full.InlineFragment tc dirs sels)
= "... on "
inlineFragment ::
Formatter ->
Maybe Full.TypeCondition ->
[Full.Directive] ->
Full.SelectionSet ->
Lazy.Text
inlineFragment formatter tc dirs sels = "... on "
<> Lazy.Text.fromStrict (fold tc)
<> directives formatter dirs
<> eitherFormat formatter " " mempty

View File

@ -6,23 +6,19 @@ module Language.GraphQL.AST.Parser
( document
) where
import Control.Applicative ( Alternative(..)
, optional
)
import Control.Applicative (Alternative(..), optional)
import Data.List.NonEmpty (NonEmpty(..))
import Language.GraphQL.AST
import Language.GraphQL.AST.Lexer
import Text.Megaparsec ( lookAhead
, option
, try
, (<?>)
)
import Text.Megaparsec (lookAhead, option, try, (<?>))
-- | Parser for the GraphQL documents.
document :: Parser Document
document = unicodeBOM >> spaceConsumer >> lexeme (manyNE definition)
document = unicodeBOM
>> spaceConsumer
>> lexeme (manyNE $ ExecutableDefinition <$> definition)
definition :: Parser Definition
definition :: Parser ExecutableDefinition
definition = DefinitionOperation <$> operationDefinition
<|> DefinitionFragment <$> fragmentDefinition
<?> "definition error!"
@ -50,15 +46,16 @@ selectionSetOpt :: Parser SelectionSetOpt
selectionSetOpt = braces $ some selection
selection :: Parser Selection
selection = SelectionField <$> field
<|> try (SelectionFragmentSpread <$> fragmentSpread)
<|> SelectionInlineFragment <$> inlineFragment
selection = field
<|> try fragmentSpread
<|> inlineFragment
<?> "selection error!"
-- * Field
field :: Parser Field
field = Field <$> optional alias
field :: Parser Selection
field = Field
<$> optional alias
<*> name
<*> opt arguments
<*> opt directives
@ -77,13 +74,15 @@ argument = Argument <$> name <* colon <*> value
-- * Fragments
fragmentSpread :: Parser FragmentSpread
fragmentSpread = FragmentSpread <$ spread
fragmentSpread :: Parser Selection
fragmentSpread = FragmentSpread
<$ spread
<*> fragmentName
<*> opt directives
inlineFragment :: Parser InlineFragment
inlineFragment = InlineFragment <$ spread
inlineFragment :: Parser Selection
inlineFragment = InlineFragment
<$ spread
<*> optional typeCondition
<*> opt directives
<*> selectionSet

View File

@ -42,9 +42,9 @@ document subs document' =
$ Replacement HashMap.empty fragmentTable
where
(fragmentTable, operationDefinitions) = foldr defragment mempty document'
defragment (Full.DefinitionOperation definition) acc =
defragment (Full.ExecutableDefinition (Full.DefinitionOperation definition)) acc =
(definition :) <$> acc
defragment (Full.DefinitionFragment definition) acc =
defragment (Full.ExecutableDefinition (Full.DefinitionFragment definition)) acc =
let (Full.FragmentDefinition name _ _ _) = definition
in first (HashMap.insert name definition) acc
@ -69,13 +69,35 @@ operation (Full.OperationDefinition Full.Mutation name _vars _dirs sels) =
selection ::
Full.Selection ->
TransformT (Either (Seq Core.Selection) Core.Selection)
selection (Full.SelectionField field') =
maybe (Left mempty) (Right . Core.SelectionField) <$> field field'
selection (Full.SelectionFragmentSpread fragment) =
maybe (Left mempty) (Right . Core.SelectionFragment)
<$> fragmentSpread fragment
selection (Full.SelectionInlineFragment fragment) =
inlineFragment fragment
selection (Full.Field alias name arguments' directives' selections) =
maybe (Left mempty) (Right . Core.SelectionField) <$> do
fieldArguments <- traverse argument arguments'
fieldSelections <- appendSelection selections
fieldDirectives <- Directive.selection <$> directives directives'
let field' = Core.Field alias name fieldArguments fieldSelections
pure $ field' <$ fieldDirectives
selection (Full.FragmentSpread name directives') =
maybe (Left mempty) (Right . Core.SelectionFragment) <$> do
spreadDirectives <- Directive.selection <$> directives directives'
fragments' <- gets fragments
fragment <- maybe lookupDefinition liftJust (HashMap.lookup name fragments')
pure $ fragment <$ spreadDirectives
where
lookupDefinition = do
fragmentDefinitions' <- gets fragmentDefinitions
found <- lift . lift $ HashMap.lookup name fragmentDefinitions'
fragmentDefinition found
selection (Full.InlineFragment type' directives' selections) = do
fragmentDirectives <- Directive.selection <$> directives directives'
case fragmentDirectives of
Nothing -> pure $ Left mempty
_ -> do
fragmentSelectionSet <- appendSelection selections
pure $ maybe Left selectionFragment type' fragmentSelectionSet
where
selectionFragment typeName = Right
. Core.SelectionFragment
. Core.Fragment typeName
appendSelection ::
Traversable t =>
@ -104,33 +126,6 @@ collectFragments = do
_ <- fragmentDefinition nextValue
collectFragments
inlineFragment ::
Full.InlineFragment ->
TransformT (Either (Seq Core.Selection) Core.Selection)
inlineFragment (Full.InlineFragment type' directives' selectionSet) = do
fragmentDirectives <- Directive.selection <$> directives directives'
case fragmentDirectives of
Nothing -> pure $ Left mempty
_ -> do
fragmentSelectionSet <- appendSelection selectionSet
pure $ maybe Left selectionFragment type' fragmentSelectionSet
where
selectionFragment typeName = Right
. Core.SelectionFragment
. Core.Fragment typeName
fragmentSpread :: Full.FragmentSpread -> TransformT (Maybe Core.Fragment)
fragmentSpread (Full.FragmentSpread name directives') = do
spreadDirectives <- Directive.selection <$> directives directives'
fragments' <- gets fragments
fragment <- maybe lookupDefinition liftJust (HashMap.lookup name fragments')
pure $ fragment <$ spreadDirectives
where
lookupDefinition = do
fragmentDefinitions' <- gets fragmentDefinitions
found <- lift . lift $ HashMap.lookup name fragmentDefinitions'
fragmentDefinition found
fragmentDefinition ::
Full.FragmentDefinition ->
TransformT Core.Fragment
@ -147,14 +142,6 @@ fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do
let newFragments = HashMap.insert name newValue fragments'
in Replacement newFragments fragmentDefinitions'
field :: Full.Field -> TransformT (Maybe Core.Field)
field (Full.Field alias name arguments' directives' selections) = do
fieldArguments <- traverse argument arguments'
fieldSelections <- appendSelection selections
fieldDirectives <- Directive.selection <$> directives directives'
let field' = Core.Field alias name fieldArguments fieldSelections
pure $ field' <$ fieldDirectives
arguments :: [Full.Argument] -> TransformT Core.Arguments
arguments = fmap Core.Arguments . foldM go HashMap.empty
where

View File

@ -35,7 +35,7 @@ spec = do
it "indents block strings in arguments" $
let arguments = [Argument "message" (String "line1\nline2")]
field = Field Nothing "field" arguments [] []
set = OperationSelectionSet $ pure $ SelectionField field
set = OperationSelectionSet $ pure field
operation = DefinitionOperation set
in definition pretty operation `shouldBe` [r|{
field(message: """