IHaskell.Eval.Evaluate: don't support libraries for testing

This commit is contained in:
Vaibhav Sagar 2019-09-26 10:51:23 -04:00
parent bfa80bce5c
commit 1509bff879
3 changed files with 17 additions and 14 deletions

View File

@ -142,7 +142,7 @@ runKernel kOpts profileSrc = do
kernelState { kernelDebug = debug }
-- Receive and reply to all messages on the shell socket.
interpret libdir True $ \hasSupportLibraries -> do
interpret libdir True True $ \hasSupportLibraries -> do
-- Ignore Ctrl-C the first time. This has to go inside the `interpret`, because GHC API resets the
-- signal handlers for some reason (completely unknown to me).
_ <- liftIO ignoreCtrlC

View File

@ -119,19 +119,21 @@ hiddenPackageNames = Set.fromList ["ghc-lib", "ghc-lib-parser"]
-- | Interpreting function for testing.
testInterpret :: Interpreter a -> IO a
testInterpret v = interpret GHC.Paths.libdir False (const v)
testInterpret v = interpret GHC.Paths.libdir False False (const v)
-- | Evaluation function for testing.
testEvaluate :: String -> IO ()
testEvaluate str = void $ testInterpret $
evaluate defaultKernelState str (\_ _ -> return ()) (\state _ -> return state)
-- | Run an interpreting action. This is effectively runGhc with initialization and importing. First
-- argument indicates whether `stdin` is handled specially, which cannot be done in a testing
-- environment. The argument passed to the action indicates whether Haskell support libraries are
-- available.
interpret :: String -> Bool -> (Bool -> Interpreter a) -> IO a
interpret libdir allowedStdin action = runGhc (Just libdir) $ do
-- | Run an interpreting action. This is effectively runGhc with initialization
-- and importing. The `allowedStdin` argument indicates whether `stdin` is
-- handled specially, which cannot be done in a testing environment. The
-- `needsSupportLibraries` argument indicates whether we want support libraries
-- to be imported, which is not the case during testing. The argument passed to
-- the action indicates whether the IHaskell library is available.
interpret :: String -> Bool -> Bool -> (Bool -> Interpreter a) -> IO a
interpret libdir allowedStdin needsSupportLibraries action = runGhc (Just libdir) $ do
-- If we're in a sandbox, add the relevant package database
sandboxPackages <- liftIO getSandboxPackageConf
initGhci sandboxPackages
@ -141,7 +143,7 @@ interpret libdir allowedStdin action = runGhc (Just libdir) $ do
void $ setSessionDynFlags $ dflags { verbosity = verb }
Nothing -> return ()
hasSupportLibraries <- initializeImports
hasSupportLibraries <- initializeImports needsSupportLibraries
-- Close stdin so it can't be used. Otherwise it'll block the kernel forever.
dir <- liftIO getIHaskellDir
@ -173,9 +175,9 @@ getPackageConfigs dflags =
Just pkgDb = pkgDatabase dflags
-- | Initialize our GHC session with imports and a value for 'it'. Return whether the IHaskell
-- support libraries are available.
initializeImports :: Interpreter Bool
initializeImports = do
-- library is available.
initializeImports :: Bool -> Interpreter Bool
initializeImports importSupportLibraries = do
-- Load packages that start with ihaskell-*, aren't just IHaskell, and depend directly on the right
-- version of the ihaskell library. Also verify that the packages we load are not broken.
dflags <- getSessionDynFlags
@ -229,10 +231,11 @@ initializeImports = do
-- Import implicit prelude.
importDecl <- parseImportDecl "import Prelude"
let implicitPrelude = importDecl { ideclImplicit = True }
displayImports' = if importSupportLibraries then displayImports else []
-- Import modules.
imports <- mapM parseImportDecl $ requiredGlobalImports ++ if hasIHaskellPackage
then ihaskellGlobalImports ++ displayImports
then ihaskellGlobalImports ++ displayImports'
else []
setContext $ map IIDecl $ implicitPrelude : imports

View File

@ -34,7 +34,7 @@ eval string = do
getTemporaryDirectory >>= setCurrentDirectory
let state = defaultKernelState { getLintStatus = LintOff }
_ <- interpret GHC.Paths.libdir False $ const $
_ <- interpret GHC.Paths.libdir False False $ const $
IHaskell.Eval.Evaluate.evaluate state string publish noWidgetHandling
out <- readIORef outputAccum
pagerout <- readIORef pagerAccum