fixup hls-eval-plugin

haskell · Oct 24, 2021 · c056b1d · c056b1d
1 parent 395389a
commit c056b1d
Show file tree

Hide file tree

Showing 3 changed files with 33 additions and 35 deletions.
diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs
@@ -50,7 +50,7 @@ module Development.IDE.Core.Rules(
     getHieAstsRule,
     getBindingsRule,
     needsCompilationRule,
-    computeLinkableType,
+    computeLinkableTypeForDynFlags,
     generateCoreRule,
     getImportMapRule,
     regenerateHiFile,
@@ -1015,33 +1015,33 @@ needsCompilationRule file = do
         pure $ computeLinkableType ms modsums (map join needsComps)
 
   pure (Just $ encodeLinkableType res, Just res)
-
--- | Compute the linkable type required for the input module
-computeLinkableType
-    :: ModSummary            -- ^ module
-    -> [Maybe ModSummary]    -- ^ direct dependencies
-    -> [Maybe LinkableType]  -- ^ linkable requirements for the direct dependencies
-    -> Maybe LinkableType
-computeLinkableType this deps xs
-    | Just ObjectLinkable `elem` xs     = Just ObjectLinkable -- If any dependent needs object code, so do we
-    | Just BCOLinkable    `elem` xs     = Just this_type      -- If any dependent needs bytecode, then we need to be compiled
-    | any (maybe False uses_th_qq) deps = Just this_type      -- If any dependent needs TH, then we need to be compiled
-    | otherwise                         = Nothing             -- If none of these conditions are satisfied, we don't need to compile
-    where
-        uses_th_qq (ms_hspp_opts -> dflags) =
-            xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
-
-        unboxed_tuples_or_sums (ms_hspp_opts -> d) =
-            xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d
-        -- How should we compile this module? (assuming we do in fact need to compile it)
-        -- Depends on whether it uses unboxed tuples or sums
-        this_type
+  where
+    uses_th_qq (ms_hspp_opts -> dflags) =
+      xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
+
+    computeLinkableType :: ModSummary -> [Maybe ModSummary] -> [Maybe LinkableType] -> Maybe LinkableType
+    computeLinkableType this deps xs
+      | Just ObjectLinkable `elem` xs     = Just ObjectLinkable -- If any dependent needs object code, so do we
+      | Just BCOLinkable    `elem` xs     = Just this_type      -- If any dependent needs bytecode, then we need to be compiled
+      | any (maybe False uses_th_qq) deps = Just this_type      -- If any dependent needs TH, then we need to be compiled
+      | otherwise                         = Nothing             -- If none of these conditions are satisfied, we don't need to compile
+      where
+        this_type = computeLinkableTypeForDynFlags (ms_hspp_opts this)
+
+-- | How should we compile this module?
+-- (assuming we do in fact need to compile it).
+-- Depends on whether it uses unboxed tuples or sums
+computeLinkableTypeForDynFlags :: DynFlags -> LinkableType
+computeLinkableTypeForDynFlags d
 #if defined(GHC_PATCHED_UNBOXED_BYTECODE)
           = BCOLinkable
 #else
-          | unboxed_tuples_or_sums this = ObjectLinkable
-          | otherwise                   = BCOLinkable
+          | unboxed_tuples_or_sums = ObjectLinkable
+          | otherwise              = BCOLinkable
 #endif
+  where
+        unboxed_tuples_or_sums =
+            xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d
 
 -- | Tracks which linkables are current, so we don't need to unload them
 newtype CompiledLinkables = CompiledLinkables { getCompiledLinkables :: Var (ModuleEnv UTCTime) }

diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal
@@ -62,7 +62,6 @@ library
     , extra
     , filepath
     , ghc
-    , ghc-boot
     , ghc-boot-th
     , ghc-paths
     , ghcide                >=1.2   && <1.5
@@ -86,7 +85,7 @@ library
     , unordered-containers
 
   ghc-options:
-    -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors
+    -Wall -Wno-name-shadowing -Wno-unticked-promoted-constructors -fno-ignore-asserts
 
   if flag(pedantic)
     ghc-options: -Werror
@@ -101,7 +100,7 @@ test-suite tests
   default-language: Haskell2010
   hs-source-dirs:   test
   main-is:          Main.hs
-  ghc-options:      -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts
+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N
   build-depends:
     , aeson
     , base

diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs
@@ -24,7 +24,7 @@ import           Development.IDE                      (GetModSummaryWithoutTimes
                                                        realSrcSpanToRange,
                                                        useWithStale_)
 import           Development.IDE.Core.PositionMapping (toCurrentRange)
-import           Development.IDE.Core.Rules           (computeLinkableType,
+import           Development.IDE.Core.Rules           (computeLinkableTypeForDynFlags,
                                                        needsCompilationRule)
 import           Development.IDE.Core.Shake           (IsIdeGlobal,
                                                        RuleBody (RuleWithCustomNewnessCheck),
@@ -35,7 +35,6 @@ import           Development.IDE.GHC.Compat
 import qualified Development.IDE.GHC.Compat           as SrcLoc
 import qualified Development.IDE.GHC.Compat.Util      as FastString
 import           Development.IDE.Graph                (alwaysRerun)
-import qualified GHC.LanguageExtensions               as LangExt
 import           Ide.Plugin.Eval.Types
 
 
@@ -101,18 +100,18 @@ evalParsedModuleRule = defineEarlyCutoff $ RuleNoDiagnostics $ \GetEvalComments
 redefinedNeedsCompilation :: Rules ()
 redefinedNeedsCompilation = defineEarlyCutoff $ RuleWithCustomNewnessCheck (<=) $ \NeedsCompilation f -> do
     alwaysRerun
-    EvaluatingVar var <- getIdeGlobalAction
 
+    EvaluatingVar var <- getIdeGlobalAction
     isEvaluating <- liftIO $ (f `elem`) <$> readIORef var
 
+
     if not isEvaluating then needsCompilationRule f else do
         ms <- msrModSummary . fst <$> useWithStale_ GetModSummaryWithoutTimestamps f
-        let ms' = ms{ms_hspp_opts = df'}
-            df' = xopt_set (ms_hspp_opts ms) LangExt.TemplateHaskell
-            linkableType = computeLinkableType ms' [] []
-            fp = encodeLinkableType linkableType
+        let df' = ms_hspp_opts ms
+            linkableType = computeLinkableTypeForDynFlags df'
+            fp = encodeLinkableType $ Just linkableType
 
         -- remove the module from the Evaluating state
         liftIO $ modifyIORef var (Set.delete f)
 
-        pure (Just fp, Just linkableType)
+        pure (Just fp, Just (Just linkableType))