Provide custom Show instances for AST values

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

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

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

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
+stringValue Minified string = Builder.toLazyText $ oneLine string
-    $ quote <> Text.foldr (mappend . escape) quote 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
 

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

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]