Add TH module with gql quasi quoter

CHANGELOG.md

@@ -14,6 +14,7 @@ and this project adheres to
 - Deprecation notes in the `Error` module for `Resolution`, `CollectErrsT` and
   `runCollectErrs`. These symbols are part of the old executor and aren't used
   anymore, it will be deprecated in the future and removed.
+- `TH` module with the `gql` quasi quoter.
 
 ### Fixed
 - Error messages are more concrete, they also contain type information and

graphql.cabal

@@ -39,6 +39,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
@@ -64,6 +65,7 @@ library
     , megaparsec >= 9.0.1 && < 9.1
     , parser-combinators >= 1.3.0 && < 1.4
     , scientific >= 0.3.7 && < 0.4
+    , template-haskell >= 2.16 && < 2.18
     , text >= 1.2.4 && < 1.3
     , transformers >= 0.5.6 && < 0.6
     , unordered-containers >= 0.2.14 && < 0.3

src/Language/GraphQL/TH.hs

@@ -0,0 +1,35 @@
+{- 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 = unlines
+    $ reverse
+    $ dropWhile null
+    $ reverse
+    $ indent spaces <$> lines withoutLeadingNewlines
+  where
+    indent 0 xs = xs
+    indent count (' ' : xs) = indent (count - 1) xs
+    indent _ xs = xs
+    withoutLeadingNewlines = dropWhile (== '\n') code
+    spaces = length $ takeWhile (== ' ') withoutLeadingNewlines
+
+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)"
+    }