Compare commits

..

1 Commits

Author SHA1 Message Date
1b3727bc05 Remove cariage return from the qq string 2023-08-05 18:04:23 +02:00
11 changed files with 84 additions and 56 deletions

View File

@ -9,7 +9,6 @@ and this project adheres to
## [Unreleased] ## [Unreleased]
### Fixed ### Fixed
- `gql` removes not only leading `\n` but also `\r`. - `gql` removes not only leading `\n` but also `\r`.
- Fix non nullable type string representation in executor error messages.
## [1.2.0.1] - 2023-04-25 ## [1.2.0.1] - 2023-04-25
### Fixed ### Fixed

View File

@ -22,7 +22,7 @@ extra-source-files:
README.md README.md
tested-with: tested-with:
GHC == 9.2.8, GHC == 9.2.8,
GHC == 9.6.3 GHC == 9.6.2
source-repository head source-repository head
type: git type: git
@ -85,6 +85,7 @@ test-suite graphql-test
Language.GraphQL.Execute.CoerceSpec Language.GraphQL.Execute.CoerceSpec
Language.GraphQL.Execute.OrderedMapSpec Language.GraphQL.Execute.OrderedMapSpec
Language.GraphQL.ExecuteSpec Language.GraphQL.ExecuteSpec
Language.GraphQL.THSpec
Language.GraphQL.Type.OutSpec Language.GraphQL.Type.OutSpec
Language.GraphQL.Validate.RulesSpec Language.GraphQL.Validate.RulesSpec
Schemas.HeroSchema Schemas.HeroSchema
@ -106,6 +107,4 @@ test-suite graphql-test
unordered-containers, unordered-containers,
containers, containers,
vector vector
build-tool-depends:
hspec-discover:hspec-discover
default-language: Haskell2010 default-language: Haskell2010

View File

@ -371,8 +371,8 @@ data NonNullType
deriving Eq deriving Eq
instance Show NonNullType where instance Show NonNullType where
show (NonNullTypeNamed typeName) = Text.unpack $ typeName <> "!" show (NonNullTypeNamed typeName) = '!' : Text.unpack typeName
show (NonNullTypeList listType) = concat ["[", show listType, "]!"] show (NonNullTypeList listType) = concat ["![", show listType, "]"]
-- ** Directives -- ** Directives

View File

@ -556,24 +556,33 @@ coerceArgumentValues argumentDefinitions argumentValues =
$ Just inputValue $ Just inputValue
| otherwise -> throwM | otherwise -> throwM
$ InputCoercionException (Text.unpack argumentName) variableType Nothing $ InputCoercionException (Text.unpack argumentName) variableType Nothing
matchFieldValues' = matchFieldValues coerceArgumentValue matchFieldValues' = matchFieldValues coerceArgumentValue
$ Full.node <$> argumentValues $ Full.node <$> argumentValues
coerceArgumentValue inputType (Transform.Int integer) =
coerceArgumentValue inputType transform = coerceInputLiteral inputType (Type.Int integer)
coerceInputLiteral inputType $ extractArgumentValue transform coerceArgumentValue inputType (Transform.Boolean boolean) =
coerceInputLiteral inputType (Type.Boolean boolean)
extractArgumentValue (Transform.Int integer) = Type.Int integer coerceArgumentValue inputType (Transform.String string) =
extractArgumentValue (Transform.Boolean boolean) = Type.Boolean boolean coerceInputLiteral inputType (Type.String string)
extractArgumentValue (Transform.String string) = Type.String string coerceArgumentValue inputType (Transform.Float float) =
extractArgumentValue (Transform.Float float) = Type.Float float coerceInputLiteral inputType (Type.Float float)
extractArgumentValue (Transform.Enum enum) = Type.Enum enum coerceArgumentValue inputType (Transform.Enum enum) =
extractArgumentValue Transform.Null = Type.Null coerceInputLiteral inputType (Type.Enum enum)
extractArgumentValue (Transform.List list) = coerceArgumentValue inputType Transform.Null
Type.List $ extractArgumentValue <$> list | In.isNonNullType inputType = Nothing
extractArgumentValue (Transform.Object object) = | otherwise = coerceInputLiteral inputType Type.Null
Type.Object $ extractArgumentValue <$> object coerceArgumentValue (In.ListBaseType inputType) (Transform.List list) =
extractArgumentValue (Transform.Variable variable) = variable let coerceItem = coerceArgumentValue inputType
in Type.List <$> traverse coerceItem list
coerceArgumentValue (In.InputObjectBaseType inputType) (Transform.Object object)
| In.InputObjectType _ _ inputFields <- inputType =
let go = forEachField object
resultMap = HashMap.foldrWithKey go (pure mempty) inputFields
in Type.Object <$> resultMap
coerceArgumentValue _ (Transform.Variable variable) = pure variable
coerceArgumentValue _ _ = Nothing
forEachField object variableName (In.InputField _ variableType defaultValue) =
matchFieldValues coerceArgumentValue object variableName variableType defaultValue
collectFields :: Monad m collectFields :: Monad m
=> Out.ObjectType m => Out.ObjectType m

View File

@ -12,17 +12,26 @@ import Language.Haskell.TH (Exp(..), Lit(..))
stripIndentation :: String -> String stripIndentation :: String -> String
stripIndentation code = reverse stripIndentation code = reverse
$ dropNewlines $ dropWhile isLineBreak
$ reverse $ reverse
$ unlines $ unlines
$ indent spaces <$> lines withoutLeadingNewlines $ indent spaces <$> lines' withoutLeadingNewlines
where where
indent 0 xs = xs indent 0 xs = xs
indent count (' ' : xs) = indent (count - 1) xs indent count (' ' : xs) = indent (count - 1) xs
indent _ xs = xs indent _ xs = xs
withoutLeadingNewlines = dropNewlines code withoutLeadingNewlines = dropWhile isLineBreak code
dropNewlines = dropWhile $ flip any ['\n', '\r'] . (==)
spaces = length $ takeWhile (== ' ') withoutLeadingNewlines spaces = length $ takeWhile (== ' ') withoutLeadingNewlines
lines' "" = []
lines' string =
let (line, rest) = break isLineBreak string
reminder =
case rest of
[] -> []
'\r' : '\n' : strippedString -> lines strippedString
_ : strippedString -> lines strippedString
in line : reminder
isLineBreak = flip any ['\n', '\r'] . (==)
-- | Removes leading and trailing newlines. Indentation of the first line is -- | Removes leading and trailing newlines. Indentation of the first line is
-- removed from each line of the string. -- removed from each line of the string.

View File

@ -18,8 +18,6 @@ module Language.GraphQL.Type.Definition
, float , float
, id , id
, int , int
, showNonNullType
, showNonNullListType
, selection , selection
, string , string
) where ) where
@ -209,11 +207,3 @@ include = handle include'
(Just (Boolean True)) -> Include directive' (Just (Boolean True)) -> Include directive'
_ -> Skip _ -> Skip
include' directive' = Continue directive' include' directive' = Continue directive'
showNonNullType :: Show a => a -> String
showNonNullType = (++ "!") . show
showNonNullListType :: Show a => a -> String
showNonNullListType listType =
let representation = show listType
in concat ["[", representation, "]!"]

View File

@ -66,11 +66,10 @@ instance Show Type where
show (NamedEnumType enumType) = show enumType show (NamedEnumType enumType) = show enumType
show (NamedInputObjectType inputObjectType) = show inputObjectType show (NamedInputObjectType inputObjectType) = show inputObjectType
show (ListType baseType) = concat ["[", show baseType, "]"] show (ListType baseType) = concat ["[", show baseType, "]"]
show (NonNullScalarType scalarType) = Definition.showNonNullType scalarType show (NonNullScalarType scalarType) = '!' : show scalarType
show (NonNullEnumType enumType) = Definition.showNonNullType enumType show (NonNullEnumType enumType) = '!' : show enumType
show (NonNullInputObjectType inputObjectType) = show (NonNullInputObjectType inputObjectType) = '!' : show inputObjectType
Definition.showNonNullType inputObjectType show (NonNullListType baseType) = concat ["![", show baseType, "]"]
show (NonNullListType baseType) = Definition.showNonNullListType baseType
-- | Field argument definition. -- | Field argument definition.
data Argument = Argument (Maybe Text) Type (Maybe Definition.Value) data Argument = Argument (Maybe Text) Type (Maybe Definition.Value)

View File

@ -115,12 +115,12 @@ instance forall a. Show (Type a) where
show (NamedInterfaceType interfaceType) = show interfaceType show (NamedInterfaceType interfaceType) = show interfaceType
show (NamedUnionType unionType) = show unionType show (NamedUnionType unionType) = show unionType
show (ListType baseType) = concat ["[", show baseType, "]"] show (ListType baseType) = concat ["[", show baseType, "]"]
show (NonNullScalarType scalarType) = showNonNullType scalarType show (NonNullScalarType scalarType) = '!' : show scalarType
show (NonNullEnumType enumType) = showNonNullType enumType show (NonNullEnumType enumType) = '!' : show enumType
show (NonNullObjectType inputObjectType) = showNonNullType inputObjectType show (NonNullObjectType inputObjectType) = '!' : show inputObjectType
show (NonNullInterfaceType interfaceType) = showNonNullType interfaceType show (NonNullInterfaceType interfaceType) = '!' : show interfaceType
show (NonNullUnionType unionType) = showNonNullType unionType show (NonNullUnionType unionType) = '!' : show unionType
show (NonNullListType baseType) = showNonNullListType baseType show (NonNullListType baseType) = concat ["![", show baseType, "]"]
-- | Matches either 'NamedScalarType' or 'NonNullScalarType'. -- | Matches either 'NamedScalarType' or 'NonNullScalarType'.
pattern ScalarBaseType :: forall m. ScalarType -> Type m pattern ScalarBaseType :: forall m. ScalarType -> Type m

View File

@ -295,7 +295,7 @@ spec =
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error executionErrors = pure $ Error
{ message = { message =
"Value completion error. Expected type School!, found: EXISTENTIALISM." "Value completion error. Expected type !School, found: EXISTENTIALISM."
, locations = [Location 1 17] , locations = [Location 1 17]
, path = [Segment "philosopher", Segment "school"] , path = [Segment "philosopher", Segment "school"]
} }
@ -307,7 +307,7 @@ spec =
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error executionErrors = pure $ Error
{ message = { message =
"Value completion error. Expected type Interest!, found: { instrument: \"piano\" }." "Value completion error. Expected type !Interest, found: { instrument: \"piano\" }."
, locations = [Location 1 17] , locations = [Location 1 17]
, path = [Segment "philosopher", Segment "interest"] , path = [Segment "philosopher", Segment "interest"]
} }
@ -319,7 +319,7 @@ spec =
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error executionErrors = pure $ Error
{ message { message
= "Value completion error. Expected type Work!, found:\ = "Value completion error. Expected type !Work, found:\
\ { title: \"Also sprach Zarathustra: Ein Buch f\252r Alle und Keinen\" }." \ { title: \"Also sprach Zarathustra: Ein Buch f\252r Alle und Keinen\" }."
, locations = [Location 1 17] , locations = [Location 1 17]
, path = [Segment "philosopher", Segment "majorWork"] , path = [Segment "philosopher", Segment "majorWork"]
@ -343,7 +343,7 @@ spec =
it "gives location information for failed result coercion" $ it "gives location information for failed result coercion" $
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error executionErrors = pure $ Error
{ message = "Unable to coerce result to Int!." { message = "Unable to coerce result to !Int."
, locations = [Location 1 26] , locations = [Location 1 26]
, path = [Segment "philosopher", Segment "century"] , path = [Segment "philosopher", Segment "century"]
} }
@ -364,7 +364,7 @@ spec =
it "sets data to null if a root field isn't nullable" $ it "sets data to null if a root field isn't nullable" $
let executionErrors = pure $ Error let executionErrors = pure $ Error
{ message = "Unable to coerce result to Int!." { message = "Unable to coerce result to !Int."
, locations = [Location 1 3] , locations = [Location 1 3]
, path = [Segment "count"] , path = [Segment "count"]
} }
@ -375,7 +375,7 @@ spec =
it "detects nullability errors" $ it "detects nullability errors" $
let data'' = Object $ HashMap.singleton "philosopher" Null let data'' = Object $ HashMap.singleton "philosopher" Null
executionErrors = pure $ Error executionErrors = pure $ Error
{ message = "Value completion error. Expected type String!, found: null." { message = "Value completion error. Expected type !String, found: null."
, locations = [Location 1 26] , locations = [Location 1 26]
, path = [Segment "philosopher", Segment "firstLanguage"] , path = [Segment "philosopher", Segment "firstLanguage"]
} }

View File

@ -0,0 +1,23 @@
{- This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE QuasiQuotes #-}
module Language.GraphQL.THSpec
( spec
) where
import Language.GraphQL.TH (gql)
import Test.Hspec (Spec, describe, it, shouldBe)
spec :: Spec
spec =
describe "gql" $
it "replaces CRNL with NL" $
let expected = "line1\nline2"
actual = [gql|
line1
line2
|]
in actual `shouldBe` expected

View File

@ -878,7 +878,7 @@ spec =
{ message = { message =
"Variable \"$dogCommandArg\" of type \ "Variable \"$dogCommandArg\" of type \
\\"DogCommand\" used in position expecting type \ \\"DogCommand\" used in position expecting type \
\\"DogCommand!\"." \\"!DogCommand\"."
, locations = [AST.Location 1 26] , locations = [AST.Location 1 26]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
@ -925,7 +925,7 @@ spec =
|] |]
expected = Error expected = Error
{ message = { message =
"Value 3 cannot be coerced to type \"CatCommand!\"." "Value 3 cannot be coerced to type \"!CatCommand\"."
, locations = [AST.Location 3 36] , locations = [AST.Location 3 36]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]
@ -940,7 +940,7 @@ spec =
|] |]
expected = Error expected = Error
{ message = { message =
"Value 3 cannot be coerced to type \"String!\"." "Value 3 cannot be coerced to type \"!String\"."
, locations = [AST.Location 2 28] , locations = [AST.Location 2 28]
} }
in validate queryString `shouldBe` [expected] in validate queryString `shouldBe` [expected]