From b27da54bf4d4c75447c1cad4329c2b28ae2c6c82 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Thu, 4 Feb 2021 08:12:12 +0100 Subject: [PATCH] Provide custom Show instances for AST values --- CHANGELOG.md | 2 +- graphql.cabal | 3 +- src/Language/GraphQL/AST/Document.hs | 64 ++++++++++++++++++++-- src/Language/GraphQL/AST/Encoder.hs | 25 ++------- tests/Language/GraphQL/AST/DocumentSpec.hs | 20 +++++++ tests/Language/GraphQL/ValidateSpec.hs | 2 +- 6 files changed, 89 insertions(+), 27 deletions(-) create mode 100644 tests/Language/GraphQL/AST/DocumentSpec.hs diff --git a/CHANGELOG.md b/CHANGELOG.md index 1ba5c58..acc418d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,7 +16,7 @@ and this project adheres to - `Type.Schema.implementations` contains a map from interfaces and objects to interfaces they implement. - Show instances for GraphQL type definitions in the `Type` modules. -- Custom Show instances for the type representation in the AST. +- Custom Show instances for type and value representations in the AST. ## [0.11.0.0] - 2020-11-07 ### Changed diff --git a/graphql.cabal b/graphql.cabal index ebc3f4b..f51e6d1 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -4,7 +4,7 @@ cabal-version: 2.2 -- -- see: https://github.com/sol/hpack -- --- hash: c89b0164372b6e02e4f338d3865dd6bb9dfd1a4475f25d808450480d73f94f91 +-- hash: 55ede035c74b423b607abac158fb26436e4ea06a43fecdcc2ef42423e63597fc name: graphql version: 0.11.0.0 @@ -78,6 +78,7 @@ test-suite graphql-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + Language.GraphQL.AST.DocumentSpec Language.GraphQL.AST.EncoderSpec Language.GraphQL.AST.LexerSpec Language.GraphQL.AST.ParserSpec diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index a65a01d..a78b007 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE Safe #-} @@ -47,11 +48,15 @@ module Language.GraphQL.AST.Document , UnionMemberTypes(..) , Value(..) , VariableDefinition(..) + , escape ) where +import Data.Char (ord) import Data.Foldable (toList) import Data.Int (Int32) +import Data.List (intercalate) import Data.List.NonEmpty (NonEmpty) +import Numeric (showFloat, showHex) import Data.Text (Text) import qualified Data.Text as Text import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation) @@ -79,7 +84,10 @@ instance Ord Location where data Node a = Node { node :: a , location :: Location - } deriving (Eq, Show) + } deriving Eq + +instance Show a => Show (Node a) where + show Node{ node } = show node instance Functor Node where fmap f Node{..} = Node (f node) location @@ -218,6 +226,28 @@ type TypeCondition = Name -- ** Input Values +escape :: Char -> String +escape char' + | char' == '\\' = "\\\\" + | char' == '\"' = "\\\"" + | char' == '\b' = "\\b" + | char' == '\f' = "\\f" + | char' == '\n' = "\\n" + | char' == '\r' = "\\r" + | char' == '\t' = "\\t" + | char' < '\x0010' = unicode "\\u000" char' + | char' < '\x0020' = unicode "\\u00" char' + | otherwise = [char'] + where + unicode prefix uchar = prefix <> (showHex $ ord uchar) "" + +showList' :: Show a => [a] -> String +showList' list = "[" ++ intercalate ", " (show <$> list) ++ "]" + +showObject :: Show a => [ObjectField a] -> String +showObject fields = + "{ " ++ intercalate ", " (show <$> fields) ++ " }" + -- | Input value (literal or variable). data Value = Variable Name @@ -229,7 +259,19 @@ data Value | Enum Name | List [Value] | Object [ObjectField Value] - deriving (Eq, Show) + deriving Eq + +instance Show Value where + showList = mappend . showList' + show (Variable variableName) = '$' : Text.unpack variableName + show (Int integer) = show integer + show (Float float) = show $ ConstFloat float + show (String text) = show $ ConstString text + show (Boolean boolean) = show boolean + show Null = "null" + show (Enum name) = Text.unpack name + show (List list) = show list + show (Object fields) = showObject fields -- | Constant input value. data ConstValue @@ -241,7 +283,18 @@ data ConstValue | ConstEnum Name | ConstList [ConstValue] | ConstObject [ObjectField ConstValue] - deriving (Eq, Show) + deriving Eq + +instance Show ConstValue where + showList = mappend . showList' + show (ConstInt integer) = show integer + show (ConstFloat float) = showFloat float mempty + show (ConstString text) = "\"" <> Text.foldr (mappend . escape) "\"" text + show (ConstBoolean boolean) = show boolean + show ConstNull = "null" + show (ConstEnum name) = Text.unpack name + show (ConstList list) = show list + show (ConstObject fields) = showObject fields -- | Key-value pair. -- @@ -250,7 +303,10 @@ data ObjectField a = ObjectField { name :: Name , value :: Node a , location :: Location - } deriving (Eq, Show) + } deriving Eq + +instance Show a => Show (ObjectField a) where + show ObjectField{..} = Text.unpack name ++ ": " ++ show value instance Functor ObjectField where fmap f ObjectField{..} = ObjectField name (f <$> value) location diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs index 9ba51b8..f04f385 100644 --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -16,7 +16,6 @@ module Language.GraphQL.AST.Encoder , value ) where -import Data.Char (ord) import Data.Foldable (fold) import qualified Data.List.NonEmpty as NonEmpty import Data.Text (Text) @@ -25,7 +24,7 @@ import qualified Data.Text.Lazy as Lazy (Text) import qualified Data.Text.Lazy as Lazy.Text import Data.Text.Lazy.Builder (Builder) import qualified Data.Text.Lazy.Builder as Builder -import Data.Text.Lazy.Builder.Int (decimal, hexadecimal) +import Data.Text.Lazy.Builder.Int (decimal) import Data.Text.Lazy.Builder.RealFloat (realFloat) import qualified Language.GraphQL.AST.Document as Full @@ -234,11 +233,12 @@ quote :: Builder.Builder quote = Builder.singleton '\"' oneLine :: Text -> Builder -oneLine string = quote <> Text.foldr (mappend . escape) quote string +oneLine string = quote <> Text.foldr merge quote string + where + merge = mappend . Builder.fromString . Full.escape stringValue :: Formatter -> Text -> Lazy.Text -stringValue Minified string = Builder.toLazyText - $ quote <> Text.foldr (mappend . escape) quote string +stringValue Minified string = Builder.toLazyText $ oneLine string stringValue (Pretty indentation) string = if hasEscaped string then stringValue Minified string @@ -266,21 +266,6 @@ stringValue (Pretty indentation) string = = Builder.fromLazyText (indent (indentation + 1)) <> line' <> newline <> acc -escape :: Char -> Builder -escape char' - | char' == '\\' = Builder.fromString "\\\\" - | char' == '\"' = Builder.fromString "\\\"" - | char' == '\b' = Builder.fromString "\\b" - | char' == '\f' = Builder.fromString "\\f" - | char' == '\n' = Builder.fromString "\\n" - | char' == '\r' = Builder.fromString "\\r" - | char' == '\t' = Builder.fromString "\\t" - | char' < '\x0010' = unicode "\\u000" char' - | char' < '\x0020' = unicode "\\u00" char' - | otherwise = Builder.singleton char' - where - unicode prefix = mappend (Builder.fromString prefix) . (hexadecimal . ord) - listValue :: Formatter -> [Full.Value] -> Lazy.Text listValue formatter = bracketsCommas formatter $ value formatter diff --git a/tests/Language/GraphQL/AST/DocumentSpec.hs b/tests/Language/GraphQL/AST/DocumentSpec.hs new file mode 100644 index 0000000..ca13e17 --- /dev/null +++ b/tests/Language/GraphQL/AST/DocumentSpec.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +module Language.GraphQL.AST.DocumentSpec + ( spec + ) where + +import Language.GraphQL.AST.Document +import Test.Hspec (Spec, describe, it, shouldBe) + +spec :: Spec +spec = do + describe "Document" $ do + it "shows objects" $ + let zero = Location 0 0 + object = ConstObject + [ ObjectField "field1" (Node (ConstFloat 1.2) zero) zero + , ObjectField "field2" (Node ConstNull zero) zero + ] + expected = "{ field1: 1.2, field2: null }" + in show object `shouldBe` expected diff --git a/tests/Language/GraphQL/ValidateSpec.hs b/tests/Language/GraphQL/ValidateSpec.hs index 24b0ad0..b47149d 100644 --- a/tests/Language/GraphQL/ValidateSpec.hs +++ b/tests/Language/GraphQL/ValidateSpec.hs @@ -851,7 +851,7 @@ spec = |] expected = Error { message = - "Value ConstInt 3 cannot be coerced to type \"Boolean\"." + "Value 3 cannot be coerced to type \"Boolean\"." , locations = [AST.Location 4 48] } in validate queryString `shouldBe` [expected]