diff options
| -rw-r--r-- | CHANGELOG.md | 1 | ||||
| -rw-r--r-- | graphql.cabal | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/TH.hs | 35 |
3 files changed, 38 insertions, 0 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index 58fda81..16fa701 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/graphql.cabal b/graphql.cabal index f72a913..2219fed 100644 --- a/graphql.cabal +++ b/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 diff --git a/src/Language/GraphQL/TH.hs b/src/Language/GraphQL/TH.hs new file mode 100644 index 0000000..02dd7d6 --- /dev/null +++ b/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)" + } |