Validate fragments on composite types

src/Language/GraphQL/AST/Document.hs

@@ -17,7 +17,9 @@ module Language.GraphQL.AST.Document
     , ExecutableDefinition(..)
     , FieldDefinition(..)
     , FragmentDefinition(..)
+    , FragmentSpread(..)
     , ImplementsInterfaces(..)
+    , InlineFragment(..)
     , InputValueDefinition(..)
     , Location(..)
     , Name
@@ -132,7 +134,28 @@ type SelectionSetOpt = [Selection]
 --   }
 -- }
 -- @
+data Selection
+    = Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt Location
+    | FragmentSpreadSelection FragmentSpread
+    | InlineFragmentSelection InlineFragment
+    deriving (Eq, Show)
+
+-- Inline fragments don't have any name and the type condition ("on UserType")
+-- is optional.
 --
+-- @
+-- {
+--   user {
+--     ... on UserType {
+--       id
+--       name
+--     }
+-- }
+-- @
+data InlineFragment = InlineFragment
+    (Maybe TypeCondition) [Directive] SelectionSet Location
+    deriving (Eq, Show)
+
 -- A fragment spread refers to a fragment defined outside the operation and is
 -- expanded at the execution time.
 --
@@ -148,23 +171,7 @@ type SelectionSetOpt = [Selection]
 --   name
 -- }
 -- @
---
--- Inline fragments are similar but they don't have any name and the type
--- condition ("on UserType") is optional.
---
--- @
--- {
---   user {
---     ... on UserType {
---       id
---       name
---     }
--- }
--- @
-data Selection
-    = Field (Maybe Alias) Name [Argument] [Directive] SelectionSetOpt Location
-    | FragmentSpread Name [Directive] Location
-    | InlineFragment (Maybe TypeCondition) [Directive] SelectionSet Location
+data FragmentSpread = FragmentSpread Name [Directive] Location
     deriving (Eq, Show)
 
 -- ** Arguments

src/Language/GraphQL/AST/Encoder.hs

@@ -128,10 +128,10 @@ selection formatter = Lazy.Text.append indent' . encodeSelection
   where
     encodeSelection (Field alias name args directives' selections _) =
         field incrementIndent alias name args directives' selections
-    encodeSelection (InlineFragment typeCondition directives' selections _) =
-        inlineFragment incrementIndent typeCondition directives' selections
-    encodeSelection (FragmentSpread name directives' _) =
-        fragmentSpread incrementIndent name directives'
+    encodeSelection (InlineFragmentSelection fragmentSelection) =
+        inlineFragment incrementIndent fragmentSelection
+    encodeSelection (FragmentSpreadSelection fragmentSelection) =
+        fragmentSpread incrementIndent fragmentSelection
     incrementIndent
         | Pretty indentation <- formatter = Pretty $ indentation + 1
         | otherwise = Minified
@@ -172,22 +172,18 @@ argument formatter (Argument name value')
 
 -- * Fragments
 
-fragmentSpread :: Formatter -> Name -> [Directive] -> Lazy.Text
-fragmentSpread formatter name directives'
+fragmentSpread :: Formatter -> FragmentSpread -> Lazy.Text
+fragmentSpread formatter (FragmentSpread name directives' _)
     = "..." <> Lazy.Text.fromStrict name
     <> optempty (directives formatter) directives'
 
-inlineFragment ::
-    Formatter ->
-    Maybe TypeCondition ->
-    [Directive] ->
-    SelectionSet ->
-    Lazy.Text
-inlineFragment formatter tc dirs sels = "... on "
-    <> Lazy.Text.fromStrict (fold tc)
-    <> directives formatter dirs
+inlineFragment :: Formatter -> InlineFragment -> Lazy.Text
+inlineFragment formatter (InlineFragment typeCondition directives' selections _)
+    = "... on "
+    <> Lazy.Text.fromStrict (fold typeCondition)
+    <> directives formatter directives'
     <> eitherFormat formatter " " mempty
-    <> selectionSet formatter sels
+    <> selectionSet formatter selections
 
 fragmentDefinition :: Formatter -> FragmentDefinition -> Lazy.Text
 fragmentDefinition formatter (FragmentDefinition name tc dirs sels _)

src/Language/GraphQL/AST/Parser.hs

@@ -377,8 +377,8 @@ selectionSetOpt = listOptIn braces selection <?> "SelectionSet"
 
 selection :: Parser Selection
 selection = field
-    <|> try fragmentSpread
-    <|> inlineFragment
+    <|> FragmentSpreadSelection <$> try fragmentSpread
+    <|> InlineFragmentSelection <$> inlineFragment
     <?> "Selection"
 
 field :: Parser Selection
@@ -400,7 +400,7 @@ arguments = listOptIn parens argument <?> "Arguments"
 argument :: Parser Argument
 argument = Argument <$> name <* colon <*> value <?> "Argument"
 
-fragmentSpread :: Parser Selection
+fragmentSpread :: Parser FragmentSpread
 fragmentSpread = label "FragmentSpread" $ do
     location <- getLocation
     _ <- spread
@@ -408,7 +408,7 @@ fragmentSpread = label "FragmentSpread" $ do
     directives' <- directives
     pure $ FragmentSpread fragmentName' directives' location
 
-inlineFragment :: Parser Selection
+inlineFragment :: Parser InlineFragment
 inlineFragment = label "InlineFragment" $ do
     location <- getLocation
     _ <- spread