From 11d2f7cb3b7c86917ff03bfe3eeac0b723eb3ff9 Mon Sep 17 00:00:00 2001 From: Thiago Rodrigues de Paula Date: Fri, 11 Jan 2019 11:09:08 +0100 Subject: [PATCH 1/5] Reduce operation type repetition --- src/GraphQL/Internal/Validation.hs | 52 +++++++++++++----------------- 1 file changed, 23 insertions(+), 29 deletions(-) diff --git a/src/GraphQL/Internal/Validation.hs b/src/GraphQL/Internal/Validation.hs index 88e02e1..fe0b8df 100644 --- a/src/GraphQL/Internal/Validation.hs +++ b/src/GraphQL/Internal/Validation.hs @@ -107,30 +107,33 @@ data QueryDocument value | MultipleOperations (Operations value) deriving (Eq, Show) +data OperationType + = Mutation + | Query + deriving (Eq, Show) + data Operation value - = Query VariableDefinitions (Directives value) (SelectionSetByType value) - | Mutation VariableDefinitions (Directives value) (SelectionSetByType value) + = Operation OperationType VariableDefinitions (Directives value) (SelectionSetByType value) deriving (Eq, Show) instance Functor Operation where - fmap f (Query vars directives selectionSet) = Query vars (fmap f directives) (fmap f selectionSet) - fmap f (Mutation vars directives selectionSet) = Mutation vars (fmap f directives) (fmap f selectionSet) + fmap f (Operation operationType vars directives selectionSet) + = Operation operationType vars (fmap f directives) (fmap f selectionSet) instance Foldable Operation where - foldMap f (Query _ directives selectionSet) = foldMap f directives `mappend` foldMap f selectionSet - foldMap f (Mutation _ directives selectionSet) = foldMap f directives `mappend` foldMap f selectionSet + foldMap f (Operation _ _ directives selectionSet) + = foldMap f directives `mappend` foldMap f selectionSet instance Traversable Operation where - traverse f (Query vars directives selectionSet) = Query vars <$> traverse f directives <*> traverse f selectionSet - traverse f (Mutation vars directives selectionSet) = Mutation vars <$> traverse f directives <*> traverse f selectionSet + traverse f (Operation operationType vars directives selectionSet) + = Operation operationType vars <$> traverse f directives <*> traverse f selectionSet -- | Get the selection set for an operation. getSelectionSet :: Operation value -> SelectionSetByType value -getSelectionSet (Query _ _ ss) = ss -getSelectionSet (Mutation _ _ ss) = ss +getSelectionSet (Operation _ _ _ ss) = ss -- | Type alias for 'Query' and 'Mutation' constructors of 'Operation'. -type OperationType value = VariableDefinitions -> Directives value -> SelectionSetByType value -> Operation value +type OperationBuilder value = VariableDefinitions -> Directives value -> SelectionSetByType value -> Operation value type Operations value = Map (Maybe Name) (Operation value) @@ -154,7 +157,7 @@ validate schema (AST.QueryDocument defns) = runValidator $ do assertAllFragmentsUsed frags (visitedFrags <> usedFrags) validValuesSS <- validateValues ss resolvedValuesSS <- resolveVariables emptyVariableDefinitions validValuesSS - pure (LoneAnonymousOperation (Query emptyVariableDefinitions emptyDirectives resolvedValuesSS)) + pure (LoneAnonymousOperation (Operation Query emptyVariableDefinitions emptyDirectives resolvedValuesSS)) _ -> throwE (MixedAnonymousOperations (length anonymous) (map fst maybeNamed)) where @@ -165,23 +168,23 @@ validate schema (AST.QueryDocument defns) = runValidator $ do splitDefns (AST.DefinitionFragment frag) = Right frag splitOps (AST.AnonymousQuery ss) = Left ss - splitOps (AST.Query node@(AST.Node maybeName _ _ _)) = Right (maybeName, (Query, node)) - splitOps (AST.Mutation node@(AST.Node maybeName _ _ _)) = Right (maybeName, (Mutation, node)) + splitOps (AST.Query node@(AST.Node maybeName _ _ _)) = Right (maybeName, (Operation Query, node)) + splitOps (AST.Mutation node@(AST.Node maybeName _ _ _)) = Right (maybeName, (Operation Mutation, node)) assertAllFragmentsUsed :: Fragments value -> Set (Maybe Name) -> Validation () assertAllFragmentsUsed fragments used = - let unused = ( Set.map pure (Map.keysSet fragments)) `Set.difference` used + let unused = Set.map pure (Map.keysSet fragments) `Set.difference` used in unless (Set.null unused) (throwE (UnusedFragments unused)) -- * Operations -validateOperations :: Schema -> Fragments AST.Value -> [(Maybe Name, (OperationType AST.Value, AST.Node))] -> StateT (Set (Maybe Name)) Validation (Operations AST.Value) +validateOperations :: Schema -> Fragments AST.Value -> [(Maybe Name, (OperationBuilder AST.Value, AST.Node))] -> StateT (Set (Maybe Name)) Validation (Operations AST.Value) validateOperations schema fragments ops = do deduped <- lift (mapErrors DuplicateOperation (makeMap ops)) traverse validateNode deduped where - validateNode (operationType, AST.Node _ vars directives ss) = - operationType <$> lift (validateVariableDefinitions schema vars) + validateNode (operationBuilder, AST.Node _ vars directives ss) = + operationBuilder <$> lift (validateVariableDefinitions schema vars) <*> lift (validateDirectives directives) <*> validateSelectionSet schema fragments ss @@ -189,17 +192,8 @@ validateOperations schema fragments ops = do -- Operation constructor or give all the fields accessors. This duplication is -- driving me batty. validateOperation :: Operation AST.Value -> Validation (Operation VariableValue) -validateOperation (Query vars directives selectionSet) = do - validValues <- Query vars <$> validateValues directives <*> validateValues selectionSet - -- Instead of doing this, we could build up a list of used variables as we - -- resolve them. - let usedVariables = getVariables validValues - let definedVariables = getDefinedVariables vars - let unusedVariables = definedVariables `Set.difference` usedVariables - unless (Set.null unusedVariables) $ throwE (UnusedVariables unusedVariables) - resolveVariables vars validValues -validateOperation (Mutation vars directives selectionSet) = do - validValues <- Mutation vars <$> validateValues directives <*> validateValues selectionSet +validateOperation (Operation operationType vars directives selectionSet) = do + validValues <- Operation operationType vars <$> validateValues directives <*> validateValues selectionSet -- Instead of doing this, we could build up a list of used variables as we -- resolve them. let usedVariables = getVariables validValues From dd16e0e9b1564c6611c38f0d41545517296433bf Mon Sep 17 00:00:00 2001 From: Thiago Rodrigues de Paula Date: Fri, 11 Jan 2019 11:10:15 +0100 Subject: [PATCH 2/5] Remove comment --- src/GraphQL/Internal/Validation.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/GraphQL/Internal/Validation.hs b/src/GraphQL/Internal/Validation.hs index fe0b8df..080fd73 100644 --- a/src/GraphQL/Internal/Validation.hs +++ b/src/GraphQL/Internal/Validation.hs @@ -188,9 +188,6 @@ validateOperations schema fragments ops = do <*> lift (validateDirectives directives) <*> validateSelectionSet schema fragments ss --- TODO: Either make operation type (Query, Mutation) a parameter of an --- Operation constructor or give all the fields accessors. This duplication is --- driving me batty. validateOperation :: Operation AST.Value -> Validation (Operation VariableValue) validateOperation (Operation operationType vars directives selectionSet) = do validValues <- Operation operationType vars <$> validateValues directives <*> validateValues selectionSet From ee4533e322e60da98461ab468aa32960784603fd Mon Sep 17 00:00:00 2001 From: Thiago Rodrigues de Paula Date: Fri, 11 Jan 2019 11:27:20 +0100 Subject: [PATCH 3/5] Add documentation --- src/GraphQL/Internal/Validation.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/GraphQL/Internal/Validation.hs b/src/GraphQL/Internal/Validation.hs index 080fd73..3d089c6 100644 --- a/src/GraphQL/Internal/Validation.hs +++ b/src/GraphQL/Internal/Validation.hs @@ -107,8 +107,12 @@ data QueryDocument value | MultipleOperations (Operations value) deriving (Eq, Show) + +-- | The type of an operation data OperationType + -- | Represents a Mutation operation = Mutation + -- | Represents a Query operation | Query deriving (Eq, Show) From 88ca679609349da3899f37e97f26b7499be7d697 Mon Sep 17 00:00:00 2001 From: Thiago Rodrigues de Paula Date: Fri, 11 Jan 2019 11:34:57 +0100 Subject: [PATCH 4/5] Adapt coverage tolerance --- scripts/hpc-ratchet | 6 +++--- src/GraphQL/Internal/Validation.hs | 3 --- 2 files changed, 3 insertions(+), 6 deletions(-) diff --git a/scripts/hpc-ratchet b/scripts/hpc-ratchet index 0ce8298..59ea746 100755 --- a/scripts/hpc-ratchet +++ b/scripts/hpc-ratchet @@ -35,10 +35,10 @@ In a just world, this would be a separate config file, or command-line arguments Each item represents the number of "things" we are OK with not being covered. """ COVERAGE_TOLERANCE = { - ALTERNATIVES: 161, + ALTERNATIVES: 155, BOOLEANS: 8, - EXPRESSIONS: 1412, - LOCAL_DECLS: 13, + EXPRESSIONS: 1366, + LOCAL_DECLS: 10, TOP_LEVEL_DECLS: 669, } diff --git a/src/GraphQL/Internal/Validation.hs b/src/GraphQL/Internal/Validation.hs index 3d089c6..9ad0eb5 100644 --- a/src/GraphQL/Internal/Validation.hs +++ b/src/GraphQL/Internal/Validation.hs @@ -108,11 +108,8 @@ data QueryDocument value deriving (Eq, Show) --- | The type of an operation data OperationType - -- | Represents a Mutation operation = Mutation - -- | Represents a Query operation | Query deriving (Eq, Show) From 863f5f8753b2c340df97681d112f8360ba5c0da0 Mon Sep 17 00:00:00 2001 From: Thiago Rodrigues de Paula Date: Fri, 11 Jan 2019 11:42:40 +0100 Subject: [PATCH 5/5] Adapt coverage tolerance --- scripts/hpc-ratchet | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scripts/hpc-ratchet b/scripts/hpc-ratchet index 59ea746..8332502 100755 --- a/scripts/hpc-ratchet +++ b/scripts/hpc-ratchet @@ -39,7 +39,7 @@ COVERAGE_TOLERANCE = { BOOLEANS: 8, EXPRESSIONS: 1366, LOCAL_DECLS: 10, - TOP_LEVEL_DECLS: 669, + TOP_LEVEL_DECLS: 673, }