diff --git a/CHANGELOG.md b/CHANGELOG.md index 612fc1a..8a11fcc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ All notable changes to this project will be documented in this file. ### Added - Module documentation. +- Inline fragment support. ## [0.5.0.1] - 2019-09-10 ### Added diff --git a/src/Language/GraphQL/AST/Transform.hs b/src/Language/GraphQL/AST/Transform.hs index 4b82082..53f04cd 100644 --- a/src/Language/GraphQL/AST/Transform.hs +++ b/src/Language/GraphQL/AST/Transform.hs @@ -66,20 +66,21 @@ selection -> Fragmenter -> Full.Selection -> Either [Core.Selection] Core.Selection -selection subs fr (Full.SelectionField fld) = - Right $ Core.SelectionField $ field subs fr fld -selection _ fr (Full.SelectionFragmentSpread (Full.FragmentSpread n _dirs)) = - Left $ Core.SelectionField <$> fr n +selection subs fr (Full.SelectionField fld) + = Right $ Core.SelectionField $ field subs fr fld +selection _ fr (Full.SelectionFragmentSpread (Full.FragmentSpread name _)) + = Left $ Core.SelectionField <$> fr name selection subs fr (Full.SelectionInlineFragment fragment) | (Full.InlineFragment (Just typeCondition) _ selectionSet) <- fragment - = Right $ Core.SelectionFragment $ Core.Fragment typeCondition $ node selectionSet - | otherwise = error "Inline fragments not supported yet" + = Right + $ Core.SelectionFragment + $ Core.Fragment typeCondition + $ NonEmpty.fromList + $ appendSelection selectionSet + | (Full.InlineFragment Nothing _ selectionSet) <- fragment + = Left $ appendSelection selectionSet where - node selections - = NonEmpty.fromList - $ foldr (appendSelection . selection subs fr) [] selections - appendSelection (Left x) acc = x ++ acc - appendSelection (Right x) acc = x : acc + appendSelection = foldr (either (++) (:) . selection subs fr) [] -- * Fragment replacement @@ -96,14 +97,13 @@ defrag subs (Full.DefinitionFragment fragDef) = fragmentDefinition :: Schema.Subs -> Full.FragmentDefinition -> Fragmenter fragmentDefinition subs (Full.FragmentDefinition name _tc _dirs sels) name' - -- TODO: Support fragments within fragments. Fold instead of map. | name == name' = selection' <$> do selections <- NonEmpty.toList $ selection subs mempty <$> sels either id pure selections | otherwise = empty where selection' (Core.SelectionField field') = field' - selection' _ = error "Inline fragments not supported yet" + selection' _ = error "Fragments within fragments are not supported yet" field :: Schema.Subs -> Fragmenter -> Full.Field -> Core.Field field subs fr (Full.Field a n args _dirs sels) = diff --git a/stack.yaml b/stack.yaml index 527dc48..44526e2 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-14.7 +resolver: lts-14.8 packages: - . diff --git a/tests/Test/FragmentSpec.hs b/tests/Test/FragmentSpec.hs index 189306d..337db7e 100644 --- a/tests/Test/FragmentSpec.hs +++ b/tests/Test/FragmentSpec.hs @@ -59,3 +59,25 @@ spec = describe "Inline fragment executor" $ do ] ] in actual `shouldBe` expected + + it "embeds inline fragments without type" $ do + let query = [r|{ + garment { + circumference + ... { + size + } + } + }|] + resolvers = Schema.object "garment" $ return [circumference, size] + + actual <- graphql (resolvers :| []) query + let expected = object + [ "data" .= object + [ "garment" .= object + [ "circumference" .= (60 :: Int) + , "size" .= ("L" :: Text) + ] + ] + ] + in actual `shouldBe` expected