morpheus-graphql-core 0.23.0 → 0.24.0

raw patch · 15 files changed

+115/−50 lines, 15 filesdep ~morpheus-graphql-testsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: morpheus-graphql-tests

API changes (from Hackage documentation)

Files

• morpheus-graphql-core.cabal +7/−3
• src/Data/Morpheus/Error.hs +2/−0
• src/Data/Morpheus/Error/Warning.hs +41/−4
• src/Data/Morpheus/Parsing/Request/Selection.hs +1/−0
• src/Data/Morpheus/Types/Internal/AST/Error.hs +3/−2
• src/Data/Morpheus/Types/Internal/AST/Selection.hs +12/−4
• src/Data/Morpheus/Types/SelectionTree.hs +2/−2
• src/Data/Morpheus/Validation/Query/Fragment.hs +3/−2
• src/Data/Morpheus/Validation/Query/UnionSelection.hs +25/−28
• test/query/parsing/selection-set/empty-selection-2/query.gql +6/−0
• test/query/parsing/selection-set/empty-selection-2/response.json +5/−0
• test/query/parsing/selection-set/non-empty-selection-2/query.gql +7/−0
• test/query/parsing/selection-set/non-empty-selection-2/response.json +1/−0
• test/rendering/union/interface/rendering.gql +0/−2
• test/rendering/union/union/rendering.gql +0/−3

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack  name:           morpheus-graphql-core-version:        0.23.0+version:        0.24.0 synopsis:       Morpheus GraphQL Core description:    Build GraphQL APIs with your favorite functional language! category:       web, graphql@@ -21,7 +21,9 @@     README.md     changelog.md data-files:+    test/query/parsing/selection-set/empty-selection-2/query.gql     test/query/parsing/selection-set/empty-selection/query.gql+    test/query/parsing/selection-set/non-empty-selection-2/query.gql     test/query/parsing/selection-set/non-empty-selection/query.gql     test/query/validation/__typename/arguments/query.gql     test/query/validation/__typename/schema.gql@@ -98,7 +100,9 @@     "test/schema/validation/schema-definition/fail/required query/schema-with-query/schema.gql"     test/schema/validation/schema-definition/fail/unknown-type/unknown/schema.gql     test/schema/validation/schema-definition/ok/full/schema.gql+    test/query/parsing/selection-set/empty-selection-2/response.json     test/query/parsing/selection-set/empty-selection/response.json+    test/query/parsing/selection-set/non-empty-selection-2/response.json     test/query/parsing/selection-set/non-empty-selection/response.json     test/query/validation/__typename/arguments/response.json     test/query/validation/__typename/selection-set/response.json@@ -270,7 +274,7 @@     , hashable >=1.0.0 && <2.0.0     , megaparsec >=7.0.0 && <10.0.0     , morpheus-graphql-core-    , morpheus-graphql-tests >=0.23.0 && <0.24.0+    , morpheus-graphql-tests >=0.24.0 && <0.25.0     , mtl >=2.0.0 && <3.0.0     , relude >=0.3.0 && <2.0.0     , scientific >=0.3.6.2 && <0.4.0

@@ -8,6 +8,8 @@     subfieldsNotSelected,     NameCollision (..),     gqlWarnings,+    printWarning,+    printError,   ) where 

@@ -1,5 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoImplicitPrelude #-}  module Data.Morpheus.Error.Warning@@ -7,6 +8,8 @@     deprecatedEnum,     deprecatedField,     gqlWarnings,+    printWarning,+    printError,   ) where @@ -14,17 +17,20 @@ import Data.ByteString.Lazy.Char8 (unpack) import Data.Morpheus.Types.Internal.AST.Base   ( Description,+    Position (..),     Ref (..),   ) import Data.Morpheus.Types.Internal.AST.Error-  ( GQLError,+  ( GQLError (..),     GQLErrors,+    PropName (..),     at,     msg,   ) import Data.Morpheus.Types.Internal.AST.Name   ( FieldName,   )+import qualified Data.Text as T import Language.Haskell.TH import Relude @@ -54,7 +60,38 @@  gqlWarnings :: [GQLError] -> Q () gqlWarnings [] = pure ()-gqlWarnings warnings = traverse_ handleWarning warnings+gqlWarnings warnings = traverse_ (reportWarning . printWarning) warnings++printWarning :: GQLError -> String+printWarning = printError "warning" "\x1b[33m"++printError :: String -> String -> GQLError -> String+printError label color warning =+  withColor (label <> ":")+    <> description+    <> loc+    <> printedPath+    <> "\n"   where-    handleWarning warning =-      reportWarning ("Morpheus GraphQL Warning: " <> (unpack . encode) warning)+    propPath = concat $ toList $ path warning+    propLoc = concat $ toList $ locations warning+    description = indent <> withColor (toString (message warning))+    loc+      | null propPath = ""+      | otherwise = indent <> "  locations: " <> concatMap printLocation propLoc+    printedPath+      | null propPath = ""+      | otherwise = indent <> "  path: " <> intercalate "." (map printPath propPath)++    withColor :: String -> String+    withColor x = color <> x <> "\x1b[0m"++indent :: String+indent = "\n      "++printPath :: PropName -> String+printPath (PropIndex x) = show x+printPath (PropName x) = T.unpack x++printLocation :: Position -> String+printLocation Position {..} = show line <> ":" <> show column

@@ -80,6 +80,7 @@       <*> maybeArguments       <*> optionalDirectives       <*> parseSelectionContent+      <*> pure empty  parseSelectionContent :: Parser (SelectionContent RAW) parseSelectionContent =

@@ -18,7 +18,8 @@     GQLErrors,     GQLError       ( message,-        locations+        locations,+        path       ),     manyMsg,     Msg (..),@@ -80,7 +81,7 @@ {-# INLINE atPositions #-}  withExtensions :: GQLError -> Map Text Value -> GQLError-withExtensions gqlerr ext = gqlerr {extensions = Just ext}+withExtensions gqlErr ext = gqlErr {extensions = Just ext}  withPath :: GQLError -> [PropName] -> GQLError withPath err [] = err

@@ -126,7 +126,7 @@   SelectionField :: SelectionContent s   SelectionSet :: SelectionSet s -> SelectionContent s   UnionSelection ::-    { defaultSelection :: SelectionSet VALID,+    { defaultSelection :: Maybe (SelectionSet VALID),       conditionalSelections :: UnionSelection VALID     } ->     SelectionContent VALID@@ -142,7 +142,7 @@     where       unionSelectionElements :: [Either (Selection VALID) UnionTag]       unionSelectionElements =-        map Left (toList interfaceFields)+        map Left (concatMap toList $ maybeToList interfaceFields)           <> map Right (sortOn unionTagName $ toList unionSets)  instance@@ -153,7 +153,7 @@   Merge (HistoryT m) (SelectionContent s)   where   merge (SelectionSet s1) (SelectionSet s2) = SelectionSet <$> merge s1 s2-  merge (UnionSelection m1 u1) (UnionSelection m2 u2) = UnionSelection <$> merge m1 m2 <*> merge u1 u2+  merge (UnionSelection m1 u1) (UnionSelection m2 u2) = UnionSelection <$> withMaybe m1 m2 <*> merge u1 u2   merge oldC currentC     | oldC == currentC = pure oldC     | otherwise = do@@ -163,6 +163,12 @@               `atPositions` fmap refPosition path           ) +withMaybe :: (Merge f a, Monad f) => Maybe a -> Maybe a -> f (Maybe a)+withMaybe (Just x) (Just y) = Just <$> merge x y+withMaybe (Just x) Nothing = pure $ Just x+withMaybe Nothing (Just y) = pure $ Just y+withMaybe Nothing Nothing = pure Nothing+ deriving instance Show (SelectionContent a)  deriving instance Eq (SelectionContent a)@@ -227,7 +233,8 @@       selectionName :: FieldName,       selectionArguments :: Arguments s,       selectionDirectives :: Directives s,-      selectionContent :: SelectionContent s+      selectionContent :: SelectionContent s,+      selectionOrigin :: Maybe FragmentName     } ->     Selection s   InlineFragment :: Fragment RAW -> Selection RAW@@ -287,6 +294,7 @@             { selectionAlias = mergeAlias,               selectionPosition = pos1,               selectionDirectives = dirs,+              selectionOrigin = Nothing,               ..             }     where

@@ -86,7 +86,7 @@     SelectionField -> mempty     (SelectionSet deeperSel) -> toList deeperSel     (UnionSelection interfaceSelection sel) ->-      toList interfaceSelection+      concatMap toList (toList interfaceSelection)         <> concatMap           (toList . unionTagSelection)           (toList sel)@@ -94,7 +94,7 @@   getChild name node = case selectionContent node of     SelectionField -> Nothing     (SelectionSet deeperSel) -> __lookup name deeperSel-    (UnionSelection interfaceSelection sel) -> select (interfaceSelection : map unionTagSelection (toList sel))+    (UnionSelection interfaceSelection sel) -> select (toList interfaceSelection <> map unionTagSelection (toList sel))       where         select (x : xs) = __lookup name x <|> select xs         select [] = Nothing

@@ -34,6 +34,7 @@     Position,     RAW,     Ref (..),+    Selection (..),     SelectionSet,     Stage,     TypeDefinition,@@ -71,8 +72,8 @@   Ref FragmentName ->   FragmentValidator s UnionTag validateSpread f allowedTargets ref = do-  fragment@Fragment {fragmentType} <- resolveSpread allowedTargets ref-  UnionTag fragmentType <$> validateFragmentSelection f fragment+  fragment@Fragment {fragmentType, fragmentName} <- resolveSpread allowedTargets ref+  UnionTag fragmentType . fmap (\s -> s {selectionOrigin = Just fragmentName}) <$> validateFragmentSelection f fragment  validateFragment ::   (Fragment RAW -> FragmentValidator s (SelectionSet VALID)) ->

@@ -14,6 +14,7 @@   ) where +import Control.Monad.Except (MonadError (throwError)) import qualified Data.HashMap.Lazy as HM import Data.Mergeable (OrdMap) import Data.Morpheus.Internal.Utils@@ -23,7 +24,6 @@     selectOr,     startHistory,   )-import Data.Morpheus.Types.Internal.AST.Base (Position (..)) import Data.Morpheus.Types.Internal.AST.Name (TypeName) import Data.Morpheus.Types.Internal.AST.Selection   ( Fragment (..),@@ -82,23 +82,13 @@   ) ->   OrdMap TypeName (TypeDefinition IMPLEMENTABLE VALID) ->   SelectionSet RAW ->-  FragmentValidator s ([UnionTag], SelectionSet RAW)+  FragmentValidator s ([UnionTag], Maybe (SelectionSet RAW)) exploreFragments validateFragment types selectionSet = do   (tags, selections) <- partitionEithers <$> traverse (splitFragment validateFragment (toList types)) (toList selectionSet)-  selectionPosition <- fromMaybe (Position 0 0) <$> asksScope position   (tags,)-    <$> fromElems-      ( ( Selection-            { selectionName = "__typename",-              selectionAlias = Nothing,-              selectionPosition,-              selectionArguments = empty,-              selectionContent = SelectionField,-              selectionDirectives = empty-            }-        )-          : selections-      )+    <$> if null selections+      then pure Nothing+      else Just <$> fromElems selections  -- sorts Fragment by conditional Types -- [@@ -134,18 +124,25 @@ getCompatibleTypes TypeDefinition {typeName, typeContent = DataObject {objectImplements}} = typeName : objectImplements getCompatibleTypes TypeDefinition {typeName} = [typeName] +maybeMerge :: [SelectionSet VALID] -> FragmentValidator s (Maybe (SelectionSet VALID))+maybeMerge [] = pure Nothing+maybeMerge (x : xs) = Just <$> startHistory (mergeConcat (x :| xs))++noEmptySelection :: FragmentValidator s a+noEmptySelection = throwError "empty selection sets are not supported."+ joinClusters ::-  SelectionSet VALID ->+  Maybe (SelectionSet VALID) ->   HashMap TypeName [SelectionSet VALID] ->   FragmentValidator s (SelectionContent VALID)-joinClusters selSet typedSelections-  | null typedSelections = pure (SelectionSet selSet)+joinClusters maybeSelSet typedSelections+  | null typedSelections = maybe noEmptySelection (pure . SelectionSet) maybeSelSet   | otherwise =       traverse mkUnionTag (HM.toList typedSelections)-        >>= fmap (UnionSelection selSet) . startHistory . fromElems+        >>= fmap (UnionSelection maybeSelSet) . startHistory . fromElems   where     mkUnionTag :: (TypeName, [SelectionSet VALID]) -> FragmentValidator s UnionTag-    mkUnionTag (typeName, fragments) = UnionTag typeName <$> startHistory (mergeConcat (selSet :| fragments))+    mkUnionTag (typeName, fragments) = UnionTag typeName <$> (maybeMerge (toList maybeSelSet <> fragments) >>= maybe noEmptySelection pure)  validateInterfaceSelection ::   ValidateFragmentSelection s =>@@ -161,10 +158,9 @@   inputSelectionSet = do     possibleTypes <- askInterfaceTypes typeDef     (spreads, selectionSet) <- exploreFragments validateFragment possibleTypes inputSelectionSet-    validSelectionSet <- validate typeDef selectionSet+    validSelectionSet <- traverse (validate typeDef) selectionSet     let tags = tagUnionFragments spreads possibleTypes-    let interfaces = selectOr [] id typeName tags-    defaultSelection <- startHistory $ mergeConcat (validSelectionSet :| interfaces)+    defaultSelection <- maybeMerge (toList validSelectionSet <> selectOr [] id typeName tags)     joinClusters defaultSelection (HM.delete typeName tags)  mkUnionRootType :: FragmentValidator s (TypeDefinition IMPLEMENTABLE VALID)@@ -177,9 +173,10 @@   UnionTypeDefinition OUT VALID ->   SelectionSet RAW ->   FragmentValidator s (SelectionContent VALID)-validateUnionSelection validateFragment validate members selectionSet = do-  unionTypes <- traverse (fmap toCategory . askTypeMember) members-  (spreads, selSet) <- exploreFragments validateFragment unionTypes selectionSet+validateUnionSelection validateFragment validate members inputSelectionSet = do   typeDef <- mkUnionRootType-  validSelection <- validate typeDef selSet-  joinClusters validSelection (tagUnionFragments spreads unionTypes)+  possibleTypes <- traverse (fmap toCategory . askTypeMember) members+  (spreads, selectionSet) <- exploreFragments validateFragment possibleTypes inputSelectionSet+  validSelectionSet <- traverse (validate typeDef) selectionSet+  let tags = tagUnionFragments spreads possibleTypes+  joinClusters validSelectionSet tags

@@ -0,0 +1,6 @@+query {+  field1 {+    ... on X {+    }+  }+}

@@ -0,0 +1,5 @@+[+  {+    "message": "empty selection sets are not supported."+  }+]

@@ -0,0 +1,7 @@+query {+  field1 {+    ... on X {+      name+    }+  }+}

@@ -0,0 +1,1 @@+"OK"

@@ -1,9 +1,7 @@ query {   character {-    __typename     name     ... on Hero {-      __typename       name       hobby     }

@@ -1,12 +1,9 @@ query {   mortal {-    __typename     ... on Animal {-      __typename       weight     }     ... on Human {-      __typename       name     }   }