mirror of
https://github.com/haskell/ghcide.git
synced 2024-12-02 08:53:07 +03:00
Support plugins (#192)
* Support plugins Call initializePlugins before running typecheck. * call initializePlugins only for GHC >= 8.6 initializePlugins doesn't exist in older GHC versions. * A separate function for initializing plugins * Add a test for plugins
This commit is contained in:
parent
7a215d22ef
commit
3bec234ddb
@ -187,6 +187,7 @@ test-suite ghcide-tests
|
||||
ghc,
|
||||
--------------------------------------------------------------
|
||||
ghcide,
|
||||
ghc-typelits-knownnat,
|
||||
haskell-lsp-types,
|
||||
lens,
|
||||
lsp-test >= 0.8,
|
||||
|
@ -28,6 +28,10 @@ import qualified GHC.LanguageExtensions.Type as GHC
|
||||
import Development.IDE.Types.Options
|
||||
import Development.IDE.Types.Location
|
||||
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
import DynamicLoading (initializePlugins)
|
||||
#endif
|
||||
|
||||
import GHC hiding (parseModule, typecheckModule)
|
||||
import qualified Parser
|
||||
import Lexer
|
||||
@ -95,11 +99,23 @@ typecheckModule (IdeDefer defer) packageState deps pm =
|
||||
runGhcEnv packageState $
|
||||
catchSrcErrors "typecheck" $ do
|
||||
setupEnv deps
|
||||
let modSummary = pm_mod_summary pm
|
||||
modSummary' <- initPlugins modSummary
|
||||
(warnings, tcm) <- withWarnings "typecheck" $ \tweak ->
|
||||
GHC.typecheckModule $ demoteIfDefer pm{pm_mod_summary = tweak $ pm_mod_summary pm}
|
||||
GHC.typecheckModule $ demoteIfDefer pm{pm_mod_summary = tweak modSummary'}
|
||||
tcm2 <- mkTcModuleResult tcm
|
||||
return (map unDefer warnings, tcm2)
|
||||
|
||||
initPlugins :: GhcMonad m => ModSummary -> m ModSummary
|
||||
initPlugins modSummary = do
|
||||
#if MIN_GHC_API_VERSION(8,6,0)
|
||||
session <- getSession
|
||||
dflags <- liftIO $ initializePlugins session (ms_hspp_opts modSummary)
|
||||
return modSummary{ms_hspp_opts = dflags}
|
||||
#else
|
||||
return modSummary
|
||||
#endif
|
||||
|
||||
-- | Compile a single type-checked module to a 'CoreModule' value, or
|
||||
-- provide errors.
|
||||
compileModule
|
||||
|
@ -40,6 +40,7 @@ main = defaultMain $ testGroup "HIE"
|
||||
, diagnosticTests
|
||||
, codeActionTests
|
||||
, findDefinitionAndHoverTests
|
||||
, pluginTests
|
||||
]
|
||||
|
||||
initializeResponseTests :: TestTree
|
||||
@ -810,6 +811,28 @@ findDefinitionAndHoverTests = let
|
||||
broken = Just . (`xfail` "known broken")
|
||||
-- no = const Nothing -- don't run this test at all
|
||||
|
||||
pluginTests :: TestTree
|
||||
pluginTests = testSessionWait "plugins" $ do
|
||||
let content =
|
||||
T.unlines
|
||||
[ "{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}"
|
||||
, "{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeOperators #-}"
|
||||
, "module Testing where"
|
||||
, "import Data.Proxy"
|
||||
, "import GHC.TypeLits"
|
||||
-- This function fails without plugins being initialized.
|
||||
, "f :: forall n. KnownNat n => Proxy n -> Integer"
|
||||
, "f _ = natVal (Proxy :: Proxy n) + natVal (Proxy :: Proxy (n+2))"
|
||||
, "foo :: Int -> Int -> Int"
|
||||
, "foo a b = a + c"
|
||||
]
|
||||
_ <- openDoc' "Testing.hs" "haskell" content
|
||||
expectDiagnostics
|
||||
[ ( "Testing.hs",
|
||||
[(DsError, (8, 14), "Variable not in scope: c")]
|
||||
)
|
||||
]
|
||||
|
||||
xfail :: TestTree -> String -> TestTree
|
||||
xfail = flip expectFailBecause
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user