diff --git a/src/Language/GraphQL/Encoder.hs b/src/Language/GraphQL/Encoder.hs index 42ce333..e257325 100644 --- a/src/Language/GraphQL/Encoder.hs +++ b/src/Language/GraphQL/Encoder.hs @@ -1,7 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} -- | This module defines a printer for the @GraphQL@ language. module Language.GraphQL.Encoder - ( definition + ( Formatter(..) + , definition , document ) where @@ -12,34 +13,50 @@ import Data.Text (Text, pack) import qualified Data.Text as Text import Language.GraphQL.AST +-- | Instructs the encoder whether a GraphQL should be minified or pretty +-- printed. +data Formatter + = Minified + | Pretty Int + -- | Converts a 'Document' into a string. -document :: Document -> Text -document defs = Text.intercalate "\n" - . NonEmpty.toList - $ definition <$> defs +document :: Formatter -> Document -> Text +document formatter defs + | Pretty _ <- formatter = Text.intercalate "\n" encodeDocument + | Minified <-formatter = Text.snoc (mconcat encodeDocument) '\n' + where + encodeDocument = NonEmpty.toList $ definition formatter <$> defs -- | Converts a 'Definition' into a string. -definition :: Definition -> Text -definition x = Text.snoc (encodeDefinition x) '\n' +definition :: Formatter -> Definition -> Text +definition formatter x + | Pretty _ <- formatter = Text.snoc (encodeDefinition x) '\n' + | Minified <- formatter = encodeDefinition x where encodeDefinition (DefinitionOperation operation) - = operationDefinition operation + = operationDefinition formatter operation encodeDefinition (DefinitionFragment fragment) - = fragmentDefinition fragment + = fragmentDefinition formatter fragment -operationDefinition :: OperationDefinition -> Text -operationDefinition (OperationSelectionSet sels) = selectionSet sels -operationDefinition (OperationDefinition Query name vars dirs sels) = - "query " <> node (fold name) vars dirs sels -operationDefinition (OperationDefinition Mutation name vars dirs sels) = - "mutation " <> node (fold name) vars dirs sels +operationDefinition :: Formatter -> OperationDefinition -> Text +operationDefinition formatter (OperationSelectionSet sels) + = selectionSet formatter sels +operationDefinition formatter (OperationDefinition Query name vars dirs sels) + = "query " <> node formatter (fold name) vars dirs sels +operationDefinition formatter (OperationDefinition Mutation name vars dirs sels) + = "mutation " <> node formatter (fold name) vars dirs sels -node :: Name -> VariableDefinitions -> Directives -> SelectionSet -> Text -node name vars dirs sels = - name +node :: Formatter + -> Name + -> VariableDefinitions + -> Directives + -> SelectionSet + -> Text +node formatter name vars dirs sels + = name <> optempty variableDefinitions vars <> optempty directives dirs - <> selectionSet sels + <> selectionSet formatter sels variableDefinitions :: [VariableDefinition] -> Text variableDefinitions = parensCommas variableDefinition @@ -54,24 +71,26 @@ defaultValue val = "=" <> value val variable :: Name -> Text variable var = "$" <> var -selectionSet :: SelectionSet -> Text -selectionSet = bracesCommas selection . NonEmpty.toList +selectionSet :: Formatter -> SelectionSet -> Text +selectionSet formatter@(Pretty _) = bracesNewLines (selection formatter) . NonEmpty.toList +selectionSet Minified = bracesCommas (selection Minified) . NonEmpty.toList -selectionSetOpt :: SelectionSetOpt -> Text -selectionSetOpt = bracesCommas selection +selectionSetOpt :: Formatter -> SelectionSetOpt -> Text +selectionSetOpt formatter@(Pretty _) = bracesNewLines $ selection formatter +selectionSetOpt Minified = bracesCommas $ selection Minified -selection :: Selection -> Text -selection (SelectionField x) = field x -selection (SelectionInlineFragment x) = inlineFragment x -selection (SelectionFragmentSpread x) = fragmentSpread x +selection :: Formatter -> Selection -> Text +selection formatter (SelectionField x) = field formatter x +selection formatter (SelectionInlineFragment x) = inlineFragment formatter x +selection _ (SelectionFragmentSpread x) = fragmentSpread x -field :: Field -> Text -field (Field alias name args dirs selso) = - optempty (`Text.snoc` ':') (fold alias) +field :: Formatter -> Field -> Text +field formatter (Field alias name args dirs selso) = + optempty (`Text.append` ":") (fold alias) <> name <> optempty arguments args <> optempty directives dirs - <> optempty selectionSetOpt selso + <> optempty (selectionSetOpt formatter) selso arguments :: [Argument] -> Text arguments = parensCommas argument @@ -85,17 +104,17 @@ fragmentSpread :: FragmentSpread -> Text fragmentSpread (FragmentSpread name ds) = "..." <> name <> optempty directives ds -inlineFragment :: InlineFragment -> Text -inlineFragment (InlineFragment tc dirs sels) = +inlineFragment :: Formatter -> InlineFragment -> Text +inlineFragment formatter (InlineFragment tc dirs sels) = "... on " <> fold tc <> directives dirs - <> selectionSet sels + <> selectionSet formatter sels -fragmentDefinition :: FragmentDefinition -> Text -fragmentDefinition (FragmentDefinition name tc dirs sels) = +fragmentDefinition :: Formatter -> FragmentDefinition -> Text +fragmentDefinition formatter (FragmentDefinition name tc dirs sels) = "fragment " <> name <> " on " <> tc <> optempty directives dirs - <> selectionSet sels + <> selectionSet formatter sels -- * Values @@ -180,5 +199,8 @@ bracketsCommas f = brackets . Text.intercalate "," . fmap f bracesCommas :: (a -> Text) -> [a] -> Text bracesCommas f = braces . Text.intercalate "," . fmap f +bracesNewLines :: (a -> Text) -> [a] -> Text +bracesNewLines f xs = Text.append (Text.intercalate "\n" $ "{" : fmap f xs) "\n}" + optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b optempty f xs = if xs == mempty then mempty else f xs diff --git a/stack.yaml b/stack.yaml index 8d2eae9..6da8acf 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-13.29 +resolver: lts-13.30 packages: - '.' extra-deps: [] diff --git a/stack.yaml.lock b/stack.yaml.lock index d2178fe..2cdf902 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -7,6 +7,6 @@ packages: [] snapshots: - completed: size: 500539 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/29.yaml - sha256: 006398c5e92d1d64737b7e98ae4d63987c36808814504d1451f56ebd98093f75 - original: lts-13.29 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/30.yaml + sha256: 59ad6b944c9903847fecdc1d4815e8500c1f9999d80fd1b4d2d66e408faec44b + original: lts-13.30 diff --git a/tests/Test/KitchenSinkSpec.hs b/tests/Test/KitchenSinkSpec.hs index f9f9395..0a6bb91 100644 --- a/tests/Test/KitchenSinkSpec.hs +++ b/tests/Test/KitchenSinkSpec.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} module Test.KitchenSinkSpec ( spec ) where @@ -16,10 +18,11 @@ import Test.Hspec.Expectations ( expectationFailure import Text.Megaparsec ( errorBundlePretty , parse ) +import Text.RawString.QQ (r) spec :: Spec -spec = describe "Kitchen Sink" $ - it "prints the query" $ do +spec = describe "Kitchen Sink" $ do + it "minifies the query" $ do dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql" minFileName <- getDataFileName "tests/data/kitchen-sink.min.graphql" actual <- Text.IO.readFile dataFileName @@ -27,5 +30,46 @@ spec = describe "Kitchen Sink" $ either (expectationFailure . errorBundlePretty) - (flip shouldBe expected . Encoder.document) + (flip shouldBe expected . Encoder.document Encoder.Minified) + $ parse Parser.document dataFileName actual + + it "pretty prints the query" $ do + dataFileName <- getDataFileName "tests/data/kitchen-sink.graphql" + actual <- Text.IO.readFile dataFileName + let expected = [r|query queryName($foo:ComplexType,$site:Site=MOBILE){ +whoever123is:node(id:[123,456]){ +id +... on User@defer{ +field2{ +id +alias:field1(first:10,after:$foo)@include(if:$foo){ +id +...frag +} +} +} +} +} + +mutation likeStory{ +like(story:123)@defer{ +story{ +id +} +} +} + +fragment frag on Friend{ +foo(size:$size,bar:$b,obj:{key:"value"}) +} + +{ +unnamed(truthy:true,falsey:false) +query +} +|] + + either + (expectationFailure . errorBundlePretty) + (flip shouldBe expected . Encoder.document (Encoder.Pretty 0)) $ parse Parser.document dataFileName actual diff --git a/tests/data/kitchen-sink.graphql b/tests/data/kitchen-sink.graphql index 46fd10e..89903b7 100644 --- a/tests/data/kitchen-sink.graphql +++ b/tests/data/kitchen-sink.graphql @@ -7,11 +7,11 @@ query queryName($foo: ComplexType, $site: Site = MOBILE) { whoever123is: node(id: [123, 456]) { - id , # Inline test comment + id, # Inline test comment ... on User @defer { field2 { - id , - alias: field1(first:10, after:$foo,) @include(if: $foo) { + id, + alias: field1(first: 10, after: $foo) @include(if: $foo) { id, ...frag } diff --git a/tests/data/kitchen-sink.min.graphql b/tests/data/kitchen-sink.min.graphql index c39e6ba..24f5c26 100644 --- a/tests/data/kitchen-sink.min.graphql +++ b/tests/data/kitchen-sink.min.graphql @@ -1,7 +1 @@ -query queryName($foo:ComplexType,$site:Site=MOBILE){whoever123is:node(id:[123,456]){id,... on User@defer{field2{id,alias:field1(first:10,after:$foo)@include(if:$foo){id,...frag}}}}} - -mutation likeStory{like(story:123)@defer{story{id}}} - -fragment frag on Friend{foo(size:$size,bar:$b,obj:{key:"value"})} - -{unnamed(truthy:true,falsey:false),query} +query queryName($foo:ComplexType,$site:Site=MOBILE){whoever123is:node(id:[123,456]){id,... on User@defer{field2{id,alias:field1(first:10,after:$foo)@include(if:$foo){id,...frag}}}}}mutation likeStory{like(story:123)@defer{story{id}}}fragment frag on Friend{foo(size:$size,bar:$b,obj:{key:"value"})}{unnamed(truthy:true,falsey:false),query}