From 89afef9daeb6da6624d42d32813d86c1f9b9f0c3 Mon Sep 17 00:00:00 2001
From: romes <rodrigo.m.mesquita@gmail.com>
Date: Mon, 25 Apr 2022 19:52:22 +0200
Subject: [PATCH] TTG: Match new GHC AST
---
haddock-api/src/Haddock.hs | 1 -
.../src/Haddock/Backends/Hyperlinker.hs | 2 -
haddock-api/src/Haddock/Backends/LaTeX.hs | 3 +-
.../src/Haddock/Backends/Xhtml/Decl.hs | 3 +-
haddock-api/src/Haddock/Interface.hs | 9 +-
haddock-api/src/Haddock/Interface/Create.hs | 2 +-
.../src/Haddock/Interface/LexParseRn.hs | 1 -
haddock-api/src/Haddock/Interface/Rename.hs | 14 +-
.../src/Haddock/Interface/Specialize.hs | 1 -
haddock-api/src/Haddock/Types.hs | 5 +-
.../ref/src/TemplateHaskellQuasiquotes.html | 372 +++++++++++++++---
.../ref/src/TemplateHaskellSplices.html | 114 +++++-
hypsrc-test/src/TemplateHaskellQuasiquotes.hs | 6 +
hypsrc-test/src/TemplateHaskellSplices.hs | 4 +
14 files changed, 457 insertions(+), 80 deletions(-)
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 4a655f64f7..e1775cc85e 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -79,7 +79,6 @@ import GHC.Utils.Error
import GHC.Utils.Logger
import GHC.Types.Name.Cache
import GHC.Unit
-import GHC.Unit.State (lookupUnit)
import GHC.Utils.Panic (handleGhcException)
import GHC.Data.FastString
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 89828e3017..9316da6dc3 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -26,8 +26,6 @@ import GHC.Types.SrcLoc ( realSrcLocSpan, mkRealSrcLoc, srcSpanFile )
import Data.Map as M
import GHC.Data.FastString ( mkFastString )
import GHC.Unit.Module ( Module, moduleName )
-import GHC.Types.Name.Cache ( initNameCache )
-import GHC.Types.Unique.Supply ( mkSplitUniqSupply )
-- | Generate hyperlinked source for given interfaces.
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 349c6e8e45..420bd3f02a 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -40,7 +40,6 @@ import Data.Char
import Control.Monad
import Data.Maybe
import Data.List ( sort )
-import Data.Void ( absurd )
import Prelude hiding ((<>))
import Haddock.Doc (combineDocumentation)
@@ -1120,7 +1119,7 @@ ppr_mono_ty (HsSumTy _ tys) u = sumParens (map (ppLType u) tys)
ppr_mono_ty (HsKindSig _ ty kind) u = parens (ppr_mono_lty ty u <+> dcolon u <+> ppLKind u kind)
ppr_mono_ty (HsListTy _ ty) u = brackets (ppr_mono_lty ty u)
ppr_mono_ty (HsIParamTy _ (L _ n) ty) u = ppIPName n <+> dcolon u <+> ppr_mono_lty ty u
-ppr_mono_ty (HsSpliceTy v _) _ = absurd v
+ppr_mono_ty (HsSpliceTy v _) _ = dataConCantHappen v
ppr_mono_ty (HsRecTy {}) _ = text "{..}"
ppr_mono_ty (XHsType {}) _ = error "ppr_mono_ty HsCoreTy"
ppr_mono_ty (HsExplicitListTy _ IsPromoted tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index a54bb0aa94..d385b42a7b 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -32,7 +32,6 @@ import Haddock.Doc (combineDocumentation)
import Data.List ( intersperse, sort )
import qualified Data.Map as Map
import Data.Maybe
-import Data.Void ( absurd )
import Text.XHtml hiding ( name, title, p, quote )
import GHC.Core.Type ( Specificity(..) )
@@ -1263,7 +1262,7 @@ ppr_mono_ty (HsKindSig _ ty kind) u q e =
ppr_mono_ty (HsListTy _ ty) u q _ = brackets (ppr_mono_lty ty u q HideEmptyContexts)
ppr_mono_ty (HsIParamTy _ (L _ n) ty) u q _ =
ppIPName n <+> dcolon u <+> ppr_mono_lty ty u q HideEmptyContexts
-ppr_mono_ty (HsSpliceTy v _) _ _ _ = absurd v
+ppr_mono_ty (HsSpliceTy v _) _ _ _ = dataConCantHappen v
ppr_mono_ty (HsRecTy {}) _ _ _ = toHtml "{..}"
-- Can now legally occur in ConDeclGADT, the output here is to provide a
-- placeholder in the signature, which is followed by the field
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index 19113107f8..92b727acd2 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -46,7 +46,7 @@ import Haddock.Types (DocOption (..), Documentation (..), ExportItem (..), Iface
import Haddock.Utils (Verbosity (..), normal, out, verbose)
import Control.Monad (unless, when)
-import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.IO.Class (MonadIO)
import Data.IORef (atomicModifyIORef', newIORef, readIORef)
import Data.List (foldl', isPrefixOf, nub)
import Text.Printf (printf)
@@ -54,7 +54,6 @@ import qualified Data.Map as Map
import qualified Data.Set as Set
import GHC hiding (verbosity)
-import GHC.Data.FastString (unpackFS)
import GHC.Data.Graph.Directed
import GHC.Driver.Env
import GHC.Driver.Monad (modifySession, withTimingM)
@@ -64,13 +63,7 @@ import GHC.Plugins
import GHC.Tc.Types (TcGblEnv (..), TcM)
import GHC.Tc.Utils.Env (tcLookupGlobal)
import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv)
-import GHC.Types.Name (nameIsFromExternalPackage, nameOccName)
-import GHC.Types.Name.Occurrence (isTcOcc)
-import GHC.Types.Name.Reader (globalRdrEnvElts, greMangledName, unQualOK)
-import GHC.Unit.Module.Env (ModuleSet, emptyModuleSet, mkModuleSet, unionModuleSet)
import GHC.Unit.Module.Graph
-import GHC.Unit.Module.ModSummary (isBootSummary)
-import GHC.Unit.Types (IsBootInterface (..))
import GHC.Utils.Error (withTiming)
#if defined(mingw32_HOST_OS)
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index dbd4a9b2fa..c5f81520c5 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -55,7 +55,7 @@ import Data.Traversable (for)
import GHC hiding (lookupName)
import GHC.Core.Class (ClassMinimalDef, classMinimalDef)
import GHC.Core.ConLike (ConLike (..))
-import GHC.Data.FastString (bytesFS, unpackFS)
+import GHC.Data.FastString (unpackFS)
import GHC.Driver.Ppr (showSDoc)
import GHC.HsToCore.Docs hiding (mkMaps, unionArgMaps)
import GHC.IORef (readIORef)
diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs
index f3b57792d4..199365b04a 100644
--- a/haddock-api/src/Haddock/Interface/LexParseRn.hs
+++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs
@@ -39,7 +39,6 @@ import GHC.Parser.PostProcess
import GHC.Driver.Ppr ( showPpr, showSDoc )
import GHC.Types.Name.Reader
import GHC.Data.EnumSet as EnumSet
-import GHC.Utils.Trace
processDocStrings :: DynFlags -> Maybe Package -> GlobalRdrEnv -> [HsDocString]
-> ErrMsgM (Maybe (MDoc Name))
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index cbc7e58fa4..d2f117331f 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -314,7 +314,8 @@ renameType t = case t of
XHsType a -> pure (XHsType a)
HsExplicitListTy _ a b -> HsExplicitListTy noAnn a <$> mapM renameLType b
HsExplicitTupleTy _ b -> HsExplicitTupleTy noAnn <$> mapM renameLType b
- HsSpliceTy _ s -> renameHsSpliceTy s
+ HsSpliceTy (HsUntypedSpliceTop _ st) _ -> renameType st
+ HsSpliceTy (HsUntypedSpliceNested _) _ -> error "renameType: not an top level type splice"
HsWildCardTy _ -> pure (HsWildCardTy noAnn)
@@ -324,17 +325,6 @@ renameSigType (HsSig { sig_bndrs = bndrs, sig_body = body }) = do
body' <- renameLType body
pure $ HsSig { sig_ext = noExtField, sig_bndrs = bndrs', sig_body = body' }
--- | Rename splices, but _only_ those that turn out to be for types.
--- I think this is actually safe for our possible inputs:
---
--- * the input is from after GHC's renamer, so should have an 'HsSpliced'
--- * the input is typechecked, and only 'HsSplicedTy' should get through that
---
-renameHsSpliceTy :: HsSplice GhcRn -> RnM (HsType DocNameI)
-renameHsSpliceTy (HsSpliced _ _ (HsSplicedTy t)) = renameType t
-renameHsSpliceTy (HsSpliced _ _ _) = error "renameHsSpliceTy: not an HsSplicedTy"
-renameHsSpliceTy _ = error "renameHsSpliceTy: not an HsSpliced"
-
renameLHsQTyVars :: LHsQTyVars GhcRn -> RnM (LHsQTyVars DocNameI)
renameLHsQTyVars (HsQTvs { hsq_explicit = tvs })
= do { tvs' <- mapM renameLTyVarBndr tvs
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index d116485873..ca6b9e7456 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -16,7 +16,6 @@ import Haddock.Syb
import Haddock.Types
import GHC
-import GHC.Types.Basic ( PromotionFlag(..) )
import GHC.Types.Name
import GHC.Data.FastString
import GHC.Builtin.Types ( listTyConName, unrestrictedFunTyConName )
diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs
index 7d00c5ecf0..dc15dfe015 100644
--- a/haddock-api/src/Haddock/Types.hs
+++ b/haddock-api/src/Haddock/Types.hs
@@ -322,6 +322,7 @@ type instance IdP DocNameI = DocName
instance CollectPass DocNameI where
collectXXPat _ ext = dataConCantHappen ext
collectXXHsBindsLR ext = dataConCantHappen ext
+ collectXSplicePat _ ext = dataConCantHappen ext
instance NamedThing DocName where
getName (Documented name _) = name
@@ -750,7 +751,7 @@ type instance XOpTy DocNameI = EpAnn [AddEpAnn]
type instance XParTy DocNameI = EpAnn AnnParen
type instance XIParamTy DocNameI = EpAnn [AddEpAnn]
type instance XKindSig DocNameI = EpAnn [AddEpAnn]
-type instance XSpliceTy DocNameI = Void -- see `renameHsSpliceTy`
+type instance XSpliceTy DocNameI = DataConCantHappen
type instance XDocTy DocNameI = EpAnn [AddEpAnn]
type instance XBangTy DocNameI = EpAnn [AddEpAnn]
type instance XRecTy DocNameI = EpAnn [AddEpAnn]
@@ -832,6 +833,8 @@ type instance XXConDeclField DocNameI = DataConCantHappen
type instance XXPat DocNameI = DataConCantHappen
type instance XXHsBindsLR DocNameI a = DataConCantHappen
+type instance XSplicePat DocNameI = DataConCantHappen
+
type instance XCInjectivityAnn DocNameI = NoExtField
type instance XCFunDep DocNameI = NoExtField
diff --git a/hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html b/hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html
index 9c06e8e087..afa3057463 100644
--- a/hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html
+++ b/hypsrc-test/ref/src/TemplateHaskellQuasiquotes.html
@@ -110,8 +110,12 @@
></span
><span
> </span
- ><span class="hs-identifier"
- >bar</span
+ ><span class="annot"
+ ><a href="#"
+ ><span class="hs-identifier hs-type"
+ >bar</span
+ ></a
+ ></span
><span
> </span
><span class="hs-glyph"
@@ -120,8 +124,15 @@
> </span
><span class="hs-special"
>$</span
- ><span class="hs-identifier"
- >aType</span
+ ><span class="annot"
+ ><span class="annottext"
+ >TypeQ
+</span
+ ><a href="TemplateHaskellQuasiquotes.html#aType"
+ ><span class="hs-identifier hs-var"
+ >aType</span
+ ></a
+ ></span
><span
> </span
><span class="hs-glyph"
@@ -134,14 +145,18 @@
> </span
><span class="hs-special"
>(</span
- ><span class="hs-identifier"
- >Int</span
+ ><span class="annot"
+ ><span class="hs-identifier hs-type"
+ >Int</span
+ ></span
><span class="hs-special"
>,</span
><span
> </span
- ><span class="hs-identifier"
- >String</span
+ ><span class="annot"
+ ><span class="hs-identifier hs-type"
+ >String</span
+ ></span
><span class="hs-special"
>)</span
><span
@@ -155,14 +170,27 @@
></span
><span
> </span
- ><span class="hs-identifier"
- >bar</span
+ ><span id=""
+ ><span class="annot"
+ ><a href="#"
+ ><span class="hs-identifier hs-var hs-var"
+ >bar</span
+ ></a
+ ></span
+ ></span
><span
> </span
><span class="hs-special"
>$</span
- ><span class="hs-identifier"
- >aPattern</span
+ ><span class="annot"
+ ><span class="annottext"
+ >PatQ
+</span
+ ><a href="TemplateHaskellQuasiquotes.html#aPattern"
+ ><span class="hs-identifier hs-var"
+ >aPattern</span
+ ></a
+ ></span
><span
> </span
><span class="hs-glyph"
@@ -171,8 +199,15 @@
> </span
><span class="hs-special"
>$</span
- ><span class="hs-identifier"
- >anExpression</span
+ ><span class="annot"
+ ><span class="annottext"
+ >ExpQ
+</span
+ ><a href="TemplateHaskellQuasiquotes.html#anExpression"
+ ><span class="hs-identifier hs-var"
+ >anExpression</span
+ ></a
+ ></span
><span
>
</span
@@ -243,8 +278,14 @@
>[</span
><span
> </span
- ><span class="hs-identifier"
- >aCrazyLongVariableName</span
+ ><span id=""
+ ><span class="annot"
+ ><a href="#"
+ ><span class="hs-identifier hs-var"
+ >aCrazyLongVariableName</span
+ ></a
+ ></span
+ ></span
><span
>
</span
@@ -256,8 +297,14 @@
>,</span
><span
> </span
- ><span class="hs-identifier"
- >_unused</span
+ ><span id=""
+ ><span class="annot"
+ ><a href="#"
+ ><span class="hs-identifier hs-var"
+ >_unused</span
+ ></a
+ ></span
+ ></span
><span
>
</span
@@ -271,14 +318,26 @@
> </span
><span class="hs-special"
>(</span
- ><span class="hs-identifier"
- >y</span
+ ><span id=""
+ ><span class="annot"
+ ><a href="#"
+ ><span class="hs-identifier hs-var"
+ >y</span
+ ></a
+ ></span
+ ></span
><span class="hs-special"
>,</span
><span
> </span
- ><span class="hs-identifier"
- >z</span
+ ><span id=""
+ ><span class="annot"
+ ><a href="#"
+ ><span class="hs-identifier hs-var"
+ >z</span
+ ></a
+ ></span
+ ></span
><span class="hs-special"
>)</span
><span
@@ -298,14 +357,23 @@
> </span
><span class="hs-special"
>$</span
- ><span class="hs-identifier"
- >aNumberPattern</span
+ ><span class="annot"
+ ><span class="annottext"
+ >PatQ
+</span
+ ><a href="TemplateHaskellQuasiquotes.html#aNumberPattern"
+ ><span class="hs-identifier hs-var"
+ >aNumberPattern</span
+ ></a
+ ></span
><span class="hs-special"
>,</span
><span
> </span
+ ><span class="annot"
><span class="hs-string"
- >"hello"</span
+ >"hello"</span
+ ></span
><span class="hs-special"
>)</span
><span
@@ -383,16 +451,30 @@
></span
><span
> </span
- ><span class="hs-identifier"
- >w</span
+ ><span id=""
+ ><span class="annot"
+ ><a href="#"
+ ><span class="hs-identifier hs-var"
+ >w</span
+ ></a
+ ></span
+ ></span
><span class="hs-glyph"
>@</span
- ><span class="hs-identifier"
- >v</span
+ ><span id=""
+ ><span class="annot"
+ ><a href="#"
+ ><span class="hs-identifier hs-var"
+ >v</span
+ ></a
+ ></span
+ ></span
><span class="hs-glyph"
>@</span
+ ><span class="annot"
><span class="hs-number"
- >4.5</span
+ >4.5</span
+ ></span
><span
>
</span
@@ -475,24 +557,37 @@
> </span
><span class="hs-special"
>(</span
+ ><span class="annot"
><span class="hs-number"
- >1</span
+ >1</span
+ ></span
><span
> </span
- ><span class="hs-operator"
- >+</span
+ ><span class="annot"
+ ><span class="hs-operator hs-type"
+ >+</span
+ ></span
><span
> </span
><span class="hs-special"
>$</span
- ><span class="hs-identifier"
- >anExpression2</span
+ ><span class="annot"
+ ><span class="annottext"
+ >ExpQ
+</span
+ ><a href="TemplateHaskellQuasiquotes.html#anExpression2"
+ ><span class="hs-identifier hs-var"
+ >anExpression2</span
+ ></a
+ ></span
><span class="hs-special"
>,</span
><span
> </span
+ ><span class="annot"
><span class="hs-string"
- >"world"</span
+ >"world"</span
+ ></span
><span class="hs-special"
>)</span
><span
@@ -536,20 +631,28 @@
> </span
><span class="hs-special"
>(</span
+ ><span class="annot"
><span class="hs-number"
- >1</span
+ >1</span
+ ></span
><span
> </span
- ><span class="hs-operator"
- >+</span
+ ><span class="annot"
+ ><span class="hs-operator hs-type"
+ >+</span
+ ></span
><span
> </span
- ><span class="hs-identifier"
- >round</span
+ ><span class="annot"
+ ><span class="hs-identifier hs-type"
+ >round</span
+ ></span
><span
> </span
- ><span class="hs-identifier"
- >pi</span
+ ><span class="annot"
+ ><span class="hs-identifier hs-type"
+ >pi</span
+ ></span
><span class="hs-special"
>)</span
><span
@@ -619,14 +722,18 @@
> </span
><span class="hs-special"
>(</span
- ><span class="hs-identifier"
- >Double</span
+ ><span class="annot"
+ ><span class="hs-identifier hs-type"
+ >Double</span
+ ></span
><span class="hs-special"
>,</span
><span
> </span
- ><span class="hs-identifier"
- >String</span
+ ><span class="annot"
+ ><span class="hs-identifier hs-type"
+ >String</span
+ ></span
><span class="hs-special"
>)</span
><span
@@ -652,16 +759,187 @@
</span
><span id="line-39"
></span
+ ><span class="annot"
+ ><a href="TemplateHaskellQuasiquotes.html#typedExpr1"
+ ><span class="hs-identifier hs-type"
+ >typedExpr1</span
+ ></a
+ ></span
+ ><span
+ > </span
+ ><span class="hs-glyph"
+ >::</span
+ ><span
+ > </span
+ ><span class="annot"
+ ><span class="hs-identifier hs-type"
+ >Code</span
+ ></span
+ ><span
+ > </span
+ ><span class="annot"
+ ><span class="hs-identifier hs-type"
+ >Q</span
+ ></span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >(</span
+ ><span class="hs-special"
+ >)</span
><span
>
</span
><span id="line-40"
></span
+ ><span id="typedExpr1"
+ ><span class="annot"
+ ><span class="annottext"
+ >typedExpr1 :: Code Q ()
+</span
+ ><a href="TemplateHaskellQuasiquotes.html#typedExpr1"
+ ><span class="hs-identifier hs-var hs-var"
+ >typedExpr1</span
+ ></a
+ ></span
+ ></span
+ ><span
+ > </span
+ ><span class="hs-glyph"
+ >=</span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >[||</span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >(</span
+ ><span class="hs-special"
+ >)</span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >||]</span
><span
>
</span
><span id="line-41"
></span
+ ><span
+ >
+</span
+ ><span id="line-42"
+ ></span
+ ><span class="annot"
+ ><a href="TemplateHaskellQuasiquotes.html#typedExpr"
+ ><span class="hs-identifier hs-type"
+ >typedExpr</span
+ ></a
+ ></span
+ ><span
+ > </span
+ ><span class="hs-glyph"
+ >::</span
+ ><span
+ > </span
+ ><span class="annot"
+ ><span class="hs-identifier hs-type"
+ >Code</span
+ ></span
+ ><span
+ > </span
+ ><span class="annot"
+ ><span class="hs-identifier hs-type"
+ >Q</span
+ ></span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >(</span
+ ><span class="hs-special"
+ >)</span
+ ><span
+ >
+</span
+ ><span id="line-43"
+ ></span
+ ><span id="typedExpr"
+ ><span class="annot"
+ ><span class="annottext"
+ >typedExpr :: Code Q ()
+</span
+ ><a href="TemplateHaskellQuasiquotes.html#typedExpr"
+ ><span class="hs-identifier hs-var hs-var"
+ >typedExpr</span
+ ></a
+ ></span
+ ></span
+ ><span
+ > </span
+ ><span class="hs-glyph"
+ >=</span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >[||</span
+ ><span
+ > </span
+ ><span class="annot"
+ ><span class="annottext"
+ >a -> b -> a
+forall a b. a -> b -> a
+</span
+ ><span class="hs-identifier hs-var"
+ >const</span
+ ></span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >$$</span
+ ><span class="hs-special"
+ >(</span
+ ><span class="annot"
+ ><span class="annottext"
+ >Code Q ()
+</span
+ ><a href="TemplateHaskellQuasiquotes.html#typedExpr1"
+ ><span class="hs-identifier hs-var"
+ >typedExpr1</span
+ ></a
+ ></span
+ ><span class="hs-special"
+ >)</span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >(</span
+ ><span class="hs-special"
+ >)</span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >||]</span
+ ><span
+ >
+</span
+ ><span id="line-44"
+ ></span
+ ><span
+ >
+</span
+ ><span id="line-45"
+ ></span
+ ><span
+ >
+</span
+ ><span id="line-46"
+ ></span
+ ><span
+ >
+</span
+ ><span id="line-47"
+ ></span
></pre
></body
></html
diff --git a/hypsrc-test/ref/src/TemplateHaskellSplices.html b/hypsrc-test/ref/src/TemplateHaskellSplices.html
index db43c8183f..bb31fb7627 100644
--- a/hypsrc-test/ref/src/TemplateHaskellSplices.html
+++ b/hypsrc-test/ref/src/TemplateHaskellSplices.html
@@ -111,8 +111,12 @@ forall a. a -> a
>$</span
><span class="hs-special"
>(</span
- ><span class="hs-identifier"
- >anExpression2</span
+ ><span class="annot"
+ ><a href="TemplateHaskellQuasiquotes.html#anExpression2"
+ ><span class="hs-identifier hs-type"
+ >anExpression2</span
+ ></a
+ ></span
><span class="hs-special"
>)</span
><span
@@ -120,6 +124,112 @@ forall a. a -> a
</span
><span id="line-10"
></span
+ ><span
+ >
+</span
+ ><span id="line-11"
+ ></span
+ ><span id="pat"
+ ><span class="annot"
+ ><span class="annottext"
+ >pat :: [(a, String)] -> ()
+</span
+ ><a href="TemplateHaskellSplices.html#pat"
+ ><span class="hs-identifier hs-var hs-var"
+ >pat</span
+ ></a
+ ></span
+ ></span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >$</span
+ ><span id=""
+ ><span id=""
+ ><span id=""
+ ><span id=""
+ ><span id=""
+ ><span id=""
+ ><span class="hs-special"
+ >(</span
+ ><span class="annot"
+ ><a href="TemplateHaskellQuasiquotes.html#aPattern"
+ ><span class="hs-identifier hs-type"
+ >aPattern</span
+ ></a
+ ></span
+ ><span class="hs-special"
+ >)</span
+ ></span
+ ></span
+ ></span
+ ></span
+ ></span
+ ></span
+ ><span
+ > </span
+ ><span class="hs-glyph"
+ >=</span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >(</span
+ ><span class="hs-special"
+ >)</span
+ ><span
+ >
+</span
+ ><span id="line-12"
+ ></span
+ ><span
+ >
+</span
+ ><span id="line-13"
+ ></span
+ ><span id="qux"
+ ><span class="annot"
+ ><span class="annottext"
+ >qux :: ()
+</span
+ ><a href="TemplateHaskellSplices.html#qux"
+ ><span class="hs-identifier hs-var hs-var"
+ >qux</span
+ ></a
+ ></span
+ ></span
+ ><span
+ > </span
+ ><span class="hs-glyph"
+ >=</span
+ ><span
+ > </span
+ ><span class="annot"
+ ><span class="annottext"
+ >() -> ()
+forall a. a -> a
+</span
+ ><span class="hs-identifier hs-var"
+ >id</span
+ ></span
+ ><span
+ > </span
+ ><span class="hs-special"
+ >$$</span
+ ><span class="hs-special"
+ >(</span
+ ><span class="annot"
+ ><a href="TemplateHaskellQuasiquotes.html#typedExpr"
+ ><span class="hs-identifier hs-type"
+ >typedExpr</span
+ ></a
+ ></span
+ ><span class="hs-special"
+ >)</span
+ ><span
+ >
+</span
+ ><span id="line-14"
+ ></span
></pre
></body
></html
diff --git a/hypsrc-test/src/TemplateHaskellQuasiquotes.hs b/hypsrc-test/src/TemplateHaskellQuasiquotes.hs
index 7fafc7aaea..c949832082 100644
--- a/hypsrc-test/src/TemplateHaskellQuasiquotes.hs
+++ b/hypsrc-test/src/TemplateHaskellQuasiquotes.hs
@@ -36,5 +36,11 @@ aType = [t|
[ (Double, String) ]
|]
+typedExpr1 :: Code Q ()
+typedExpr1 = [|| () ||]
+
+typedExpr :: Code Q ()
+typedExpr = [|| const $$(typedExpr1) () ||]
+
diff --git a/hypsrc-test/src/TemplateHaskellSplices.hs b/hypsrc-test/src/TemplateHaskellSplices.hs
index f8a859a0bb..66af36a393 100644
--- a/hypsrc-test/src/TemplateHaskellSplices.hs
+++ b/hypsrc-test/src/TemplateHaskellSplices.hs
@@ -7,3 +7,7 @@ import TemplateHaskellQuasiquotes
$(aDecl)
foo = id $(anExpression2)
+
+pat $(aPattern) = ()
+
+qux = id $$(typedExpr)
--
GitLab