CHANGELOG.md

@@ -6,10 +6,6 @@ The format is based on
 and this project adheres to
 [Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
-## [Unreleased]
-### Changed
-- Remove deprecated 'gql' quasi quoter.
-
 ## [1.4.0.0] - 2024-10-26
 ### Changed
 - `Schema.Directive` is extended to contain a boolean argument, representing
@@ -542,7 +538,6 @@ and this project adheres to
 ### Added
 - Data types for the GraphQL language.
 
-[Unreleased]: https://git.caraus.tech/OSS/graphql/compare/v1.4.0.0...master
 [1.4.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.3.0.0...v1.4.0.0
 [1.3.0.0]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.3...v1.3.0.0
 [1.2.0.3]: https://git.caraus.tech/OSS/graphql/compare/v1.2.0.2...v1.2.0.3

graphql.cabal

@@ -40,6 +40,7 @@ library
     Language.GraphQL.Execute
     Language.GraphQL.Execute.Coerce
     Language.GraphQL.Execute.OrderedMap
+    Language.GraphQL.TH
     Language.GraphQL.Type
     Language.GraphQL.Type.In
     Language.GraphQL.Type.Out
@@ -62,6 +63,7 @@ library
     exceptions ^>= 0.10.4,
     megaparsec >= 9.0 && < 10,
     parser-combinators >= 1.3 && < 2,
+    template-haskell >= 2.16 && < 3,
     text >= 1.2 && < 3,
     transformers >= 0.5.6 && < 0.7,
     unordered-containers ^>= 0.2.14,
@@ -82,6 +84,7 @@ test-suite graphql-test
     Language.GraphQL.Execute.CoerceSpec
     Language.GraphQL.Execute.OrderedMapSpec
     Language.GraphQL.ExecuteSpec
+    Language.GraphQL.THSpec
     Language.GraphQL.Type.OutSpec
     Language.GraphQL.Validate.RulesSpec
     Schemas.HeroSchema

src/Language/GraphQL/AST/Document.hs

@@ -482,9 +482,12 @@ instance Monoid Description
 data TypeDefinition
     = ScalarTypeDefinition Description Name [Directive]
     | ObjectTypeDefinition
-        Description Name (ImplementsInterfaces []) [Directive] [FieldDefinition]
-    | InterfaceTypeDefinition
-        Description Name (ImplementsInterfaces []) [Directive] [FieldDefinition]
+        Description
+        Name
+        (ImplementsInterfaces [])
+        [Directive]
+        [FieldDefinition]
+    | InterfaceTypeDefinition Description Name [Directive] [FieldDefinition]
     | UnionTypeDefinition Description Name [Directive] (UnionMemberTypes [])
     | EnumTypeDefinition Description Name [Directive] [EnumValueDefinition]
     | InputObjectTypeDefinition

src/Language/GraphQL/AST/Encoder.hs

@@ -226,11 +226,10 @@ typeDefinition formatter = \case
         <> optempty (directives formatter) directives'
         <> eitherFormat formatter " " ""
         <> bracesList formatter (fieldDefinition nextFormatter) fields'
-    Full.InterfaceTypeDefinition description' name' ifaces' directives' fields'
+    Full.InterfaceTypeDefinition description' name' directives' fields'
         -> optempty (description formatter) description'
         <> "interface "
         <> Lazy.Text.fromStrict name'
-        <> optempty (" " <>) (implementsInterfaces ifaces')
         <> optempty (directives formatter) directives'
         <> eitherFormat formatter " " ""
         <> bracesList formatter (fieldDefinition nextFormatter) fields'

src/Language/GraphQL/AST/Parser.hs

@@ -214,7 +214,6 @@ interfaceTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
 interfaceTypeDefinition description' = Full.InterfaceTypeDefinition description'
     <$ symbol "interface"
     <*> name
-    <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
     <*> directives
     <*> braces (many fieldDefinition)
     <?> "InterfaceTypeDefinition"

src/Language/GraphQL/TH.hs

@@ -0,0 +1,48 @@
+{- 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/. -}
+
+-- | Template Haskell helpers.
+module Language.GraphQL.TH
+    ( gql
+    ) where
+
+import Language.Haskell.TH.Quote (QuasiQuoter(..))
+import Language.Haskell.TH (Exp(..), Lit(..))
+
+stripIndentation :: String -> String
+stripIndentation code = reverse
+    $ dropWhile isLineBreak
+    $ reverse
+    $ unlines
+    $ indent spaces <$> lines' withoutLeadingNewlines
+  where
+    indent 0 xs = xs
+    indent count (' ' : xs) = indent (count - 1) xs
+    indent _ xs = xs
+    withoutLeadingNewlines = dropWhile isLineBreak code
+    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
+-- removed from each line of the string.
+{-# DEPRECATED gql "Use Language.GraphQL.Class.gql from graphql-spice instead" #-}
+gql :: QuasiQuoter
+gql = QuasiQuoter
+    { quoteExp = pure . LitE . StringL . stripIndentation
+    , quotePat = const
+        $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a pattern)"
+    , quoteType = const
+        $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a type)"
+    , quoteDec = const
+        $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a declaration)"
+    }

src/Language/GraphQL/Validate.hs

@@ -210,7 +210,7 @@ typeDefinition context rule = \case
     Full.ObjectTypeDefinition _ _ _ directives' fields
         -> directives context rule objectLocation directives'
         >< foldMap (fieldDefinition context rule) fields
-    Full.InterfaceTypeDefinition _ _ _ directives' fields
+    Full.InterfaceTypeDefinition _ _ directives' fields
         -> directives context rule interfaceLocation directives'
         >< foldMap (fieldDefinition context rule) fields
     Full.UnionTypeDefinition _ _ directives' _ ->

tests/Language/GraphQL/AST/EncoderSpec.hs

@@ -181,7 +181,7 @@ spec = do
                 argument = Full.InputValueDefinition mempty "arg" someType Nothing mempty
                 arguments = Full.ArgumentsDefinition [argument]
                 definition' = Full.TypeDefinition
-                    $ Full.InterfaceTypeDefinition mempty "UUID" (Full.ImplementsInterfaces []) mempty
+                    $ Full.InterfaceTypeDefinition mempty "UUID" mempty
                     $ pure
                     $ Full.FieldDefinition mempty "value" arguments someType mempty
                 expected = "interface UUID {\n\

tests/Language/GraphQL/AST/ParserSpec.hs

@@ -103,12 +103,6 @@ spec = describe "Parser" $ do
             \  name: String\n\
             \}"
 
-    it "parses ImplementsInterfaces on interfaces" $
-        parse document "" `shouldSucceedOn`
-            "interface Person implements NamedEntity & ValuedEntity {\n\
-            \  name: String\n\
-            \}"
-
     it "parses minimal enum type definition" $
         parse document "" `shouldSucceedOn`
             "enum Direction {\n\

tests/Language/GraphQL/THSpec.hs

@@ -0,0 +1,24 @@
+{- 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\nline3"
+                actual = [gql|
+                  line1
+                  line2
+                  line3
+                |]
+             in actual `shouldBe` expected