Overloaded Quotation Brackets (#246)wip/overload-th

This patch implements overloaded quotation brackets which generalise the
desugaring of all quotation forms in terms of a new minimal interface.

The main change is that a quotation, for example, [e| 5 |], will now
have type `Quote m => m Exp` rather than `Q Exp`. The `Quote` typeclass
contains a single method for generating new names which is used when
desugaring binding structures.

The return type of functions from the `Lift` type class, `lift` and `liftTyped` have
been restricted to `forall m . Quote m => m Exp` rather than returning a
result in a Q monad.

More details about the feature can be read in the GHC proposal.

https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0246-overloaded-bracket.rst

1 files changed, 69 insertions, 49 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index fb9556db54..0abe15f3ea 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -204,6 +204,67 @@ instance Applicative Q where
 
 -----------------------------------------------------
 --
+--              The Quote class
+--
+-----------------------------------------------------
+
+
+
+-- | The 'Quote' class implements the minimal interface which is necessary for
+-- desugaring quotations.
+--
+-- * The @Monad m@ superclass is needed to stitch together the different
+-- AST fragments.
+-- * 'newName' is used when desugaring binding structures such as lambdas
+-- to generate fresh names.
+--
+-- Therefore the type of an untyped quotation in GHC is `Quote m => m Exp`
+--
+-- For many years the type of a quotation was fixed to be `Q Exp` but by
+-- more precisely specifying the minimal interface it enables the `Exp` to
+-- be extracted purely from the quotation without interacting with `Q`.
+class Monad m => Quote m where
+  {- |
+  Generate a fresh name, which cannot be captured.
+
+  For example, this:
+
+  @f = $(do
+    nm1 <- newName \"x\"
+    let nm2 = 'mkName' \"x\"
+    return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
+   )@
+
+  will produce the splice
+
+  >f = \x0 -> \x -> x0
+
+  In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
+  and is not captured by the binding @VarP nm2@.
+
+  Although names generated by @newName@ cannot /be captured/, they can
+  /capture/ other names. For example, this:
+
+  >g = $(do
+  >  nm1 <- newName "x"
+  >  let nm2 = mkName "x"
+  >  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
+  > )
+
+  will produce the splice
+
+  >g = \x -> \x0 -> x0
+
+  since the occurrence @VarE nm2@ is captured by the innermost binding
+  of @x@, namely @VarP nm1@.
+  -}
+  newName :: String -> m Name
+
+instance Quote Q where
+  newName s = Q (qNewName s)
+
+-----------------------------------------------------
+--
 --              The TExp type
 --
 -----------------------------------------------------
@@ -250,7 +311,7 @@ newtype TExp (a :: TYPE (r :: RuntimeRep)) = TExp
 -- expression
 --
 -- Levity-polymorphic since /template-haskell-2.16.0.0/.
-unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r). Q (TExp a) -> Q Exp
+unTypeQ :: forall (r :: RuntimeRep) (a :: TYPE r) m . Quote m => m (TExp a) -> m Exp
 unTypeQ m = do { TExp e <- m
                ; return e }
 
@@ -260,7 +321,8 @@ unTypeQ m = do { TExp e <- m
 -- really does have the type you claim it has.
 --
 -- Levity-polymorphic since /template-haskell-2.16.0.0/.
-unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r). Q Exp -> Q (TExp a)
+unsafeTExpCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .
+                      Quote m => m Exp -> m (TExp a)
 unsafeTExpCoerce m = do { e <- m
                         ; return (TExp e) }
 
@@ -280,42 +342,6 @@ The splice will evaluate to (MkAge 3) and you can't add that to
 ----------------------------------------------------
 -- Packaged versions for the programmer, hiding the Quasi-ness
 
-{- |
-Generate a fresh name, which cannot be captured.
-
-For example, this:
-
-@f = $(do
-  nm1 <- newName \"x\"
-  let nm2 = 'mkName' \"x\"
-  return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))
- )@
-
-will produce the splice
-
->f = \x0 -> \x -> x0
-
-In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,
-and is not captured by the binding @VarP nm2@.
-
-Although names generated by @newName@ cannot /be captured/, they can
-/capture/ other names. For example, this:
-
->g = $(do
->  nm1 <- newName "x"
->  let nm2 = mkName "x"
->  return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))
-> )
-
-will produce the splice
-
->g = \x -> \x0 -> x0
-
-since the occurrence @VarE nm2@ is captured by the innermost binding
-of @x@, namely @VarP nm1@.
--}
-newName :: String -> Q Name
-newName s = Q (qNewName s)
 
 -- | Report an error (True) or warning (False),
 -- but carry on; use 'fail' to stop.
@@ -654,13 +680,7 @@ instance Quasi Q where
 -- The following operations are used solely in DsMeta when desugaring brackets
 -- They are not necessary for the user, who can use ordinary return and (>>=) etc
 
-returnQ :: a -> Q a
-returnQ = return
-
-bindQ :: Q a -> (a -> Q b) -> Q b
-bindQ = (>>=)
-
-sequenceQ :: [Q a] -> Q [a]
+sequenceQ :: forall m . Monad m => forall a . [m a] -> m [a]
 sequenceQ = sequence
 
 
@@ -700,15 +720,15 @@ sequenceQ = sequence
 class Lift (t :: TYPE r) where
   -- | Turn a value into a Template Haskell expression, suitable for use in
   -- a splice.
-  lift :: t -> Q Exp
-  default lift :: (r ~ 'LiftedRep) => t -> Q Exp
+  lift :: Quote m => t -> m Exp
+  default lift :: (r ~ 'LiftedRep, Quote m) => t -> m Exp
   lift = unTypeQ . liftTyped
 
   -- | Turn a value into a Template Haskell typed expression, suitable for use
   -- in a typed splice.
   --
   -- @since 2.16.0.0
-  liftTyped :: t -> Q (TExp t)
+  liftTyped :: Quote m => t -> m (TExp t)
 
 
 -- If you add any instances here, consider updating test th/TH_Lift
@@ -832,7 +852,7 @@ instance Lift a => Lift [a] where
   liftTyped x = unsafeTExpCoerce (lift x)
   lift xs = do { xs' <- mapM lift xs; return (ListE xs') }
 
-liftString :: String -> Q Exp
+liftString :: Quote m => String -> m Exp
 -- Used in TcExpr to short-circuit the lifting for strings
 liftString s = return (LitE (StringL s))