parent
def52ddc20
commit
fc9ad9c4a1
|
|
@ -6,6 +6,9 @@ All notable changes to this project will be documented in this file.
|
|||
- Parsing multiple string arguments, such as
|
||||
`login(username: "username", password: "password")` would fail on the comma
|
||||
due to strings not having a space consumer.
|
||||
- Fragment spread is evaluated based on the `__typename` resolver. If the
|
||||
resolver is missing, it is assumed that the type condition is satisfied (all
|
||||
fragments are included).
|
||||
|
||||
## [0.6.0.0] - 2019-11-27
|
||||
### Changed
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@ import qualified Language.GraphQL.Schema as Schema
|
|||
|
||||
-- | Associates a fragment name with a list of 'Core.Field's.
|
||||
data Replacement = Replacement
|
||||
{ fragments :: HashMap Core.Name (Seq Core.Selection)
|
||||
{ fragments :: HashMap Core.Name Core.Fragment
|
||||
, fragmentDefinitions :: HashMap Full.Name Full.FragmentDefinition
|
||||
}
|
||||
|
||||
|
|
@ -65,15 +65,8 @@ selection ::
|
|||
Full.Selection ->
|
||||
TransformT (Either (Seq Core.Selection) Core.Selection)
|
||||
selection (Full.SelectionField fld) = Right . Core.SelectionField <$> field fld
|
||||
selection (Full.SelectionFragmentSpread (Full.FragmentSpread name _)) = do
|
||||
fragments' <- gets fragments
|
||||
Left <$> maybe lookupDefinition liftJust (HashMap.lookup name fragments')
|
||||
where
|
||||
lookupDefinition :: TransformT (Seq Core.Selection)
|
||||
lookupDefinition = do
|
||||
fragmentDefinitions' <- gets fragmentDefinitions
|
||||
found <- lift . lift $ HashMap.lookup name fragmentDefinitions'
|
||||
fragmentDefinition found
|
||||
selection (Full.SelectionFragmentSpread fragment) =
|
||||
Right . Core.SelectionFragment <$> fragmentSpread fragment
|
||||
selection (Full.SelectionInlineFragment fragment)
|
||||
| (Full.InlineFragment (Just typeCondition) _ selectionSet) <- fragment
|
||||
= Right
|
||||
|
|
@ -94,12 +87,23 @@ collectFragments = do
|
|||
_ <- fragmentDefinition nextValue
|
||||
collectFragments
|
||||
|
||||
fragmentSpread :: Full.FragmentSpread -> TransformT Core.Fragment
|
||||
fragmentSpread (Full.FragmentSpread name _) = do
|
||||
fragments' <- gets fragments
|
||||
maybe lookupDefinition liftJust (HashMap.lookup name fragments')
|
||||
where
|
||||
lookupDefinition = do
|
||||
fragmentDefinitions' <- gets fragmentDefinitions
|
||||
found <- lift . lift $ HashMap.lookup name fragmentDefinitions'
|
||||
fragmentDefinition found
|
||||
|
||||
fragmentDefinition ::
|
||||
Full.FragmentDefinition ->
|
||||
TransformT (Seq Core.Selection)
|
||||
fragmentDefinition (Full.FragmentDefinition name _tc _dirs selections) = do
|
||||
TransformT Core.Fragment
|
||||
fragmentDefinition (Full.FragmentDefinition name typeCondition _dirs selections) = do
|
||||
modify deleteFragmentDefinition
|
||||
newValue <- appendSelection selections
|
||||
fragmentSelection <- appendSelection selections
|
||||
let newValue = Core.Fragment typeCondition fragmentSelection
|
||||
modify $ insertFragment newValue
|
||||
liftJust newValue
|
||||
where
|
||||
|
|
|
|||
|
|
@ -131,8 +131,8 @@ resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
|
|||
tryResolvers (SelectionField fld@(Field _ name _ _))
|
||||
= maybe (errmsg fld) (tryResolver fld) $ find (compareResolvers name) resolvers
|
||||
tryResolvers (SelectionFragment (Fragment typeCondition selections')) = do
|
||||
that <- maybe (return "") resolveTypeName (find (compareResolvers "__typename") resolvers)
|
||||
if Aeson.String typeCondition == that
|
||||
that <- traverse resolveTypeName (find (compareResolvers "__typename") resolvers)
|
||||
if maybe True (Aeson.String typeCondition ==) that
|
||||
then fmap fold . traverse tryResolvers $ selections'
|
||||
else return mempty
|
||||
compareResolvers name (Resolver name' _) = name == name'
|
||||
|
|
|
|||
|
|
@ -48,117 +48,144 @@ hasErrors (Object object') = HashMap.member "errors" object'
|
|||
hasErrors _ = True
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Inline fragment executor" $ do
|
||||
it "chooses the first selection if the type matches" $ do
|
||||
actual <- graphql (garment "Hat" :| []) inlineQuery
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
spec = do
|
||||
describe "Inline fragment executor" $ do
|
||||
it "chooses the first selection if the type matches" $ do
|
||||
actual <- graphql (garment "Hat" :| []) inlineQuery
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "chooses the last selection if the type matches" $ do
|
||||
actual <- graphql (garment "Shirt" :| []) inlineQuery
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "size" .= ("L" :: Text)
|
||||
]
|
||||
]
|
||||
]
|
||||
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
|
||||
|
||||
it "evaluates fragments on Query" $ do
|
||||
let query = [r|{
|
||||
... {
|
||||
size
|
||||
}
|
||||
}|]
|
||||
|
||||
actual <- graphql (size :| []) query
|
||||
actual `shouldNotSatisfy` hasErrors
|
||||
|
||||
describe "Fragment spread executor" $ do
|
||||
it "evaluates fragment spreads" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "chooses the last selection if the type matches" $ do
|
||||
actual <- graphql (garment "Shirt" :| []) inlineQuery
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "size" .= ("L" :: Text)
|
||||
it "evaluates nested fragments" $ do
|
||||
let query = [r|
|
||||
{
|
||||
garment {
|
||||
...circumferenceFragment
|
||||
}
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
...hatFragment
|
||||
}
|
||||
|
||||
fragment hatFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (garment "Hat" :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "embeds inline fragments without type" $ do
|
||||
let query = [r|{
|
||||
garment {
|
||||
circumference
|
||||
... {
|
||||
size
|
||||
}
|
||||
}
|
||||
}|]
|
||||
resolvers = Schema.object "garment" $ return [circumference, size]
|
||||
it "rejects recursive fragments" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
actual <- graphql (resolvers :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
, "size" .= ("L" :: Text)
|
||||
fragment circumferenceFragment on Hat {
|
||||
...circumferenceFragment
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
actual `shouldSatisfy` hasErrors
|
||||
|
||||
it "considers type condition" $ do
|
||||
let query = [r|
|
||||
{
|
||||
garment {
|
||||
...circumferenceFragment
|
||||
...sizeFragment
|
||||
}
|
||||
}
|
||||
fragment circumferenceFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
fragment sizeFragment on Shirt {
|
||||
size
|
||||
}
|
||||
|]
|
||||
expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "evaluates fragments on Query" $ do
|
||||
let query = [r|{
|
||||
... {
|
||||
size
|
||||
}
|
||||
}|]
|
||||
|
||||
actual <- graphql (size :| []) query
|
||||
actual `shouldNotSatisfy` hasErrors
|
||||
|
||||
it "evaluates nested fragments" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
|
||||
fragment hatFragment on Hat {
|
||||
...circumferenceFragment
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "evaluates fragments defined in any order" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
...hatFragment
|
||||
}
|
||||
|
||||
fragment hatFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "rejects recursive" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
...circumferenceFragment
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
actual `shouldSatisfy` hasErrors
|
||||
actual <- graphql (garment "Hat" :| []) query
|
||||
actual `shouldBe` expected
|
||||
|
|
|
|||
Loading…
Reference in New Issue