ihaskell 0.10.1.2 → 0.10.2.0
raw patch · 11 files changed
+171/−45 lines, 11 filesdep +exceptionsdep ~basedep ~ghcdep ~ghc-boot
Dependencies added: exceptions
Dependency ranges changed: base, ghc, ghc-boot
Files
- ihaskell.cabal +10/−6
- main/Main.hs +15/−13
- src/IHaskell/Eval/Completion.hs +14/−0
- src/IHaskell/Eval/Evaluate.hs +72/−14
- src/IHaskell/Eval/Info.hs +9/−0
- src/IHaskell/Eval/Inspect.hs +8/−0
- src/IHaskell/Eval/Lint.hs +2/−3
- src/IHaskell/Eval/Util.hs +29/−7
- src/IHaskell/Flags.hs +6/−1
- src/IHaskell/IPython.hs +2/−0
- src/tests/IHaskell/Test/Eval.hs +4/−1
ihaskell.cabal view
@@ -7,7 +7,7 @@ -- PVP summary: +--+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.10.1.2+version: 0.10.2.0 -- A short (one-line) description of the package. synopsis: A Haskell backend kernel for the IPython project.@@ -40,7 +40,7 @@ build-type: Simple -- Constraint on the version of Cabal needed to build this package.-cabal-version: >=1.16+cabal-version: 1.16 data-files: html/kernel.js@@ -63,13 +63,13 @@ cmdargs >=0.10, containers >=0.5, directory -any,+ exceptions -any, filepath -any, ghc >=8.0, ghc-parser >=0.2.1, ghc-paths >=0.1, haskeline -any, hlint >=1.9,- haskell-src-exts >=1.18, http-client >= 0.4, http-client-tls >= 0.2, mtl >=2.1,@@ -88,8 +88,12 @@ utf8-string -any, vector -any, ipython-kernel >=0.10.2.0,- ghc-boot >=8.0 && <8.11+ ghc-boot >=8.0 && <9.1 + if impl (ghc < 8.10)+ build-depends:+ haskell-src-exts >=1.18+ exposed-modules: IHaskell.Display IHaskell.Convert IHaskell.Convert.Args@@ -135,10 +139,10 @@ default-language: Haskell2010 build-depends: ihaskell -any,- base >=4.9 && < 4.15,+ base >=4.9 && < 4.16, text >=0.11, transformers -any,- ghc >=8.0 && < 8.11,+ ghc >=8.0 && < 9.1, process >=1.1, aeson >=0.7, bytestring >=0.10,
main/Main.hs view
@@ -88,6 +88,8 @@ kernelSpecOpts { kernelSpecConfFile = return (Just filename) } addFlag kernelSpecOpts KernelDebug = kernelSpecOpts { kernelSpecDebug = True }+ addFlag kernelSpecOpts (CodeMirror codemirror) =+ kernelSpecOpts { kernelSpecCodeMirror = codemirror } addFlag kernelSpecOpts (GhcLibDir libdir) = kernelSpecOpts { kernelSpecGhcLibdir = libdir } addFlag kernelSpecOpts (RTSFlags rts) =@@ -191,7 +193,7 @@ else do -- Create the reply, possibly modifying kernel state. oldState <- liftIO $ takeMVar state- (newState, reply) <- replyTo interface request replyHeader oldState+ (newState, reply) <- replyTo kOpts interface request replyHeader oldState liftIO $ putMVar state newState -- Write the reply to the reply channel.@@ -224,11 +226,11 @@ newMessageId (mhSessionId parent) (mhUsername parent) repType [] -- | Compute a reply to a message.-replyTo :: ZeroMQInterface -> Message -> MessageHeader -> KernelState -> Interpreter (KernelState, Message)+replyTo :: KernelSpecOptions -> ZeroMQInterface -> Message -> MessageHeader -> KernelState -> Interpreter (KernelState, Message) -- Reply to kernel info requests with a kernel info reply. No computation needs to be done, as a -- kernel info reply is a static object (all info is hard coded into the representation of that -- message type).-replyTo interface KernelInfoRequest{} replyHeader state = do+replyTo kOpts interface KernelInfoRequest{} replyHeader state = do let send msg = liftIO $ writeChan (iopubChannel interface) msg -- Notify the frontend that the Kernel is idle@@ -246,14 +248,14 @@ { languageName = "haskell" , languageVersion = VERSION_ghc , languageFileExtension = ".hs"- , languageCodeMirrorMode = "ihaskell"+ , languageCodeMirrorMode = kernelSpecCodeMirror kOpts , languagePygmentsLexer = "Haskell" , languageMimeType = "text/x-haskell" -- https://jupyter-client.readthedocs.io/en/stable/wrapperkernels.html#MyKernel.language_info } , status = Ok }) -replyTo _ CommInfoRequest{} replyHeader state =+replyTo _ _ CommInfoRequest{} replyHeader state = let comms = Map.mapKeys (UUID.uuidToString) (openComms state) in return (state, CommInfoReply@@ -263,13 +265,13 @@ -- Reply to a shutdown request by exiting the main thread. Before shutdown, reply to the request to -- let the frontend know shutdown is happening.-replyTo interface ShutdownRequest { restartPending = pending } replyHeader _ = liftIO $ do+replyTo _ interface ShutdownRequest { restartPending = pending } replyHeader _ = liftIO $ do writeChan (shellReplyChannel interface) $ ShutdownReply replyHeader pending exitSuccess -- Reply to an execution request. The reply itself does not require computation, but this causes -- messages to be sent to the IOPub socket with the output of the code in the execution request.-replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do+replyTo _ interface req@ExecuteRequest { getCode = code } replyHeader state = do -- Convenience function to send a message to the IOPub socket. let send msg = liftIO $ writeChan (iopubChannel interface) msg @@ -310,7 +312,7 @@ -- Check for a trailing empty line. If it doesn't exist, we assume the code is incomplete, -- otherwise we assume the code is complete. Todo: Implement a mechanism that only requests -- a trailing empty line, when multiline code is entered.-replyTo _ req@IsCompleteRequest{} replyHeader state = do+replyTo _ _ req@IsCompleteRequest{} replyHeader state = do isComplete <- isInputComplete let reply = IsCompleteReply { header = replyHeader, reviewResult = isComplete } return (state, reply)@@ -323,7 +325,7 @@ else return $ CodeIncomplete $ indent 4 indent n = take n $ repeat ' ' -replyTo _ req@CompleteRequest{} replyHeader state = do+replyTo _ _ req@CompleteRequest{} replyHeader state = do let code = getCode req pos = getCursorPos req (matchedText, completions) <- complete (T.unpack code) pos@@ -333,7 +335,7 @@ reply = CompleteReply replyHeader (map T.pack completions) start end (Metadata HashMap.empty) True return (state, reply) -replyTo _ req@InspectRequest{} replyHeader state = do+replyTo _ _ req@InspectRequest{} replyHeader state = do result <- inspect (T.unpack $ inspectCode req) (inspectCursorPos req) let reply = case result of@@ -346,7 +348,7 @@ return (state, reply) -- TODO: Implement history_reply.-replyTo _ HistoryRequest{} replyHeader state = do+replyTo _ _ HistoryRequest{} replyHeader state = do let reply = HistoryReply { header = replyHeader -- FIXME@@ -365,7 +367,7 @@ -- -- Sending the message only on the shell_reply channel doesn't work, so we send it as a comm message -- on the iopub channel and return the SendNothing message.-replyTo interface ocomm@CommOpen{} replyHeader state = do+replyTo _ interface ocomm@CommOpen{} replyHeader state = do let send = liftIO . writeChan (iopubChannel interface) incomingUuid = commUuid ocomm@@ -393,7 +395,7 @@ return (state, SendNothing) -- TODO: What else can be implemented?-replyTo _ message _ state = do+replyTo _ _ message _ state = do liftIO $ hPutStrLn stderr $ "Unimplemented message: " ++ show message return (state, SendNothing)
src/IHaskell/Eval/Completion.hs view
@@ -22,10 +22,18 @@ import System.Environment (getEnv) import GHC+#if MIN_VERSION_ghc(9,0,0)+import GHC.Unit.Database+import GHC.Unit.State+import GHC.Driver.Session+import GHC.Driver.Monad as GhcMonad+import GHC.Utils.Outputable (showPpr)+#else import GHC.PackageDb import DynFlags import GhcMonad import Outputable (showPpr)+#endif import System.Directory import Control.Exception (try)@@ -74,9 +82,15 @@ unqualNames = nub $ filter (not . isQualified) rdrNames qualNames = nub $ scopeNames ++ filter isQualified rdrNames +#if MIN_VERSION_ghc(9,0,0)+ let Just db = unitDatabases flags+ getNames = map (moduleNameString . exposedName) . unitExposedModules+ moduleNames = nub $ concatMap getNames $ concatMap unitDatabaseUnits db+#else let Just db = pkgDatabase flags getNames = map (moduleNameString . exposedName) . exposedModules moduleNames = nub $ concatMap getNames $ concatMap snd db+#endif let target = completionTarget line pos completion = completionType line pos target
src/IHaskell/Eval/Evaluate.hs view
@@ -28,7 +28,6 @@ import Data.Char as Char import Data.Dynamic import qualified Data.Serialize as Serialize-import qualified Debugger import System.Directory import System.Posix.IO (fdToHandle) import System.IO (hGetChar, hSetEncoding, utf8)@@ -38,19 +37,34 @@ import Data.Maybe (mapMaybe) import System.Environment (getEnv) -import qualified GHC.Paths-import InteractiveEval+#if MIN_VERSION_ghc(9,0,0)+import qualified GHC.Runtime.Debugger as Debugger+import GHC.Runtime.Eval+import GHC.Driver.Session+import GHC.Driver.Types+import GHC.Unit.State+import Control.Monad.Catch as MC+import GHC.Utils.Outputable hiding ((<>))+import GHC.Data.Bag+import GHC.Unit.Types (UnitId)+import qualified GHC.Utils.Error as ErrUtils+#else+import qualified Debugger+import Bag import DynFlags-import Exception (gtry) import HscTypes-import GhcMonad (liftIO)-import GHC hiding (Stmt, TypeSig)+import InteractiveEval+import Exception (gtry) import Exception hiding (evaluate)+import GhcMonad (liftIO) import Outputable hiding ((<>)) import Packages-import Bag import qualified ErrUtils+#endif +import qualified GHC.Paths+import GHC hiding (Stmt, TypeSig)+ import IHaskell.Types import IHaskell.IPython import IHaskell.Eval.Parser@@ -61,15 +75,33 @@ import IHaskell.BrokenPackages import StringUtils (replace, split, strip, rstrip) -#if MIN_VERSION_ghc(8,2,0)+#if MIN_VERSION_ghc(9,0,0)+import GHC.Data.FastString+#elif MIN_VERSION_ghc(8,2,0) import FastString (unpackFS) #else import Paths_ihaskell (version) import Data.Version (versionBranch) #endif +#if MIN_VERSION_ghc(9,0,0)+gcatch :: Ghc a -> (SomeException -> Ghc a) -> Ghc a+gcatch = MC.catch +gtry :: IO a -> IO (Either SomeException a)+gtry = MC.try +gfinally :: Ghc a -> Ghc b -> Ghc a+gfinally = MC.finally++ghandle :: (MonadCatch m, Exception e) => (e -> m a) -> m a -> m a+ghandle = MC.handle++throw :: SomeException -> Ghc a+throw = MC.throwM+#endif++ -- | Set GHC's verbosity for debugging ghcVerbosity :: Maybe Int ghcVerbosity = Nothing -- Just 5@@ -157,9 +189,19 @@ -- Run the rest of the interpreter action hasSupportLibraries +#if MIN_VERSION_ghc(9,0,0)+packageIdString' :: DynFlags -> UnitInfo -> String+#else packageIdString' :: DynFlags -> PackageConfig -> String+#endif packageIdString' dflags pkg_cfg =-#if MIN_VERSION_ghc(8,2,0)+#if MIN_VERSION_ghc(9,0,0)+ case (lookupUnit (unitState dflags) $ mkUnit pkg_cfg) of+ Nothing -> "(unknown)"+ Just cfg -> let+ PackageName name = unitPackageName cfg+ in unpackFS name+#elif MIN_VERSION_ghc(8,2,0) case (lookupPackage dflags $ packageConfigId pkg_cfg) of Nothing -> "(unknown)" Just cfg -> let@@ -169,11 +211,19 @@ fromMaybe "(unknown)" (unitIdPackageIdString dflags $ packageConfigId pkg_cfg) #endif +#if MIN_VERSION_ghc(9,0,0)+getPackageConfigs :: DynFlags -> [GenUnitInfo UnitId]+getPackageConfigs dflags =+ foldMap unitDatabaseUnits pkgDb+ where+ Just pkgDb = unitDatabases dflags+#else getPackageConfigs :: DynFlags -> [PackageConfig] getPackageConfigs dflags = foldMap snd pkgDb where Just pkgDb = pkgDatabase dflags+#endif -- | Initialize our GHC session with imports and a value for 'it'. Return whether the IHaskell -- library is available.@@ -183,7 +233,11 @@ -- version of the ihaskell library. Also verify that the packages we load are not broken. dflags <- getSessionDynFlags broken <- liftIO getBrokenPackages+#if MIN_VERSION_ghc(9,0,0)+ dflgs <- liftIO $ initUnits dflags+#else (dflgs, _) <- liftIO $ initPackages dflags+#endif let db = getPackageConfigs dflgs packageNames = map (packageIdString' dflgs) db hiddenPackages = Set.intersection hiddenPackageNames (Set.fromList packageNames)@@ -709,11 +763,7 @@ ExitSuccess -> return $ Display [plain out] ExitFailure code -> do let errMsg = "Process exited with error code " ++ show code- htmlErr = printf "<span class='err-msg'>%s</span>" errMsg- return $ Display- [ plain $ out ++ "\n" ++ errMsg- , html $ printf "<span class='mono'>%s</span>" out ++ htmlErr- ]+ return $ Display [plain $ out ++ "\n" ++ errMsg] loop -- This is taken largely from GHCi's info section in InteractiveUI.@@ -790,7 +840,11 @@ evalCommand _ (Directive SPrint binding) state = wrapExecution state $ do flags <- getSessionDynFlags contents <- liftIO $ newIORef []+#if MIN_VERSION_ghc(9,0,0)+ let action = \_dflags _warn _sev _srcspan msg -> modifyIORef' contents (showSDoc flags msg :)+#else let action = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' contents (showSDoc flags msg :)+#endif let flags' = flags { log_action = action } _ <- setSessionDynFlags flags' Debugger.pprintClosureCommand False False binding@@ -1032,7 +1086,11 @@ _ <- setSessionDynFlags $ flip gopt_set Opt_BuildDynamicToo flags { hscTarget = objTarget flags+#if MIN_VERSION_ghc(9,0,0)+ , log_action = \_dflags _warn _sev _srcspan msg -> modifyIORef' errRef (showSDoc flags msg :)+#else , log_action = \_dflags _sev _srcspan _ppr _style msg -> modifyIORef' errRef (showSDoc flags msg :)+#endif } -- Load the new target.
src/IHaskell/Eval/Info.hs view
@@ -8,11 +8,20 @@ import IHaskell.Eval.Evaluate (typeCleaner, Interpreter) import GHC+#if MIN_VERSION_ghc(9,0,0)+import GHC.Utils.Outputable+import Control.Monad.Catch (handle)+#else import Outputable import Exception+#endif info :: String -> Interpreter String+#if MIN_VERSION_ghc(9,0,0)+info name = handle handler $ do+#else info name = ghandle handler $ do+#endif dflags <- getSessionDynFlags #if MIN_VERSION_ghc(8,2,0) result <- exprType TM_Inst name
src/IHaskell/Eval/Inspect.hs view
@@ -12,7 +12,11 @@ import Data.List.Split (splitOn) +#if MIN_VERSION_ghc(9,0,0)+import qualified Control.Monad.Catch as MC+#else import Exception (ghandle)+#endif import IHaskell.Eval.Evaluate (Interpreter) import IHaskell.Display@@ -44,7 +48,11 @@ let identifier = getIdentifier code pos handler :: SomeException -> Interpreter (Maybe a) handler _ = return Nothing+#if MIN_VERSION_ghc(9,0,0)+ response <- MC.handle handler (Just <$> getType identifier)+#else response <- ghandle handler (Just <$> getType identifier)+#endif let prefix = identifier ++ " :: " fmt str = Display [plain $ prefix ++ str] return $ fmt <$> response
src/IHaskell/Eval/Lint.hs view
@@ -232,13 +232,12 @@ [ named $ suggestion suggest , floating "left" $ styl severityClass "Found:" ++ -- Things that look like this get highlighted.- styleId "highlight-code" "haskell" (escapeDollar $ found suggest)+ styleId "highlight-code" "haskell" (found suggest) , floating "left" $ styl severityClass "Why Not:" ++ -- Things that look like this get highlighted.- styleId "highlight-code" "haskell" (escapeDollar $ whyNot suggest)+ styleId "highlight-code" "haskell" (whyNot suggest) ] where- escapeDollar = replace "$" "\\$" severityClass = case severity suggest of Error -> "error"
src/IHaskell/Eval/Util.hs view
@@ -33,12 +33,21 @@ #endif -- GHC imports.-import DynFlags-#if MIN_VERSION_ghc(8,6,0)+#if MIN_VERSION_ghc(9,0,0)+import GHC.Core.InstEnv (is_cls, is_tys)+import GHC.Core.Unify+import GHC.Core.Ppr.TyThing+import GHC.Driver.CmdLine+import GHC.Driver.Monad (modifySession)+import GHC.Driver.Session+import GHC.Driver.Types+import GHC.Types.Name (pprInfixName)+import GHC.Types.Name.Set+import qualified GHC.Driver.Session as DynFlags+import qualified GHC.Utils.Outputable as O+import qualified GHC.Utils.Ppr as Pretty #else-import FastString-#endif-import GHC+import DynFlags import GhcMonad import HscTypes import NameSet@@ -48,6 +57,12 @@ import Unify (tcMatchTys) import qualified Pretty import qualified Outputable as O+#endif+#if MIN_VERSION_ghc(8,6,0)+#else+import FastString+#endif+import GHC import Control.Monad (void) import Data.Function (on)@@ -55,7 +70,8 @@ import StringUtils (replace) -#if MIN_VERSION_ghc(8,4,0)+#if MIN_VERSION_ghc(9,0,0)+#elif MIN_VERSION_ghc(8,4,0) import CmdLineParser (warnMsg) #endif @@ -228,7 +244,9 @@ doc sdoc = do flags <- getSessionDynFlags unqual <- getPrintUnqual-#if MIN_VERSION_ghc(8,2,0)+#if MIN_VERSION_ghc(9,0,0)+ let style = O.mkUserStyle unqual O.AllTheWay+#elif MIN_VERSION_ghc(8,2,0) let style = O.mkUserStyle flags unqual O.AllTheWay #else let style = O.mkUserStyle unqual O.AllTheWay@@ -270,7 +288,11 @@ case sandboxPackages of Nothing -> packageDBFlags originalFlags Just path ->+#if MIN_VERSION_ghc(9,0,0)+ let pkg = PackageDB $ PkgDbPath path+#else let pkg = PackageDB $ PkgConfFile path+#endif in packageDBFlags originalFlags ++ [pkg] void $ setSessionDynFlags $ dflags
src/IHaskell/Flags.hs view
@@ -31,6 +31,7 @@ | KernelDebug -- ^ Spew debugging output from the kernel. | Help -- ^ Display help text. | Version -- ^ Display version text.+ | CodeMirror String -- ^ change codemirror mode (default=ihaskell) | ConvertFrom String | ConvertTo String | ConvertFromFormat NotebookFormat@@ -113,6 +114,10 @@ where addDebug (Args md prev) = Args md (KernelDebug : prev) +kernelCodeMirrorFlag :: Flag Args+kernelCodeMirrorFlag = flagReq ["codemirror"] (store CodeMirror) "<codemirror>"+ "Specify codemirror mode that is used for syntax highlighting (default: ihaskell)."+ kernelStackFlag :: Flag Args kernelStackFlag = flagNone ["stack"] addStack "Inherit environment from `stack` when it is installed"@@ -143,7 +148,7 @@ kernel :: Mode Args kernel = mode "kernel" (Args (Kernel Nothing) []) "Invoke the IHaskell kernel." kernelArg- [ghcLibFlag, kernelDebugFlag, confFlag, kernelStackFlag]+ [ghcLibFlag, kernelDebugFlag, confFlag, kernelStackFlag, kernelCodeMirrorFlag] where kernelArg = flagArg update "<json-kernel-file>" update filename (Args _ flags) = Right $ Args (Kernel $ Just filename) flags
src/IHaskell/IPython.hs view
@@ -39,6 +39,7 @@ { kernelSpecGhcLibdir :: String -- ^ GHC libdir. , kernelSpecRTSOptions :: [String] -- ^ Runtime options to use. , kernelSpecDebug :: Bool -- ^ Spew debugging output?+ , kernelSpecCodeMirror :: String -- ^ CodeMirror mode , kernelSpecConfFile :: IO (Maybe String) -- ^ Filename of profile JSON file. , kernelSpecInstallPrefix :: Maybe String , kernelSpecUseStack :: Bool -- ^ Whether to use @stack@ environments.@@ -50,6 +51,7 @@ , kernelSpecRTSOptions = ["-M3g", "-N2"] -- Memory cap 3 GiB, -- multithreading on two processors. , kernelSpecDebug = False+ , kernelSpecCodeMirror = "ihaskell" , kernelSpecConfFile = defaultConfFile , kernelSpecInstallPrefix = Nothing , kernelSpecUseStack = False
src/tests/IHaskell/Test/Eval.hs view
@@ -161,7 +161,10 @@ ":! printf \"hello\\nworld\"" `becomes` ["hello\nworld"] it "evaluates directives" $ do-#if MIN_VERSION_ghc(8,2,0)+#if MIN_VERSION_ghc(9,0,0)+ -- brackets around the type variable+ ":typ 3" `becomes` ["3 :: forall {p}. Num p => p"]+#elif 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