Haskell Language Server + haskell.nix patch

hls.patch

diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs
index 99938bd4..471b184c 100644
--- a/ghcide/src/Development/IDE/Core/Compile.hs
+++ b/ghcide/src/Development/IDE/Core/Compile.hs
@@ -122,6 +122,15 @@ import           GHC.Hs                            (LEpaComment)
 import qualified GHC.Types.Error                   as Error
 #endif
 
+import StgSyn
+import FastString
+import Unique
+import CostCentre
+import Data.Either
+import CoreSyn
+import CoreToStg
+import SimplStg
+
 -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'.
 parseModule
     :: IdeOptions
@@ -256,9 +265,37 @@ captureSplicesAndDeps env k = do
            ; fv_hvs <- loadDecls (hscInterp hsc_env) hsc_env srcspan bcos
            ; let hval = (expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs)
 #else
+             {- Create a temporary binding and convert to STG -}
+           ; let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel")
+                                         (mkPseudoUniqueE 0)
+                                         (exprType prepd_expr)
+           ; (binds, _) <-
+               myCoreToStg hsc_env
+                           (icInteractiveModule (hsc_IC hsc_env))
+                           [NonRec bco_tmp_id prepd_expr]
+
+           ; let (_strings, lifted_binds) = partitionEithers $ do  -- list monad
+                  bnd <- binds
+                  case bnd of
+                    StgTopLifted (StgNonRec i expr) -> [Right (i, expr)]
+                    StgTopLifted (StgRec bnds)      -> map Right bnds
+                    StgTopStringLit b str           -> [Left (b, str)]
+
+           ; let stg_expr = case lifted_binds of
+                              [(_i, e)] -> e
+                              _        ->
+                                StgRhsClosure noExtFieldSilent
+                                              dontCareCCS
+                                              ReEntrant
+                                              []
+                                              (StgLet noExtFieldSilent
+                                                 (StgRec lifted_binds)
+                                                 (StgApp bco_tmp_id []))
              {- Convert to BCOs -}
            ; bcos <- coreExprToBCOs hsc_env
-                       (icInteractiveModule (hsc_IC hsc_env)) prepd_expr
+                       (icInteractiveModule (hsc_IC hsc_env))
+                       bco_tmp_id
+                       stg_expr
 
            ; let needed_mods = mkUniqSet [ moduleName mod | n <- uniqDSetToList (bcoFreeNames bcos)
                                          , Just mod <- [nameModule_maybe n] -- Names from other modules
@@ -1342,3 +1379,16 @@ pathToModuleName = mkModuleName . map rep
       rep c | isPathSeparator c = '_'
       rep ':' = '_'
       rep c = c
+
+myCoreToStg :: HscEnv -> Module -> CoreProgram
+            -> IO ( [StgTopBinding] -- output program
+                  , CollectedCCs )  -- CAF cost centre info (declared and used)
+myCoreToStg hsc_env this_mod prepd_binds = do
+    let (stg_binds, cost_centre_info)
+         = {-# SCC "Core2Stg" #-}
+           coreToStg (hsc_dflags hsc_env) this_mod prepd_binds
+    stg_binds2
+        <- {-# SCC "Stg2Stg" #-}
+           stg2stg hsc_env this_mod stg_binds
+
+    return (stg_binds2, cost_centre_info)