From f3a02a87a41dc92a17eef94a25221530d62acf9a Mon Sep 17 00:00:00 2001 From: Brandon Simmons Date: Thu, 17 Mar 2022 11:36:48 -0400 Subject: [PATCH 1/2] Make litName an untyped TH expression splice for now To work around https://gitlab.haskell.org/ghc/ghc/-/issues/16524 --- src/Language/GraphQL/Draft/Syntax.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Language/GraphQL/Draft/Syntax.hs b/src/Language/GraphQL/Draft/Syntax.hs index e1a6dfb..26c0ba5 100644 --- a/src/Language/GraphQL/Draft/Syntax.hs +++ b/src/Language/GraphQL/Draft/Syntax.hs @@ -101,7 +101,7 @@ import {-# SOURCE #-} Language.GraphQL.Draft.Parser ) import {-# SOURCE #-} Language.GraphQL.Draft.Printer (renderExecutableDoc) import Language.GraphQL.Draft.Syntax.Internal (liftTypedHashMap) -import Language.Haskell.TH.Syntax (Lift, Q, TExp) +import Language.Haskell.TH.Syntax (Lift, Q, Exp) import Language.Haskell.TH.Syntax qualified as TH import Prettyprinter (Pretty (..)) import Prelude @@ -129,8 +129,8 @@ parseName text = maybe (fail errorMessage) pure $ mkName text where errorMessage = T.unpack text <> " is not valid GraphQL name" -litName :: Text -> Q (TExp Name) -litName = parseName >=> \name -> [||name||] +litName :: Text -> Q Exp -- (TExp Name) +litName = parseName >=> \name -> [|name|] instance J.FromJSON Name where parseJSON = J.withText "Name" parseName From 2269020ec8294294cce7c8c11abcfac1fcd4c0bf Mon Sep 17 00:00:00 2001 From: jkachmar Date: Thu, 17 Mar 2022 13:11:09 -0400 Subject: [PATCH 2/2] Adds GraphQL name quasiquoter --- src/Language/GraphQL/Draft/Syntax.hs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/src/Language/GraphQL/Draft/Syntax.hs b/src/Language/GraphQL/Draft/Syntax.hs index 26c0ba5..df8c29b 100644 --- a/src/Language/GraphQL/Draft/Syntax.hs +++ b/src/Language/GraphQL/Draft/Syntax.hs @@ -8,6 +8,7 @@ module Language.GraphQL.Draft.Syntax mkName, unsafeMkName, litName, + nameQQ, Description (..), Value (..), literal, @@ -101,7 +102,8 @@ import {-# SOURCE #-} Language.GraphQL.Draft.Parser ) import {-# SOURCE #-} Language.GraphQL.Draft.Printer (renderExecutableDoc) import Language.GraphQL.Draft.Syntax.Internal (liftTypedHashMap) -import Language.Haskell.TH.Syntax (Lift, Q, Exp) +import Language.Haskell.TH.Quote (QuasiQuoter (..)) +import Language.Haskell.TH.Syntax (Exp, Lift, Q) import Language.Haskell.TH.Syntax qualified as TH import Prettyprinter (Pretty (..)) import Prelude @@ -129,9 +131,19 @@ parseName text = maybe (fail errorMessage) pure $ mkName text where errorMessage = T.unpack text <> " is not valid GraphQL name" -litName :: Text -> Q Exp -- (TExp Name) +-- | Construct a 'Name' value at compile-time. +litName :: Text -> Q Exp litName = parseName >=> \name -> [|name|] +-- | Construct a 'Name' value at compile-time via quasiquotation. +nameQQ :: QuasiQuoter +nameQQ = QuasiQuoter {quoteExp, quotePat, quoteType, quoteDec} + where + quotePat _ = error "nameQQ does not support quoting patterns" + quoteType _ = error "nameQQ does not support quoting types" + quoteDec _ = error "nameQQ does not support quoting declarations" + quoteExp = litName . T.pack + instance J.FromJSON Name where parseJSON = J.withText "Name" parseName