WIP: Support hover and goto definition for top-level splices

I can't work out how to properly integrate this information into the
.hie file machinery. Perhaps it would be better to upstream this.

src/Development/IDE/Core/Compile.hs

@@ -71,9 +71,11 @@ import qualified HeaderInfo                     as Hdr
 import           HscMain                        (makeSimpleDetails, hscDesugar, hscTypecheckRename, hscSimplify, hscGenHardCode, hscInteractive)
 import           MkIface
 import           StringBuffer                   as SB
-import           TcRnMonad (finalSafeMode, TcGblEnv, tct_id, TcTyThing(AGlobal, ATcId), initTc, initIfaceLoad, tcg_th_coreplugins, tcg_binds)
+import           TcRnMonad (TcM, finalSafeMode, TcGblEnv, tct_id, TcTyThing(AGlobal, ATcId), initTc, initIfaceLoad, tcg_th_coreplugins, tcg_binds)
 import           TcIface                        (typecheckIface)
 import           TidyPgm
+import           Hooks
+import           TcSplice
 
 import Control.Exception.Safe
 import Control.Monad.Extra
@@ -148,20 +150,40 @@ typecheckModule (IdeDefer defer) hsc pm = do
     where
         demoteIfDefer = if defer then demoteTypeErrorsToWarnings else id
 
+-- | Add a Hook to the DynFlags which captures and returns the
+-- typechecked splices before they are run. This information
+-- is used for hover.
+captureSplices :: DynFlags -> (DynFlags -> IO a) -> IO (a, [LHsExpr GhcTc])
+captureSplices dflags k = do
+  splice_ref <- newIORef []
+  res <- k (dflags { hooks = addSpliceHook splice_ref (hooks dflags)})
+  splices <- readIORef splice_ref
+  return (res, splices)
+  where
+    addSpliceHook :: IORef [LHsExpr GhcTc] -> Hooks -> Hooks
+    addSpliceHook var h = h { runMetaHook = Just (splice_hook var) }
+
+    splice_hook :: IORef [LHsExpr GhcTc] -> MetaRequest -> LHsExpr GhcTc -> TcM MetaResult
+    splice_hook var mr e = do
+      liftIO $ modifyIORef var (e:)
+      pprTraceM "expr" (ppr e)
+      defaultRunMeta mr e
+
 tcRnModule :: GhcMonad m => ParsedModule -> m TcModuleResult
 tcRnModule pmod = do
   let ms = pm_mod_summary pmod
   hsc_env <- getSession
-  let hsc_env_tmp = hsc_env { hsc_dflags = ms_hspp_opts ms }
-  (tc_gbl_env, mrn_info)
-        <- liftIO $ hscTypecheckRename hsc_env_tmp ms $
-                       HsParsedModule { hpm_module = parsedSource pmod,
-                                        hpm_src_files = pm_extra_src_files pmod,
-                                        hpm_annotations = pm_annotations pmod }
+  ((tc_gbl_env, mrn_info), splices)
+        <- liftIO $ captureSplices (ms_hspp_opts ms) $ \dflags ->
+             do  let hsc_env_tmp = hsc_env { hsc_dflags = dflags }
+                 hscTypecheckRename hsc_env_tmp ms $
+                          HsParsedModule { hpm_module = parsedSource pmod,
+                                           hpm_src_files = pm_extra_src_files pmod,
+                                           hpm_annotations = pm_annotations pmod }
   let rn_info = case mrn_info of
         Just x -> x
         Nothing -> error "no renamed info tcRnModule"
-  pure (TcModuleResult pmod rn_info tc_gbl_env False)
+  pure (TcModuleResult pmod rn_info tc_gbl_env splices False)
 
 mkHiFileResultNoCompile :: HscEnv -> TcModuleResult -> IO HiFileResult
 mkHiFileResultNoCompile session tcm = do

src/Development/IDE/Core/RuleTypes.hs

@@ -91,6 +91,7 @@ data TcModuleResult = TcModuleResult
     { tmrParsed :: ParsedModule
     , tmrRenamed :: RenamedSource
     , tmrTypechecked :: TcGblEnv
+    , tmrTopLevelSplices :: [LHsExpr GhcTc] -- ^ Typechecked top-level splices from this module
     , tmrDeferedError :: !Bool -- ^ Did we defer any type errors for this module?
     }
 instance Show TcModuleResult where