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:
Jinwoo Lee 2019-11-15 00:27:28 -08:00 committed by Andreas Herrmann
parent 7a215d22ef
commit 3bec234ddb
3 changed files with 41 additions and 1 deletions

View File

@ -187,6 +187,7 @@ test-suite ghcide-tests
ghc,
--------------------------------------------------------------
ghcide,
ghc-typelits-knownnat,
haskell-lsp-types,
lens,
lsp-test >= 0.8,

View File

@ -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

View File

@ -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