X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2FInteractiveUI.hs;h=9807556435d7e2711c5bb0723484220ca51b7852;hp=f12773521d31909dad7850233def36369df82ea1;hb=0eca7e0b307c5862212c9eebfc69af9743ef06f3;hpb=db604b9dd4cb26b317048d1c143693bbf8fa9727 diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index f127735..9807556 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -377,12 +377,12 @@ runGHCi paths maybe_exprs = do current_dir = return (Just ".ghci") - app_user_dir = io $ withGhcAppData + app_user_dir = liftIO $ withGhcAppData (\dir -> return (Just (dir "ghci.conf"))) (return Nothing) home_dir = do - either_dir <- io $ IO.try (getEnv "HOME") + either_dir <- liftIO $ IO.try (getEnv "HOME") case either_dir of Right home -> return (Just (home ".ghci")) _ -> return Nothing @@ -393,12 +393,12 @@ runGHCi paths maybe_exprs = do sourceConfigFile :: FilePath -> GHCi () sourceConfigFile file = do - exists <- io $ doesFileExist file + exists <- liftIO $ doesFileExist file when exists $ do - dir_ok <- io $ checkPerms (getDirectory file) - file_ok <- io $ checkPerms file + dir_ok <- liftIO $ checkPerms (getDirectory file) + file_ok <- liftIO $ checkPerms file when (dir_ok && file_ok) $ do - either_hdl <- io $ IO.try (openFile file ReadMode) + either_hdl <- liftIO $ IO.try (openFile file ReadMode) case either_hdl of Left _e -> return () -- NOTE: this assumes that runInputT won't affect the terminal; @@ -411,7 +411,7 @@ runGHCi paths maybe_exprs = do when (read_dot_files) $ do mcfgs0 <- sequence [ current_dir, app_user_dir, home_dir ] - mcfgs <- io $ mapM canonicalizePath' (catMaybes mcfgs0) + mcfgs <- liftIO $ mapM canonicalizePath' (catMaybes mcfgs0) mapM_ sourceConfigFile $ nub $ catMaybes mcfgs -- nub, because we don't want to read .ghci twice if the -- CWD is $HOME. @@ -427,11 +427,11 @@ runGHCi paths maybe_exprs = do filePaths' <- mapM (Encoding.decode . BS.pack) filePaths loadModule (zip filePaths' phases) when (isJust maybe_exprs && failed ok) $ - io (exitWith (ExitFailure 1)) + liftIO (exitWith (ExitFailure 1)) -- if verbosity is greater than 0, or we are connected to a -- terminal, display the prompt in the interactive loop. - is_tty <- io (hIsTerminalDevice stdin) + is_tty <- liftIO (hIsTerminalDevice stdin) dflags <- getDynFlags let show_prompt = verbosity dflags > 0 || is_tty @@ -449,19 +449,19 @@ runGHCi paths maybe_exprs = do -- Jump through some hoops to get the -- current progname in the exception text: -- : - io $ withProgName (progname st) + liftIO $ withProgName (progname st) -- this used to be topHandlerFastExit, see #2228 - $ topHandler e + $ topHandler e runInputTWithPrefs defaultPrefs defaultSettings $ do runCommands' handle (return Nothing) -- and finally, exit - io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi." + liftIO $ when (verbosity dflags > 0) $ putStrLn "Leaving GHCi." runGHCiInput :: InputT GHCi a -> GHCi a runGHCiInput f = do - histFile <- io $ withGhcAppData (\dir -> return (Just (dir "ghci_history"))) - (return Nothing) + histFile <- liftIO $ withGhcAppData (\dir -> return (Just (dir "ghci_history"))) + (return Nothing) let settings = setComplete ghciCompleteWord $ defaultSettings {historyFile = histFile} runInputT settings f @@ -599,7 +599,7 @@ runOneCommand eh getCmd = do (doCommand c) where printErrorAndKeepGoing err = do - GHC.printExceptionAndWarnings err + GHC.printException err return False noSpace q = q >>= maybe (return Nothing) @@ -687,7 +687,7 @@ afterRunStmt step_here run_result = do _ -> return () flushInterpBuffers - io installSignalHandlers + liftIO installSignalHandlers b <- isOptionSet RevertCAFs when b revertCAFs @@ -755,7 +755,7 @@ lookupCommand "" = do Just c -> return $ GotCommand c Nothing -> return NoLastCommand lookupCommand str = do - mc <- io $ lookupCommand' str + mc <- liftIO $ lookupCommand' str st <- getGHCiState setGHCiState st{ last_command = mc } return $ case mc of @@ -808,14 +808,14 @@ getCurrentBreakModule = do noArgs :: GHCi () -> String -> GHCi () noArgs m "" = m -noArgs _ _ = io $ putStrLn "This command takes no arguments" +noArgs _ _ = liftIO $ putStrLn "This command takes no arguments" help :: String -> GHCi () -help _ = io (putStr helpText) +help _ = liftIO (putStr helpText) info :: String -> InputT GHCi () info "" = ghcError (CmdLineError "syntax: ':i '") -info s = handleSourceError GHC.printExceptionAndWarnings $ +info s = handleSourceError GHC.printException $ withFlattenedDynflags $ do { let names = words s ; dflags <- getDynFlags @@ -827,7 +827,7 @@ info s = handleSourceError GHC.printExceptionAndWarnings $ mb_stuffs <- mapM GHC.getInfo names let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs) unqual <- GHC.getPrintUnqual - outputStrLn $ showSDocForUser unqual $ + liftIO $ putStrLn $ showSDocForUser unqual $ vcat (intersperse (text "") $ map (pprInfo pefas) filtered) @@ -855,7 +855,7 @@ pprInfo pefas (thing, fixity, insts) runMain :: String -> GHCi () runMain s = case toArgs s of - Left err -> io (hPutStrLn stderr err) + Left err -> liftIO (hPutStrLn stderr err) Right args -> withFlattenedDynflags $ do dflags <- getDynFlags @@ -865,7 +865,7 @@ runMain s = case toArgs s of runRun :: String -> GHCi () runRun s = case toCmdArgs s of - Left err -> io (hPutStrLn stderr err) + Left err -> liftIO (hPutStrLn stderr err) Right (cmd, args) -> doWithArgs args cmd doWithArgs :: [String] -> String -> GHCi () @@ -894,7 +894,7 @@ changeDirectory "" = do changeDirectory dir = do graph <- GHC.getModuleGraph when (not (null graph)) $ - outputStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n" + liftIO $ putStrLn "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed." prev_context <- GHC.getContext GHC.setTargets [] _ <- GHC.load LoadAllTargets @@ -905,7 +905,7 @@ changeDirectory dir = do trySuccess :: GHC.GhcMonad m => m SuccessFlag -> m SuccessFlag trySuccess act = - handleSourceError (\e -> do GHC.printExceptionAndWarnings e + handleSourceError (\e -> do GHC.printException e return Failed) $ do act @@ -916,7 +916,7 @@ editFile str = let cmd = editor st when (null cmd) $ ghcError (CmdLineError "editor not set, use :set editor") - _ <- io $ system (cmd ++ ' ':file) + _ <- liftIO $ system (cmd ++ ' ':file) return () -- The user didn't specify a file so we pick one for them. @@ -953,16 +953,16 @@ chooseEditFile = defineMacro :: Bool{-overwrite-} -> String -> GHCi () defineMacro _ (':':_) = - io $ putStrLn "macro name cannot start with a colon" + liftIO $ putStrLn "macro name cannot start with a colon" defineMacro overwrite s = do let (macro_name, definition) = break isSpace s - macros <- io (readIORef macros_ref) + macros <- liftIO (readIORef macros_ref) let defined = map cmdName macros if (null macro_name) then if null defined - then io $ putStrLn "no macros defined" - else io $ putStr ("the following macros are defined:\n" ++ - unlines defined) + then liftIO $ putStrLn "no macros defined" + else liftIO $ putStr ("the following macros are defined:\n" ++ + unlines defined) else do if (not overwrite && macro_name `elem` defined) then ghcError (CmdLineError @@ -976,15 +976,15 @@ defineMacro overwrite s = do let new_expr = '(' : definition ++ ") :: String -> IO String" -- compile the expression - handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ + handleSourceError (\e -> GHC.printException e) $ withFlattenedDynflags $ do hv <- GHC.compileExpr new_expr - io (writeIORef macros_ref -- - (filtered ++ [(macro_name, lift . runMacro hv, noCompletion)])) + liftIO (writeIORef macros_ref -- + (filtered ++ [(macro_name, lift . runMacro hv, noCompletion)])) runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool runMacro fun s = do - str <- io ((unsafeCoerce# fun :: String -> IO String) s) + str <- liftIO ((unsafeCoerce# fun :: String -> IO String) s) -- make sure we force any exceptions in the result, while we are still -- inside the exception handler for commands: seqList str (return ()) @@ -994,20 +994,20 @@ runMacro fun s = do undefineMacro :: String -> GHCi () undefineMacro str = mapM_ undef (words str) where undef macro_name = do - cmds <- io (readIORef macros_ref) + cmds <- liftIO (readIORef macros_ref) if (macro_name `notElem` map cmdName cmds) then ghcError (CmdLineError ("macro '" ++ macro_name ++ "' is not defined")) else do - io (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds)) + liftIO (writeIORef macros_ref (filter ((/= macro_name) . cmdName) cmds)) cmdCmd :: String -> GHCi () cmdCmd str = do let expr = '(' : str ++ ") :: IO String" - handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ + handleSourceError (\e -> GHC.printException e) $ withFlattenedDynflags $ do hv <- GHC.compileExpr expr - cmds <- io $ (unsafeCoerce# hv :: IO String) + cmds <- liftIO $ (unsafeCoerce# hv :: IO String) enqueueCommands (lines cmds) return () @@ -1047,9 +1047,9 @@ checkModule :: String -> InputT GHCi () checkModule m = do let modl = GHC.mkModuleName m prev_context <- GHC.getContext - ok <- handleSourceError (\e -> GHC.printExceptionAndWarnings e >> return False) $ do + ok <- handleSourceError (\e -> GHC.printException e >> return False) $ do r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl - outputStrLn (showSDoc ( + liftIO $ putStrLn $ showSDoc $ case GHC.moduleInfo r of cm | Just scope <- GHC.modInfoTopLevelScope cm -> let @@ -1058,7 +1058,7 @@ checkModule m = do in (text "global names: " <+> ppr global) $$ (text "local names: " <+> ppr local) - _ -> empty)) + _ -> empty return True afterLoad (successIf ok) False prev_context @@ -1161,14 +1161,14 @@ modulesLoadedMsg ok mods = do punctuate comma (map ppr mods)) <> text "." case ok of Failed -> - outputStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)) + liftIO $ putStrLn $ showSDoc (text "Failed, modules loaded: " <> mod_commas) Succeeded -> - outputStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)) + liftIO $ putStrLn $ showSDoc (text "Ok, modules loaded: " <> mod_commas) typeOfExpr :: String -> InputT GHCi () typeOfExpr str - = handleSourceError (\e -> GHC.printExceptionAndWarnings e) + = handleSourceError GHC.printException $ withFlattenedDynflags $ do ty <- GHC.exprType str @@ -1178,7 +1178,7 @@ typeOfExpr str kindOfType :: String -> InputT GHCi () kindOfType str - = handleSourceError (\e -> GHC.printExceptionAndWarnings e) + = handleSourceError GHC.printException $ withFlattenedDynflags $ do ty <- GHC.typeKind str @@ -1188,12 +1188,12 @@ quit :: String -> InputT GHCi Bool quit _ = return True shellEscape :: String -> GHCi Bool -shellEscape str = io (system str >> return False) +shellEscape str = liftIO (system str >> return False) withFlattenedDynflags :: GHC.GhcMonad m => m a -> m a withFlattenedDynflags m = do dflags <- GHC.getSessionDynFlags - gbracket (GHC.setSessionDynFlags (ensureFlattenedExtensionFlags dflags)) + gbracket (GHC.setSessionDynFlags dflags) (\_ -> GHC.setSessionDynFlags dflags) (\_ -> m) @@ -1300,7 +1300,7 @@ browseModule bang modl exports_only = withFlattenedDynflags $ do let prettyThings = map (pretty pefas) things prettyThings' | bang = annotate $ zip modNames prettyThings | otherwise = prettyThings - outputStrLn $ showSDocForUser unqual (vcat prettyThings') + liftIO $ putStrLn $ showSDocForUser unqual (vcat prettyThings') -- ToDo: modInfoInstances currently throws an exception for -- package modules. When it works, we can do this: -- $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info)) @@ -1406,18 +1406,18 @@ setCmd :: String -> GHCi () setCmd "" = do st <- getGHCiState let opts = options st - io $ putStrLn (showSDoc ( + liftIO $ putStrLn (showSDoc ( text "options currently set: " <> if null opts then text "none." else hsep (map (\o -> char '+' <> text (optToStr o)) opts) )) dflags <- getDynFlags - io $ putStrLn (showSDoc ( + liftIO $ putStrLn (showSDoc ( vcat (text "GHCi-specific dynamic flag settings:" :map (flagSetting dflags) ghciFlags) )) - io $ putStrLn (showSDoc ( + liftIO $ putStrLn (showSDoc ( vcat (text "other dynamic, non-language, flag settings:" :map (flagSetting dflags) others) )) @@ -1436,17 +1436,17 @@ setCmd str = case getCmd str of Right ("args", rest) -> case toArgs rest of - Left err -> io (hPutStrLn stderr err) + Left err -> liftIO (hPutStrLn stderr err) Right args -> setArgs args Right ("prog", rest) -> case toArgs rest of Right [prog] -> setProg prog - _ -> io (hPutStrLn stderr "syntax: :set prog ") + _ -> liftIO (hPutStrLn stderr "syntax: :set prog ") Right ("prompt", rest) -> setPrompt $ dropWhile isSpace rest Right ("editor", rest) -> setEditor $ dropWhile isSpace rest Right ("stop", rest) -> setStop $ dropWhile isSpace rest _ -> case toArgs str of - Left err -> io (hPutStrLn stderr err) + Left err -> liftIO (hPutStrLn stderr err) Right wds -> setOptions wds setArgs, setOptions :: [String] -> GHCi () @@ -1484,13 +1484,13 @@ setStop cmd = do setPrompt value = do st <- getGHCiState if null value - then io $ hPutStrLn stderr $ "syntax: :set prompt , currently \"" ++ prompt st ++ "\"" + then liftIO $ hPutStrLn stderr $ "syntax: :set prompt , currently \"" ++ prompt st ++ "\"" else case value of '\"' : _ -> case reads value of [(value', xs)] | all isSpace xs -> setGHCiState (st { prompt = value' }) _ -> - io $ hPutStrLn stderr "Can't parse prompt string. Use Haskell syntax." + liftIO $ hPutStrLn stderr "Can't parse prompt string. Use Haskell syntax." _ -> setGHCiState (st { prompt = value }) setOptions wds = @@ -1504,8 +1504,8 @@ newDynFlags :: [String] -> GHCi () newDynFlags minus_opts = do dflags <- getDynFlags let pkg_flags = packageFlags dflags - (dflags', leftovers, warns) <- io $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts - handleFlagWarnings dflags' warns + (dflags', leftovers, warns) <- liftIO $ GHC.parseDynamicFlags dflags $ map noLoc minus_opts + liftIO $ handleFlagWarnings dflags' warns if (not (null leftovers)) then ghcError $ errorsToGhcException leftovers @@ -1517,10 +1517,10 @@ newDynFlags minus_opts = do -- and link the new packages. dflags <- getDynFlags when (packageFlags dflags /= pkg_flags) $ do - io $ hPutStrLn stderr "package flags have changed, resetting and loading new packages..." + liftIO $ hPutStrLn stderr "package flags have changed, resetting and loading new packages..." GHC.setTargets [] _ <- GHC.load LoadAllTargets - io (linkPackages dflags new_pkgs) + liftIO (linkPackages dflags new_pkgs) -- package flags changed, we can't re-use any of the old context setContextAfterLoad ([],[]) False [] return () @@ -1534,7 +1534,7 @@ unsetOptions str (plus_opts, rest2) = partitionWith isPlus rest1 if (not (null rest2)) - then io (putStrLn ("unknown option: '" ++ head rest2 ++ "'")) + then liftIO (putStrLn ("unknown option: '" ++ head rest2 ++ "'")) else do mapM_ unsetOpt plus_opts @@ -1557,12 +1557,12 @@ setOpt, unsetOpt :: String -> GHCi () setOpt str = case strToGHCiOpt str of - Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'")) + Nothing -> liftIO (putStrLn ("unknown option: '" ++ str ++ "'")) Just o -> setOption o unsetOpt str = case strToGHCiOpt str of - Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'")) + Nothing -> liftIO (putStrLn ("unknown option: '" ++ str ++ "'")) Just o -> unsetOption o strToGHCiOpt :: String -> (Maybe GHCiOption) @@ -1583,14 +1583,14 @@ showCmd :: String -> GHCi () showCmd str = withFlattenedDynflags $ do st <- getGHCiState case words str of - ["args"] -> io $ putStrLn (show (args st)) - ["prog"] -> io $ putStrLn (show (progname st)) - ["prompt"] -> io $ putStrLn (show (prompt st)) - ["editor"] -> io $ putStrLn (show (editor st)) - ["stop"] -> io $ putStrLn (show (stop st)) + ["args"] -> liftIO $ putStrLn (show (args st)) + ["prog"] -> liftIO $ putStrLn (show (progname st)) + ["prompt"] -> liftIO $ putStrLn (show (prompt st)) + ["editor"] -> liftIO $ putStrLn (show (editor st)) + ["stop"] -> liftIO $ putStrLn (show (stop st)) ["modules" ] -> showModules ["bindings"] -> showBindings - ["linker"] -> io showLinkerState + ["linker"] -> liftIO showLinkerState ["breaks"] -> showBkptTable ["context"] -> showContext ["packages"] -> showPackages @@ -1602,7 +1602,7 @@ showModules :: GHCi () showModules = do loaded_mods <- getLoadedModules -- we want *loaded* modules only, see #1734 - let show_one ms = do m <- GHC.showModule ms; io (putStrLn m) + let show_one ms = do m <- GHC.showModule ms; liftIO (putStrLn m) mapM_ show_one loaded_mods getLoadedModules :: GHC.GhcMonad m => m [GHC.ModSummary] @@ -1642,14 +1642,9 @@ showContext = do showPackages :: GHCi () showPackages = do pkg_flags <- fmap packageFlags getDynFlags - io $ putStrLn $ showSDoc $ vcat $ + liftIO $ putStrLn $ showSDoc $ vcat $ text ("active package flags:"++if null pkg_flags then " none" else "") : map showFlag pkg_flags - pkg_ids <- fmap (preloadPackages . pkgState) getDynFlags - io $ putStrLn $ showSDoc $ vcat $ - text "packages currently loaded:" - : map (nest 2 . text . packageIdString) - (sortBy (compare `on` packageIdFS) pkg_ids) where showFlag (ExposePackage p) = text $ " -package " ++ p showFlag (HidePackage p) = text $ " -hide-package " ++ p showFlag (IgnorePackage p) = text $ " -ignore-package " ++ p @@ -1658,9 +1653,9 @@ showPackages = do showLanguages :: GHCi () showLanguages = do dflags <- getDynFlags - io $ putStrLn $ showSDoc $ vcat $ + liftIO $ putStrLn $ showSDoc $ vcat $ text "active language flags:" : - [text (" -X" ++ str) | (str, f, _) <- DynFlags.xFlags, dopt f dflags] + [text (" -X" ++ str) | (str, f, _) <- DynFlags.xFlags, xopt f dflags] -- ----------------------------------------------------------------------------- -- Completion @@ -1793,21 +1788,21 @@ handler :: SomeException -> GHCi Bool handler exception = do flushInterpBuffers - io installSignalHandlers + liftIO installSignalHandlers ghciHandle handler (showException exception >> return False) showException :: SomeException -> GHCi () showException se = - io $ case fromException se of - -- omit the location for CmdLineError: - Just (CmdLineError s) -> putStrLn s - -- ditto: - Just ph@(PhaseFailed {}) -> putStrLn (showGhcException ph "") - Just other_ghc_ex -> print other_ghc_ex - Nothing -> - case fromException se of - Just UserInterrupt -> putStrLn "Interrupted." - _other -> putStrLn ("*** Exception: " ++ show se) + liftIO $ case fromException se of + -- omit the location for CmdLineError: + Just (CmdLineError s) -> putStrLn s + -- ditto: + Just ph@(PhaseFailed {}) -> putStrLn (showGhcException ph "") + Just other_ghc_ex -> print other_ghc_ex + Nothing -> + case fromException se of + Just UserInterrupt -> putStrLn "Interrupted." + _ -> putStrLn ("*** Exception: " ++ show se) ----------------------------------------------------------------------------- -- recursive exception handlers @@ -1859,7 +1854,7 @@ wantNameFromInterpretedModule :: GHC.GhcMonad m -> (Name -> m ()) -> m () wantNameFromInterpretedModule noCanDo str and_then = - handleSourceError (GHC.printExceptionAndWarnings) $ do + handleSourceError GHC.printException $ do names <- GHC.parseName str case names of [] -> return () @@ -1942,16 +1937,15 @@ doContinue pred step = do abandonCmd :: String -> GHCi () abandonCmd = noArgs $ do b <- GHC.abandon -- the prompt will change to indicate the new context - when (not b) $ io $ putStrLn "There is no computation running." - return () + when (not b) $ liftIO $ putStrLn "There is no computation running." deleteCmd :: String -> GHCi () deleteCmd argLine = do deleteSwitch $ words argLine where deleteSwitch :: [String] -> GHCi () - deleteSwitch [] = - io $ putStrLn "The delete command requires at least one argument." + deleteSwitch [] = + liftIO $ putStrLn "The delete command requires at least one argument." -- delete all break points deleteSwitch ("*":_rest) = discardActiveBreakPoints deleteSwitch idents = do @@ -1966,17 +1960,17 @@ historyCmd :: String -> GHCi () historyCmd arg | null arg = history 20 | all isDigit arg = history (read arg) - | otherwise = io $ putStrLn "Syntax: :history [num]" + | otherwise = liftIO $ putStrLn "Syntax: :history [num]" where history num = do resumes <- GHC.getResumeContext case resumes of - [] -> io $ putStrLn "Not stopped at a breakpoint" + [] -> liftIO $ putStrLn "Not stopped at a breakpoint" (r:_) -> do let hist = GHC.resumeHistory r (took,rest) = splitAt num hist case hist of - [] -> io $ putStrLn $ + [] -> liftIO $ putStrLn $ "Empty history. Perhaps you forgot to use :trace?" _ -> do spans <- mapM GHC.getHistorySpan took @@ -1987,7 +1981,7 @@ historyCmd arg (map text nums) (map (bold . ppr) names) (map (parens . ppr) spans))) - io $ putStrLn $ if null rest then "" else "..." + liftIO $ putStrLn $ if null rest then "" else "..." bold :: SDoc -> SDoc bold c | do_bold = text start_bold <> c <> text end_bold @@ -2020,7 +2014,7 @@ breakCmd argLine = do breakSwitch :: [String] -> GHCi () breakSwitch [] = do - io $ putStrLn "The break command requires at least one argument." + liftIO $ putStrLn "The break command requires at least one argument." breakSwitch (arg1:rest) | looksLikeModuleName arg1 && not (null rest) = do mod <- wantInterpretedModule arg1 @@ -2030,8 +2024,8 @@ breakSwitch (arg1:rest) case toplevel of (mod : _) -> breakByModuleLine mod (read arg1) rest [] -> do - io $ putStrLn "Cannot find default module for breakpoint." - io $ putStrLn "Perhaps no modules are loaded for debugging?" + liftIO $ putStrLn "Cannot find default module for breakpoint." + liftIO $ putStrLn "Perhaps no modules are loaded for debugging?" | otherwise = do -- try parsing it as an identifier wantNameFromInterpretedModule noCanDo arg1 $ \name -> do let loc = GHC.srcSpanStart (GHC.nameSrcSpan name) @@ -2068,9 +2062,9 @@ findBreakAndSet mod lookupTickTree = do tickArray <- getTickArray mod (breakArray, _) <- getModBreak mod case lookupTickTree tickArray of - Nothing -> io $ putStrLn $ "No breakpoints found at that location." + Nothing -> liftIO $ putStrLn $ "No breakpoints found at that location." Just (tick, span) -> do - success <- io $ setBreakFlag True breakArray tick + success <- liftIO $ setBreakFlag True breakArray tick if success then do (alreadySet, nm) <- @@ -2177,7 +2171,7 @@ list2 :: [String] -> InputT GHCi () list2 [arg] | all isDigit arg = do (toplevel, _) <- GHC.getContext case toplevel of - [] -> outputStrLn "No module to list" + [] -> liftIO $ putStrLn "No module to list" (mod : _) -> listModuleLine mod (read arg) list2 [arg1,arg2] | looksLikeModuleName arg1, all isDigit arg2 = do mod <- wantInterpretedModule arg1 @@ -2202,7 +2196,7 @@ list2 [arg] = do noCanDo n why = printForUser $ text "cannot list source code for " <> ppr n <> text ": " <> why list2 _other = - outputStrLn "syntax: :list [ | | ]" + liftIO $ putStrLn "syntax: :list [ | | ]" listModuleLine :: Module -> Int -> InputT GHCi () listModuleLine modl line = do @@ -2243,7 +2237,7 @@ listAround span do_highlight = do let output = BS.intercalate (BS.pack "\n") prefixed utf8Decoded <- liftIO $ BS.useAsCStringLen output $ \(p,n) -> utf8DecodeString (castPtr p) n - outputStrLn utf8Decoded + liftIO $ putStrLn utf8Decoded where file = GHC.srcSpanFile span line1 = GHC.srcSpanStartLine span @@ -2343,7 +2337,7 @@ deleteBreak identity = do turnOffBreak :: BreakLocation -> GHCi Bool turnOffBreak loc = do (arr, _) <- getModBreak (breakModule loc) - io $ setBreakFlag False arr (breakTick loc) + liftIO $ setBreakFlag False arr (breakTick loc) getModBreak :: Module -> GHCi (GHC.BreakArray, Array Int SrcSpan) getModBreak mod = do