diff --git a/CHANGELOG.md b/CHANGELOG.md index 61c9e33..d2aab3a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,8 @@ All notable changes to this project will be documented in this file. ### Added - `executeWithName` executes an operation with the given name. - Export `Language.GraphQL.Encoder.definition`. +- Export `Language.GraphQL.Encoder.value`. Escapes \ and " in strings now. +- Export `Language.GraphQL.Encoder.type'`. ### Changed - `Operation` includes now possible operation name which allows to support diff --git a/graphql.cabal b/graphql.cabal index dc4bf54..0a43ff4 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: dca80d6bcaa432cabc2499efc9f047c6f59546bc2ba75b35fed6efd694895598 +-- hash: cb68243309f47fc44768d14981c4f6f8b3f1bb9dc37dd17a63996418d6aac375 name: graphql version: 0.4.0.0 @@ -66,6 +66,7 @@ test-suite tasty type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + Language.GraphQL.EncoderSpec Language.GraphQL.ErrorSpec Language.GraphQL.LexerSpec Language.GraphQL.ParserSpec diff --git a/src/Language/GraphQL/Encoder.hs b/src/Language/GraphQL/Encoder.hs index b246e14..71c7145 100644 --- a/src/Language/GraphQL/Encoder.hs +++ b/src/Language/GraphQL/Encoder.hs @@ -8,6 +8,8 @@ module Language.GraphQL.Encoder , document , minified , pretty + , type' + , value ) where import Data.Foldable (fold) @@ -84,7 +86,7 @@ variableDefinition :: Formatter -> VariableDefinition -> Text variableDefinition formatter (VariableDefinition var ty dv) = variable var <> eitherFormat formatter ": " ":" - <> type_ ty + <> type' ty <> maybe mempty (defaultValue formatter) dv defaultValue :: Formatter -> Value -> Text @@ -160,8 +162,19 @@ fragmentDefinition formatter (FragmentDefinition name tc dirs sels) <> eitherFormat formatter " " mempty <> selectionSet formatter sels --- * Values +-- * Directives +directives :: Formatter -> Directives -> Text +directives formatter@(Pretty _) = Text.Lazy.cons ' ' . spaces (directive formatter) +directives Minified = spaces (directive Minified) + +directive :: Formatter -> Directive -> Text +directive formatter (Directive name args) + = "@" <> Text.Lazy.fromStrict name <> optempty (arguments formatter) args + +-- * Miscellaneous + +-- | Converts a 'Value' into a string. value :: Formatter -> Value -> Text value _ (ValueVariable x) = variable x value _ (ValueInt x) = toLazyText $ decimal x @@ -177,9 +190,11 @@ booleanValue :: Bool -> Text booleanValue True = "true" booleanValue False = "false" --- TODO: Escape characters stringValue :: Text -> Text -stringValue = quotes +stringValue + = quotes + . Text.Lazy.replace "\"" "\\\"" + . Text.Lazy.replace "\\" "\\\\" listValue :: Formatter -> [Value] -> Text listValue formatter = bracketsCommas formatter $ value formatter @@ -201,25 +216,14 @@ objectField formatter (ObjectField name v) | Pretty _ <- formatter = ": " | Minified <- formatter = ":" --- * Directives - -directives :: Formatter -> [Directive] -> Text -directives formatter@(Pretty _) = Text.Lazy.cons ' ' . spaces (directive formatter) -directives Minified = spaces (directive Minified) - -directive :: Formatter -> Directive -> Text -directive formatter (Directive name args) - = "@" <> Text.Lazy.fromStrict name <> optempty (arguments formatter) args - --- * Type Reference - -type_ :: Type -> Text -type_ (TypeNamed x) = Text.Lazy.fromStrict x -type_ (TypeList x) = listType x -type_ (TypeNonNull x) = nonNullType x +-- | Converts a 'Type' a type into a string. +type' :: Type -> Text +type' (TypeNamed x) = Text.Lazy.fromStrict x +type' (TypeList x) = listType x +type' (TypeNonNull x) = nonNullType x listType :: Type -> Text -listType x = brackets (type_ x) +listType x = brackets (type' x) nonNullType :: NonNullType -> Text nonNullType (NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!" diff --git a/tests/Language/GraphQL/EncoderSpec.hs b/tests/Language/GraphQL/EncoderSpec.hs new file mode 100644 index 0000000..d2d4a00 --- /dev/null +++ b/tests/Language/GraphQL/EncoderSpec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} +module Language.GraphQL.EncoderSpec + ( spec + ) where + +import Language.GraphQL.AST ( Value(..)) +import Language.GraphQL.Encoder ( value + , minified + ) +import Test.Hspec ( Spec + , describe + , it + , shouldBe + ) + +spec :: Spec +spec = describe "value" $ do + it "escapes \\" $ + value minified (ValueString "\\") `shouldBe` "\"\\\\\"" + it "escapes quotes" $ + value minified (ValueString "\"") `shouldBe` "\"\\\"\""