diff --git a/ihaskell.cabal b/ihaskell.cabal --- a/ihaskell.cabal +++ b/ihaskell.cabal @@ -7,7 +7,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.9.0.1 +version: 0.9.0.2 -- A short (one-line) description of the package. synopsis: A Haskell backend kernel for the IPython project. @@ -55,7 +55,7 @@ default-language: Haskell2010 build-depends: aeson >=1.0, - base >=4.6, + base >=4.9, base64-bytestring >=1.0, bytestring >=0.10, cereal >=0.3, @@ -63,12 +63,12 @@ containers >=0.5, directory -any, filepath -any, - ghc >=7.6, + ghc >=8.0, ghc-parser >=0.1.7, ghc-paths >=0.1, haskeline -any, hlint >=1.9, - haskell-src-exts >=1.16, + haskell-src-exts >=1.18, http-client >= 0.4, http-client-tls >= 0.2, mtl >=2.1, @@ -92,7 +92,7 @@ build-depends: bin-package-db if impl(ghc >= 8.0) - build-depends: ghc-boot >=8.0 && <8.1 + build-depends: ghc-boot >=8.0 && <8.3 exposed-modules: IHaskell.Display IHaskell.Convert @@ -128,13 +128,13 @@ other-modules: IHaskellPrelude Paths_ihaskell - ghc-options: -threaded + ghc-options: -threaded -rtsopts -- Other library packages from which modules are imported. default-language: Haskell2010 build-depends: ihaskell -any, - base >=4.6 && < 4.10, + base >=4.6 && < 4.11, text >=0.11, transformers -any, ghc >=7.6 || < 7.11, diff --git a/main/Main.hs b/main/Main.hs --- a/main/Main.hs +++ b/main/Main.hs @@ -113,6 +113,8 @@ kernelSpecOpts { kernelSpecDebug = True } addFlag kernelSpecOpts (GhcLibDir libdir) = kernelSpecOpts { kernelSpecGhcLibdir = libdir } + addFlag kernelSpecOpts (RTSFlags rts) = + kernelSpecOpts { kernelSpecRTSOptions = rts } addFlag kernelSpecOpts (KernelspecInstallPrefix prefix) = kernelSpecOpts { kernelSpecInstallPrefix = Just prefix } addFlag kernelSpecOpts KernelspecUseStack = diff --git a/src/IHaskell/Eval/Completion.hs b/src/IHaskell/Eval/Completion.hs --- a/src/IHaskell/Eval/Completion.hs +++ b/src/IHaskell/Eval/Completion.hs @@ -29,7 +29,9 @@ import System.Environment (getEnv) import GHC hiding (Qualified) -#if MIN_VERSION_ghc(7,10,0) +#if MIN_VERSION_ghc(8,2,0) +import GHC.PackageDb +#elif MIN_VERSION_ghc(7,10,0) import GHC.PackageDb (ExposedModule(exposedName)) #endif import DynFlags @@ -61,6 +63,9 @@ | KernelOption String | Extension String deriving (Show, Eq) +#if MIN_VERSION_ghc(8,2,0) +exposedName = fst +#endif #if MIN_VERSION_ghc(7,10,0) extName (FlagSpec { flagSpecName = name }) = name #else diff --git a/src/IHaskell/Eval/Evaluate.hs b/src/IHaskell/Eval/Evaluate.hs --- a/src/IHaskell/Eval/Evaluate.hs +++ b/src/IHaskell/Eval/Evaluate.hs @@ -188,7 +188,13 @@ packageIdString' :: DynFlags -> PackageConfig -> String packageIdString' dflags pkg_cfg = -#if MIN_VERSION_ghc(8,0,0) +#if MIN_VERSION_ghc(8,2,0) + case (lookupPackage dflags $ packageConfigId pkg_cfg) of + Nothing -> "(unknown)" + Just cfg -> let + PackageName name = packageName cfg + in unpackFS name +#elif MIN_VERSION_ghc(8,0,0) fromMaybe "(unknown)" (unitIdPackageIdString dflags $ packageConfigId pkg_cfg) #elif MIN_VERSION_ghc(7,10,2) fromMaybe "(unknown)" (packageKeyPackageIdString dflags $ packageConfigId pkg_cfg) @@ -222,8 +228,13 @@ initStr = "ihaskell-" +#if MIN_VERSION_ghc(8,2,0) + -- Name of the ihaskell package, i.e. "ihaskell" + iHaskellPkgName = "ihaskell" +#else -- Name of the ihaskell package, e.g. "ihaskell-1.2.3.4" iHaskellPkgName = initStr ++ intercalate "." (map show (versionBranch version)) +#endif #if !MIN_VERSION_ghc(8,0,0) unitId = packageId @@ -254,7 +265,11 @@ dropFirstAndLast = reverse . drop 1 . reverse . drop 1 toImportStmt :: String -> String +#if MIN_VERSION_ghc(8,2,0) + toImportStmt = printf importFmt . concatMap capitalize . drop 1 . split "-" +#else toImportStmt = printf importFmt . concatMap capitalize . dropFirstAndLast . split "-" +#endif displayImports = map toImportStmt displayPkgs @@ -841,16 +856,28 @@ -- is no appropriate typeclass instance, this will throw an exception and thus `attempt` will return -- False, and we just resort to plaintext. let displayExpr = printf "(IHaskell.Display.display (%s))" expr :: String +#if MIN_VERSION_ghc(8,2,0) + canRunDisplay <- attempt $ exprType TM_Inst displayExpr +#else canRunDisplay <- attempt $ exprType displayExpr +#endif -- Check if this is a widget. let widgetExpr = printf "(IHaskell.Display.Widget (%s))" expr :: String +#if MIN_VERSION_ghc(8,2,0) + isWidget <- attempt $ exprType TM_Inst widgetExpr +#else isWidget <- attempt $ exprType widgetExpr +#endif -- Check if this is a template haskell declaration let declExpr = printf "((id :: IHaskellTH.DecsQ -> IHaskellTH.DecsQ) (%s))" expr :: String let anyExpr = printf "((id :: IHaskellPrelude.Int -> IHaskellPrelude.Int) (%s))" expr :: String +#if MIN_VERSION_ghc(8,2,0) + isTHDeclaration <- liftM2 (&&) (attempt $ exprType TM_Inst declExpr) (not <$> attempt (exprType TM_Inst anyExpr)) +#else isTHDeclaration <- liftM2 (&&) (attempt $ exprType declExpr) (not <$> attempt (exprType anyExpr)) +#endif write state $ "Can Display: " ++ show canRunDisplay write state $ "Is Widget: " ++ show isWidget @@ -946,7 +973,11 @@ then display :: Display else removeSvg display +#if MIN_VERSION_ghc(8,2,0) + isIO expr = attempt $ exprType TM_Inst $ printf "((\\x -> x) :: IO a -> IO a) (%s)" expr +#else isIO expr = attempt $ exprType $ printf "((\\x -> x) :: IO a -> IO a) (%s)" expr +#endif postprocessShowError :: EvalOut -> EvalOut postprocessShowError evalOut = evalOut { evalResult = Display $ map postprocess disps } @@ -996,7 +1027,11 @@ -- Get all the type strings. dflags <- getSessionDynFlags types <- forM nonDataNames $ \name -> do +#if MIN_VERSION_ghc(8,2,0) + theType <- showSDocUnqual dflags . ppr <$> exprType TM_Inst name +#else theType <- showSDocUnqual dflags . ppr <$> exprType name +#endif return $ name ++ " :: " ++ theType return $ Display [html $ unlines $ map formatGetType types] @@ -1045,7 +1080,7 @@ -- Compile loaded modules. flags <- getSessionDynFlags errRef <- liftIO $ newIORef [] - setSessionDynFlags + setSessionDynFlags $ flip gopt_set Opt_BuildDynamicToo flags { hscTarget = objTarget flags #if MIN_VERSION_ghc(8,0,0) @@ -1309,7 +1344,11 @@ else do -- Get all the type strings. types <- forM nonItNames $ \name -> do +#if MIN_VERSION_ghc(8,2,0) + theType <- showSDocUnqual dflags . ppr <$> exprType TM_Inst name +#else theType <- showSDocUnqual dflags . ppr <$> exprType name +#endif return $ name ++ " :: " ++ theType let joined = unlines types diff --git a/src/IHaskell/Eval/Info.hs b/src/IHaskell/Eval/Info.hs --- a/src/IHaskell/Eval/Info.hs +++ b/src/IHaskell/Eval/Info.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-} +{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings #-} {- | Description : Inspect type and function information and documentation. -} module IHaskell.Eval.Info (info) where @@ -19,7 +19,11 @@ info :: String -> Interpreter String info name = ghandle handler $ do dflags <- getSessionDynFlags +#if MIN_VERSION_ghc(8,2,0) + result <- exprType TM_Inst name +#else result <- exprType name +#endif return $ typeCleaner $ showPpr dflags result where handler :: SomeException -> Interpreter String diff --git a/src/IHaskell/Eval/Lint.hs b/src/IHaskell/Eval/Lint.hs --- a/src/IHaskell/Eval/Lint.hs +++ b/src/IHaskell/Eval/Lint.hs @@ -61,7 +61,7 @@ -- Initialize hlint settings initialized <- not <$> isEmptyMVar hlintSettings unless initialized $ - autoSettings >>= putMVar hlintSettings + autoSettings' >>= putMVar hlintSettings -- Get hlint settings (flags, classify, hint) <- readMVar hlintSettings @@ -70,12 +70,18 @@ -- create 'suggestions' let modules = mapMaybe (createModule mode) blocks ideas = applyHints classify hint (map (\m -> (m, [])) modules) - suggestions = mapMaybe showIdea ideas + suggestions = mapMaybe showIdea $ filter (not . ignoredIdea) ideas return $ Display $ if null suggestions then [] else [plain $ concatMap plainSuggestion suggestions, html $ htmlSuggestions suggestions] + where + autoSettings' = do + (fixities, classify, hints) <- autoSettings + let hidingIgnore = Classify Ignore "Unnecessary hiding" "" "" + return (fixities, hidingIgnore:classify, hints) + ignoredIdea idea = ideaSeverity idea == Ignore showIdea :: Idea -> Maybe LintSuggestion showIdea idea = diff --git a/src/IHaskell/Eval/Util.hs b/src/IHaskell/Eval/Util.hs --- a/src/IHaskell/Eval/Util.hs +++ b/src/IHaskell/Eval/Util.hs @@ -224,7 +224,11 @@ doc sdoc = do flags <- getSessionDynFlags unqual <- getPrintUnqual +#if MIN_VERSION_ghc(8,2,0) + let style = O.mkUserStyle flags unqual O.AllTheWay +#else let style = O.mkUserStyle unqual O.AllTheWay +#endif let cols = pprCols flags d = O.runSDoc sdoc (O.initSDocContext flags style) return $ Pretty.fullRender Pretty.PageMode cols 1.5 string_txt "" d @@ -256,6 +260,21 @@ #else dflags = flag Opt_ExtendedDefaultRules . unflag Opt_MonomorphismRestriction $ originalFlags #endif +#if MIN_VERSION_ghc(8,2,0) + pkgFlags = + case sandboxPackages of + Nothing -> packageDBFlags originalFlags + Just path -> + let pkg = PackageDB $ PkgConfFile path + in packageDBFlags originalFlags ++ [pkg] + + void $ setSessionDynFlags $ dflags + { hscTarget = HscInterpreted + , ghcLink = LinkInMemory + , pprCols = 300 + , packageDBFlags = pkgFlags + } +#else pkgConfs = case sandboxPackages of Nothing -> extraPkgConfs originalFlags @@ -269,6 +288,7 @@ , pprCols = 300 , extraPkgConfs = pkgConfs } +#endif -- | Evaluate a single import statement. If this import statement is importing a module which was -- previously imported implicitly (such as `Prelude`) or if this module has a `hiding` annotation, @@ -359,7 +379,11 @@ -- | Get the type of an expression and convert it to a string. getType :: GhcMonad m => String -> m String getType expr = do +#if MIN_VERSION_ghc(8,2,0) + result <- exprType TM_Inst expr +#else result <- exprType expr +#endif flags <- getSessionDynFlags let typeStr = O.showSDocUnqual flags $ O.ppr result return typeStr diff --git a/src/IHaskell/Flags.hs b/src/IHaskell/Flags.hs --- a/src/IHaskell/Flags.hs +++ b/src/IHaskell/Flags.hs @@ -31,6 +31,8 @@ data Argument = ConfFile String -- ^ A file with commands to load at startup. | OverwriteFiles -- ^ Present when output should overwrite existing files. | GhcLibDir String -- ^ Where to find the GHC libraries. + | RTSFlags [String] -- ^ Options for the GHC runtime (e.g. heap-size limit + -- or number of threads). | KernelDebug -- ^ Spew debugging output from the kernel. | Help -- ^ Display help text. | Version -- ^ Display version text. @@ -96,6 +98,20 @@ ghcLibFlag :: Flag Args ghcLibFlag = flagReq ["ghclib", "l"] (store GhcLibDir) "" "Library directory for GHC." +ghcRTSFlag :: Flag Args +ghcRTSFlag = flagReq ["use-rtsopts"] storeRTS "\"\"" + "Runtime options (multithreading etc.). See `ghc +RTS -?`." + where storeRTS allRTSFlags (Args mode prev) + = fmap (Args mode . (:prev) . RTSFlags) + . parseRTS . words $ filter (/='"') allRTSFlags + parseRTS ("+RTS":fs) -- Ignore if this is included (we already wrap + = parseRTS fs -- the ihaskell-kernel call in +RTS -RTS anyway) + parseRTS ["-RTS"] = Right [] + parseRTS ("-RTS":_) -- Evil injection of extra arguments? Unlikely, but... + = Left "Adding non-RTS options to --use-rtsopts not permitted." + parseRTS (f:fs) = (f:) <$> parseRTS fs + parseRTS [] = Right [] + kernelDebugFlag :: Flag Args kernelDebugFlag = flagNone ["debug"] addDebug "Print debugging output from the kernel." where @@ -125,7 +141,7 @@ installKernelSpec :: Mode Args installKernelSpec = mode "install" (Args InstallKernelSpec []) "Install the Jupyter kernelspec." noArgs - [ghcLibFlag, kernelDebugFlag, confFlag, installPrefixFlag, helpFlag, kernelStackFlag] + [ghcLibFlag, ghcRTSFlag, kernelDebugFlag, confFlag, installPrefixFlag, helpFlag, kernelStackFlag] kernel :: Mode Args kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel." kernelArg diff --git a/src/IHaskell/IPython.hs b/src/IHaskell/IPython.hs --- a/src/IHaskell/IPython.hs +++ b/src/IHaskell/IPython.hs @@ -45,6 +45,7 @@ data KernelSpecOptions = KernelSpecOptions { kernelSpecGhcLibdir :: String -- ^ GHC libdir. + , kernelSpecRTSOptions :: [String] -- ^ Runtime options to use. , kernelSpecDebug :: Bool -- ^ Spew debugging output? , kernelSpecConfFile :: IO (Maybe String) -- ^ Filename of profile JSON file. , kernelSpecInstallPrefix :: Maybe String @@ -54,6 +55,8 @@ defaultKernelSpecOptions :: KernelSpecOptions defaultKernelSpecOptions = KernelSpecOptions { kernelSpecGhcLibdir = GHC.Paths.libdir + , kernelSpecRTSOptions = ["-M3g", "-N2"] -- Memory cap 3 GiB, + -- multithreading on two processors. , kernelSpecDebug = False , kernelSpecConfFile = defaultConfFile , kernelSpecInstallPrefix = Nothing @@ -191,6 +194,9 @@ Nothing -> [] Just file -> ["--conf", file]) ++ ["--ghclib", kernelSpecGhcLibdir opts] + ++ (case kernelSpecRTSOptions opts of + [] -> [] + rtsOpts -> "+RTS" : kernelSpecRTSOptions opts ++ ["-RTS"]) ++ ["--stack" | kernelSpecUseStack opts] let kernelSpec = KernelSpec diff --git a/src/tests/IHaskell/Test/Eval.hs b/src/tests/IHaskell/Test/Eval.hs --- a/src/tests/IHaskell/Test/Eval.hs +++ b/src/tests/IHaskell/Test/Eval.hs @@ -159,6 +159,11 @@ "putStrLn \"Привет!\"" `becomes` ["Привет!"] it "evaluates directives" $ do +#if MIN_VERSION_ghc(8,2,0) + -- It's `p` instead of `t` for some reason + ":typ 3" `becomes` ["3 :: forall p. Num p => p"] +#else ":typ 3" `becomes` ["3 :: forall t. Num t => t"] +#endif ":k Maybe" `becomes` ["Maybe :: * -> *"] ":in String" `pages` ["type String = [Char] \t-- Defined in \8216GHC.Base\8217"]