diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index dd5f3de106..ee59909ef5 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -171,11 +171,11 @@ typecheckModule :: IdeDefer typecheckModule (IdeDefer defer) hsc tc_helpers pm = do let modSummary = pm_mod_summary pm dflags = ms_hspp_opts modSummary - mmodSummary' <- catchSrcErrors (hsc_dflags hsc) "typecheck (initialize plugins)" + initialized <- catchSrcErrors (hsc_dflags hsc) "typecheck (initialize plugins)" (initPlugins hsc modSummary) - case mmodSummary' of + case initialized of Left errs -> return (errs, Nothing) - Right modSummary' -> do + Right (modSummary', hsc) -> do (warnings, etcm) <- withWarnings "typecheck" $ \tweak -> let session = tweak (hscSetFlags dflags hsc) @@ -472,7 +472,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do Nothing #endif -#else +#else let !partial_iface = force (mkPartialIface session details simplified_guts) final_iface <- mkFullIface session partial_iface #endif @@ -563,11 +563,6 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do . (("Error during " ++ T.unpack source) ++) . show @SomeException ] -initPlugins :: HscEnv -> ModSummary -> IO ModSummary -initPlugins session modSummary = do - session1 <- liftIO $ initializePlugins (hscSetFlags (ms_hspp_opts modSummary) session) - return modSummary{ms_hspp_opts = hsc_dflags session1} - -- | Whether we should run the -O0 simplifier when generating core. -- -- This is required for template Haskell to work but we disable this in DAML. @@ -1095,7 +1090,9 @@ getModSummaryFromImports -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO ModSummaryResult getModSummaryFromImports env fp modTime contents = do - (contents, opts, dflags) <- preprocessor env fp contents + (contents, opts, env) <- preprocessor env fp contents + + let dflags = hsc_dflags env -- The warns will hopefully be reported when we actually parse the module (_warns, L main_loc hsmod) <- parseHeader dflags fp contents @@ -1154,9 +1151,9 @@ getModSummaryFromImports env fp modTime contents = do then mkHomeModLocation dflags (pathToModuleName fp) fp else mkHomeModLocation dflags mod fp - let modl = mkHomeModule (hscHomeUnit (hscSetFlags dflags env)) mod + let modl = mkHomeModule (hscHomeUnit env) mod sourceType = if "-boot" `isSuffixOf` takeExtension fp then HsBootFile else HsSrcFile - msrModSummary = + msrModSummary2 = ModSummary { ms_mod = modl , ms_hie_date = Nothing @@ -1181,7 +1178,8 @@ getModSummaryFromImports env fp modTime contents = do , ms_textual_imps = textualImports } - msrFingerprint <- liftIO $ computeFingerprint opts msrModSummary + msrFingerprint <- liftIO $ computeFingerprint opts msrModSummary2 + (msrModSummary, msrHscEnv) <- liftIO $ initPlugins env msrModSummary2 return ModSummaryResult{..} where -- Compute a fingerprint from the contents of `ModSummary`, @@ -1222,7 +1220,7 @@ parseHeader dflags filename contents = do PFailedWithErrorMessages msgs -> throwE $ diagFromErrMsgs "parser" dflags $ msgs dflags POk pst rdr_module -> do - let (warns, errs) = getMessages' pst dflags + let (warns, errs) = renderMessages $ getPsMessages pst dflags -- Just because we got a `POk`, it doesn't mean there -- weren't errors! To clarify, the GHC parser @@ -1257,9 +1255,18 @@ parseFileContents env customPreprocessor filename ms = do POk pst rdr_module -> let hpm_annotations = mkApiAnns pst - (warns, errs) = getMessages' pst dflags + psMessages = getPsMessages pst dflags in do + let IdePreprocessedSource preproc_warns errs parsed = customPreprocessor rdr_module + + unless (null errs) $ + throwE $ diagFromStrings "parser" DsError errs + + let preproc_warnings = diagFromStrings "parser" DsWarning preproc_warns + (parsed', msgs) <- liftIO $ applyPluginsParsedResultAction env dflags ms hpm_annotations parsed psMessages + let (warns, errs) = renderMessages msgs + -- Just because we got a `POk`, it doesn't mean there -- weren't errors! To clarify, the GHC parser -- distinguishes between fatal and non-fatal @@ -1272,14 +1279,6 @@ parseFileContents env customPreprocessor filename ms = do unless (null errs) $ throwE $ diagFromErrMsgs "parser" dflags errs - -- Ok, we got here. It's safe to continue. - let IdePreprocessedSource preproc_warns errs parsed = customPreprocessor rdr_module - - unless (null errs) $ - throwE $ diagFromStrings "parser" DsError errs - - let preproc_warnings = diagFromStrings "parser" DsWarning preproc_warns - parsed' <- liftIO $ applyPluginsParsedResultAction env dflags ms hpm_annotations parsed -- To get the list of extra source files, we take the list -- that the parser gave us, diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index d41a7f9795..ef08264d7a 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -36,12 +36,12 @@ import GHC.Utils.Outputable (renderWithContext) -- | Given a file and some contents, apply any necessary preprocessors, -- e.g. unlit/cpp. Return the resulting buffer and the DynFlags it implies. -preprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], DynFlags) -preprocessor env0 filename mbContents = do +preprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO (Util.StringBuffer, [String], HscEnv) +preprocessor env filename mbContents = do -- Perform unlit (isOnDisk, contents) <- if isLiterate filename then do - newcontent <- liftIO $ runLhs env0 filename mbContents + newcontent <- liftIO $ runLhs env filename mbContents return (False, newcontent) else do contents <- liftIO $ maybe (Util.hGetStringBuffer filename) return mbContents @@ -49,17 +49,17 @@ preprocessor env0 filename mbContents = do return (isOnDisk, contents) -- Perform cpp - (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env0 filename contents - let env1 = hscSetFlags dflags env0 - let logger = hsc_logger env1 - (isOnDisk, contents, opts, dflags) <- + (opts, env) <- ExceptT $ parsePragmasIntoHscEnv env filename contents + let dflags = hsc_dflags env + let logger = hsc_logger env + (isOnDisk, contents, opts, env) <- if not $ xopt LangExt.Cpp dflags then - return (isOnDisk, contents, opts, dflags) + return (isOnDisk, contents, opts, env) else do cppLogs <- liftIO $ newIORef [] let newLogger = pushLogHook (const (logActionCompat $ logAction cppLogs)) logger contents <- ExceptT - $ (Right <$> (runCpp (putLogHook newLogger env1) filename + $ (Right <$> (runCpp (putLogHook newLogger env) filename $ if isOnDisk then Nothing else Just contents)) `catch` ( \(e :: Util.GhcException) -> do @@ -68,16 +68,16 @@ preprocessor env0 filename mbContents = do [] -> throw e diags -> return $ Left diags ) - (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env1 filename contents - return (False, contents, opts, dflags) + (opts, env) <- ExceptT $ parsePragmasIntoHscEnv env filename contents + return (False, contents, opts, env) -- Perform preprocessor if not $ gopt Opt_Pp dflags then - return (contents, opts, dflags) + return (contents, opts, env) else do - contents <- liftIO $ runPreprocessor env1 filename $ if isOnDisk then Nothing else Just contents - (opts, dflags) <- ExceptT $ parsePragmasIntoDynFlags env1 filename contents - return (contents, opts, dflags) + contents <- liftIO $ runPreprocessor env filename $ if isOnDisk then Nothing else Just contents + (opts, env) <- ExceptT $ parsePragmasIntoHscEnv env filename contents + return (contents, opts, env) where logAction :: IORef [CPPLog] -> LogActionCompat logAction cppLogs dflags _reason severity srcSpan _style msg = do @@ -137,12 +137,12 @@ isLiterate x = takeExtension x `elem` [".lhs",".lhs-boot"] -- | This reads the pragma information directly from the provided buffer. -parsePragmasIntoDynFlags +parsePragmasIntoHscEnv :: HscEnv -> FilePath -> Util.StringBuffer - -> IO (Either [FileDiagnostic] ([String], DynFlags)) -parsePragmasIntoDynFlags env fp contents = catchSrcErrors dflags0 "pragmas" $ do + -> IO (Either [FileDiagnostic] ([String], HscEnv)) +parsePragmasIntoHscEnv env fp contents = catchSrcErrors dflags0 "pragmas" $ do #if MIN_VERSION_ghc(9,3,0) let (_warns,opts) = getOptions (initParserOpts dflags0) contents fp #else @@ -154,7 +154,7 @@ parsePragmasIntoDynFlags env fp contents = catchSrcErrors dflags0 "pragmas" $ do (dflags, _, _) <- parseDynamicFilePragma dflags0 opts hsc_env' <- initializePlugins (hscSetFlags dflags env) - return (map unLoc opts, disableWarningsAsErrors (hsc_dflags hsc_env')) + return (map unLoc opts, hscSetFlags (disableWarningsAsErrors $ hsc_dflags hsc_env') hsc_env') where dflags0 = hsc_dflags env -- | Run (unlit) literate haskell preprocessor on a file, or buffer if set diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index 92145d494c..edc2abe148 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -155,7 +155,7 @@ data TcModuleResult = TcModuleResult , tmrTypechecked :: TcGblEnv , tmrTopLevelSplices :: Splices -- ^ Typechecked splice information - , tmrDeferredError :: !Bool + , tmrDeferredError :: !Bool -- ^ Did we defer any type errors for this module? , tmrRuntimeModules :: !(ModuleEnv ByteString) -- ^ Which modules did we need at runtime while compiling this file? @@ -357,6 +357,12 @@ data ModSummaryResult = ModSummaryResult { msrModSummary :: !ModSummary , msrImports :: [LImportDecl GhcPs] , msrFingerprint :: !Fingerprint + , msrHscEnv :: !HscEnv + -- ^ HscEnv for this particular ModSummary. + -- Contains initialised plugins, parsed options, etc... + -- + -- Implicit assumption: DynFlags in 'msrModSummary' are the same as + -- the DynFlags in 'msrHscEnv'. } instance Show ModSummaryResult where diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index af19487808..71f278b798 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -253,9 +253,7 @@ getParsedModuleRule :: Recorder (WithPriority Log) -> Rules () getParsedModuleRule recorder = -- this rule does not have early cutoff since all its dependencies already have it define (cmapWithPrio LogShake recorder) $ \GetParsedModule file -> do - ModSummaryResult{msrModSummary = ms'} <- use_ GetModSummary file - sess <- use_ GhcSession file - let hsc = hscEnv sess + ModSummaryResult{msrModSummary = ms', msrHscEnv = hsc} <- use_ GetModSummary file opt <- getIdeOptions modify_dflags <- getModifyDynFlags dynFlagsModifyParser let ms = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } @@ -327,8 +325,7 @@ getParsedModuleWithCommentsRule recorder = -- The parse diagnostics are owned by the GetParsedModule rule -- For this reason, this rule does not produce any diagnostics defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \GetParsedModuleWithComments file -> do - ModSummaryResult{msrModSummary = ms} <- use_ GetModSummary file - sess <- use_ GhcSession file + ModSummaryResult{msrModSummary = ms, msrHscEnv = hsc} <- use_ GetModSummary file opt <- getIdeOptions let ms' = withoutOption Opt_Haddock $ withOption Opt_KeepRawTokenStream ms @@ -336,7 +333,7 @@ getParsedModuleWithCommentsRule recorder = let ms = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } reset_ms pm = pm { pm_mod_summary = ms' } - liftIO $ fmap (fmap reset_ms) $ snd <$> getParsedModuleDefinition (hscEnv sess) opt file ms + liftIO $ fmap (fmap reset_ms) $ snd <$> getParsedModuleDefinition hsc opt file ms getModifyDynFlags :: (DynFlagsModifications -> a) -> Action a getModifyDynFlags f = do diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index bbc4c1a585..5983936fdd 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -26,7 +26,8 @@ module Development.IDE.GHC.Compat( disableWarningsAsErrors, reLoc, reLocA, - getMessages', + getPsMessages, + renderMessages, pattern PFailedWithErrorMessages, isObjectLinkable, @@ -268,6 +269,7 @@ import GHC.Types.IPE #if MIN_VERSION_ghc(9,3,0) import GHC.Types.Error import GHC.Driver.Config.Stg.Pipeline +import GHC.Driver.Plugins (PsMessages (..)) #endif #if !MIN_VERSION_ghc(9,3,0) @@ -383,25 +385,13 @@ corePrepExpr _ = GHC.corePrepExpr simplifyExpr df _ = GHC.simplifyExpr df #endif -#if MIN_VERSION_ghc(9,2,0) -type ErrMsg = MsgEnvelope DecoratedSDoc -#endif -#if MIN_VERSION_ghc(9,3,0) -type WarnMsg = MsgEnvelope DecoratedSDoc -#endif - -getMessages' :: PState -> DynFlags -> (Bag WarnMsg, Bag ErrMsg) -getMessages' pst dflags = +renderMessages :: PsMessages -> (Bag WarnMsg, Bag ErrMsg) +renderMessages msgs = #if MIN_VERSION_ghc(9,3,0) - bimap (fmap (fmap renderDiagnosticMessageWithHints) . getMessages) (fmap (fmap renderDiagnosticMessageWithHints) . getMessages) $ getPsMessages pst + let renderMsgs extractor = (fmap . fmap) renderDiagnosticMessageWithHints . getMessages $ extractor msgs + in (renderMsgs psWarnings, renderMsgs psErrors) #else -#if MIN_VERSION_ghc(9,2,0) - bimap (fmap pprWarning) (fmap pprError) $ -#endif - getMessages pst -#if !MIN_VERSION_ghc(9,2,0) - dflags -#endif + msgs #endif #if MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 5ff0867782..7a5448361e 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -589,7 +589,7 @@ import GHC.Parser.Header hiding (getImports) #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Linker.Loader as Linker import GHC.Linker.Types -import GHC.Parser.Lexer hiding (initParserState) +import GHC.Parser.Lexer hiding (initParserState, getPsMessages) import GHC.Parser.Annotation (EpAnn (..)) import GHC.Platform.Ways import GHC.Runtime.Context (InteractiveImport (..)) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 0dd10fc9a3..f34f03658f 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -27,6 +27,8 @@ module Development.IDE.GHC.Compat.Outputable ( -- * Error infrastructure DecoratedSDoc, MsgEnvelope, + ErrMsg, + WarnMsg, errMsgSpan, errMsgSeverity, formatErrorWithQual, @@ -192,6 +194,13 @@ type PsWarning = ErrMsg type PsError = ErrMsg #endif +#if MIN_VERSION_ghc(9,2,0) +type ErrMsg = MsgEnvelope DecoratedSDoc +#endif +#if MIN_VERSION_ghc(9,3,0) +type WarnMsg = MsgEnvelope DecoratedSDoc +#endif + mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualifiedDefault env = #if MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index 9af3d38162..79e1602e02 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -2,47 +2,78 @@ -- | Plugin Compat utils. module Development.IDE.GHC.Compat.Plugins ( + -- * Plugin Compat Types, and initialisation Plugin(..), defaultPlugin, PluginWithArgs(..), applyPluginsParsedResultAction, initializePlugins, + initPlugins, -- * Static plugins StaticPlugin(..), hsc_static_plugins, + + -- * Plugin messages + PsMessages(..), + getPsMessages ) where #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) -import qualified GHC.Driver.Env as Env +import qualified GHC.Driver.Env as Env #endif -import GHC.Driver.Plugins (Plugin (..), - PluginWithArgs (..), - StaticPlugin (..), - defaultPlugin, withPlugins) +import GHC.Driver.Plugins (Plugin (..), + PluginWithArgs (..), + StaticPlugin (..), + defaultPlugin, + withPlugins) #if MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Plugins (ParsedResult (..), - PsMessages (..), - staticPlugins) +import GHC.Driver.Plugins (ParsedResult (..), + PsMessages (..), + staticPlugins) +import qualified GHC.Parser.Lexer as Lexer +#else +import Data.Bifunctor (bimap) #endif -import qualified GHC.Runtime.Loader as Loader +import qualified GHC.Runtime.Loader as Loader #else -import qualified DynamicLoading as Loader +import qualified DynamicLoading as Loader import Plugins #endif import Development.IDE.GHC.Compat.Core -import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags) -import Development.IDE.GHC.Compat.Parser as Parser +import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags) +import Development.IDE.GHC.Compat.Outputable as Out +import Development.IDE.GHC.Compat.Parser as Parser +import Development.IDE.GHC.Compat.Util (Bag) + + +#if !MIN_VERSION_ghc(9,3,0) +type PsMessages = (Bag WarnMsg, Bag ErrMsg) +#endif + +getPsMessages :: PState -> DynFlags -> PsMessages +getPsMessages pst dflags = +#if MIN_VERSION_ghc(9,3,0) + uncurry PsMessages $ Lexer.getPsMessages pst +#else +#if MIN_VERSION_ghc(9,2,0) + bimap (fmap pprWarning) (fmap pprError) $ +#endif + getMessages pst +#if !MIN_VERSION_ghc(9,2,0) + dflags +#endif +#endif -applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> Parser.ApiAnns -> ParsedSource -> IO ParsedSource -applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do +applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> Parser.ApiAnns -> ParsedSource -> PsMessages -> IO (ParsedSource, PsMessages) +applyPluginsParsedResultAction env dflags ms hpm_annotations parsed msgs = do -- Apply parsedResultAction of plugins let applyPluginAction p opts = parsedResultAction p opts ms #if MIN_VERSION_ghc(9,3,0) - fmap (hpm_module . parsedResultModule) $ runHsc env $ withPlugins + fmap (\result -> (hpm_module (parsedResultModule result), (parsedResultMessages result))) $ runHsc env $ withPlugins #else - fmap hpm_module $ runHsc env $ withPlugins + fmap (\parsed_module -> (hpm_module parsed_module, msgs)) $ runHsc env $ withPlugins #endif #if MIN_VERSION_ghc(9,3,0) (Env.hsc_plugins env) @@ -53,7 +84,7 @@ applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do #endif applyPluginAction #if MIN_VERSION_ghc(9,3,0) - (ParsedResult (HsParsedModule parsed [] hpm_annotations) (PsMessages mempty mempty)) + (ParsedResult (HsParsedModule parsed [] hpm_annotations) msgs) #else (HsParsedModule parsed [] hpm_annotations) #endif @@ -67,6 +98,12 @@ initializePlugins env = do pure $ hscSetFlags newDf env #endif +-- | Plugins aren't stored in ModSummary anymore since GHC 9.2, but this +-- function still returns it for compatibility with 8.10 +initPlugins :: HscEnv -> ModSummary -> IO (ModSummary, HscEnv) +initPlugins session modSummary = do + session1 <- initializePlugins (hscSetFlags (ms_hspp_opts modSummary) session) + return (modSummary{ms_hspp_opts = hsc_dflags session1}, session1) hsc_static_plugins :: HscEnv -> [StaticPlugin] #if MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index ac0b18e490..32b52f31e8 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -1209,10 +1209,32 @@ checkFileCompiles fp diag = void (openTestDataDoc (dir fp)) diag + pluginSimpleTests :: TestTree pluginSimpleTests = ignoreInWindowsForGHC810 $ - ignoreForGHC92Plus "blocked on ghc-typelits-natnormalise" $ + -- Build profile: -w ghc-9.4.2 -O1 + -- In order, the following will be built (use -v for more details): + -- - ghc-typelits-natnormalise-0.7.7 (lib) (requires build) + -- - ghc-typelits-knownnat-0.7.7 (lib) (requires build) + -- - plugin-1.0.0 (lib) (first run) + -- Starting ghc-typelits-natnormalise-0.7.7 (lib) + -- Building ghc-typelits-natnormalise-0.7.7 (lib) + + -- Failed to build ghc-typelits-natnormalise-0.7.7. + -- Build log ( + -- C:\cabal\logs\ghc-9.4.2\ghc-typelits-_-0.7.7-3f036a52a0d9bfc3389d1852a87da2e87c6de2e4.log + -- ): + -- Preprocessing library for ghc-typelits-natnormalise-0.7.7.. + -- Building library for ghc-typelits-natnormalise-0.7.7.. + -- [1 of 3] Compiling GHC.TypeLits.Normalise.SOP ( src\GHC\TypeLits\Normalise\SOP.hs, dist\build\GHC\TypeLits\Normalise\SOP.o ) + -- [2 of 3] Compiling GHC.TypeLits.Normalise.Unify ( src\GHC\TypeLits\Normalise\Unify.hs, dist\build\GHC\TypeLits\Normalise\Unify.o ) + -- [3 of 3] Compiling GHC.TypeLits.Normalise ( src-ghc-9.4\GHC\TypeLits\Normalise.hs, dist\build\GHC\TypeLits\Normalise.o ) + -- C:\tools\ghc-9.4.2\lib\../mingw/bin/llvm-ar.exe: error: dist\build\objs-5156\libHSghc-typelits-_-0.7.7-3f036a52a0d9bfc3389d1852a87da2e87c6de2e4.a: No such file or directory + + -- Error: cabal: Failed to build ghc-typelits-natnormalise-0.7.7 (which is + -- required by plugin-1.0.0). See the build log above for details. + ignoreFor (BrokenSpecific Windows [GHC94]) "ghc-typelist-natnormalise fails to build on GHC 9.4.2 for windows only" $ testSessionWithExtraFiles "plugin-knownnat" "simple plugin" $ \dir -> do _ <- openDoc (dir "KnownNat.hs") "haskell" liftIO $ writeFile (dir"hie.yaml")