From 63a1a074071247b41710a3f51a2097b563022ecb Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Fri, 18 Sep 2009 14:40:41 +0000 Subject: [PATCH] remove encoding of output using Haskeline; the IO library does it now (#3398) --- ghc/GhciMonad.hs | 34 ++-------------------------------- ghc/InteractiveUI.hs | 16 ++++++---------- 2 files changed, 8 insertions(+), 42 deletions(-) diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs index e065387..0b9239d 100644 --- a/ghc/GhciMonad.hs +++ b/ghc/GhciMonad.hs @@ -15,7 +15,6 @@ module GhciMonad where import qualified GHC import Outputable hiding (printForUser, printForUserPartWay) -import qualified Pretty import qualified Outputable import Panic hiding (showException) import Util @@ -27,7 +26,6 @@ import ObjLink import Linker import StaticFlags import qualified MonadUtils -import qualified ErrUtils import Exception -- import Data.Maybe @@ -45,9 +43,7 @@ import GHC.Exts import System.Console.Haskeline (CompletionFunc, InputT) import qualified System.Console.Haskeline as Haskeline -import System.Console.Haskeline.Encoding import Control.Monad.Trans as Trans -import qualified Data.ByteString as B ----------------------------------------------------------------------------- -- GHCi monad @@ -240,42 +236,16 @@ unsetOption opt io :: IO a -> GHCi a io = MonadUtils.liftIO -printForUser :: SDoc -> GHCi () +printForUser :: GhcMonad m => SDoc -> m () printForUser doc = do unqual <- GHC.getPrintUnqual - io $ Outputable.printForUser stdout unqual doc - -printForUser' :: SDoc -> InputT GHCi () -printForUser' doc = do - unqual <- GHC.getPrintUnqual - Haskeline.outputStrLn $ showSDocForUser unqual doc + MonadUtils.liftIO $ Outputable.printForUser stdout unqual doc printForUserPartWay :: SDoc -> GHCi () printForUserPartWay doc = do unqual <- GHC.getPrintUnqual io $ Outputable.printForUserPartWay stdout opt_PprUserLength unqual doc --- We set log_action to write encoded output. --- This fails whenever GHC tries to mention an (already encoded) filename, --- but I don't know how to work around that. -setLogAction :: InputT GHCi () -setLogAction = do - encoder <- getEncoder - dflags <- GHC.getSessionDynFlags - _ <- GHC.setSessionDynFlags dflags {log_action = logAction encoder} - return () - where - logAction encoder severity srcSpan style msg = case severity of - GHC.SevInfo -> printEncErrs encoder (msg style) - GHC.SevFatal -> printEncErrs encoder (msg style) - _ -> do - hPutChar stderr '\n' - printEncErrs encoder (ErrUtils.mkLocMessage srcSpan msg style) - printEncErrs encoder doc = do - str <- encoder (Pretty.showDocWith Pretty.PageMode doc) - B.hPutStrLn stderr str - hFlush stderr - runStmt :: String -> GHC.SingleStep -> GHCi GHC.RunResult runStmt expr step = do st <- getGHCiState diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index a5a1ba4..b99b332 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -399,7 +399,6 @@ runGHCi paths maybe_exprs = do -- can we assume this will always be the case? -- This would be a good place for runFileInputT. Right hdl -> runInputTWithPrefs defaultPrefs defaultSettings $ do - setLogAction runCommands $ fileLoop hdl where getDirectory f = case takeDirectory f of "" -> "."; d -> d @@ -446,7 +445,6 @@ runGHCi paths maybe_exprs = do -- this used to be topHandlerFastExit, see #2228 $ topHandler e runInputTWithPrefs defaultPrefs defaultSettings $ do - setLogAction runCommands' handle (return Nothing) -- and finally, exit @@ -458,9 +456,7 @@ runGHCiInput f = do (return Nothing) let settings = setComplete ghciCompleteWord $ defaultSettings {historyFile = histFile} - runInputT settings $ do - setLogAction - f + runInputT settings f nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String) nextInputLine show_prompt is_tty @@ -1149,13 +1145,13 @@ typeOfExpr str ty <- GHC.exprType str dflags <- getDynFlags let pefas = dopt Opt_PrintExplicitForalls dflags - printForUser' $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)] + printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)] kindOfType :: String -> InputT GHCi () kindOfType str = handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do ty <- GHC.typeKind str - printForUser' $ text str <+> dcolon <+> ppr ty + printForUser $ text str <+> dcolon <+> ppr ty quit :: String -> InputT GHCi Bool quit _ = return True @@ -2077,7 +2073,7 @@ listCmd "" = do mb_span <- lift getCurrentBreakSpan case mb_span of Nothing -> - printForUser' $ text "Not stopped at a breakpoint; nothing to list" + printForUser $ text "Not stopped at a breakpoint; nothing to list" Just span | GHC.isGoodSrcSpan span -> listAround span True | otherwise -> @@ -2089,7 +2085,7 @@ listCmd "" = do [] -> text "rerunning with :trace," _ -> empty doWhat = traceIt <+> text ":back then :list" - printForUser' (text "Unable to list source for" <+> + printForUser (text "Unable to list source for" <+> ppr span $$ text "Try" <+> doWhat) listCmd str = list2 (words str) @@ -2120,7 +2116,7 @@ list2 [arg] = do noCanDo name $ text "can't find its location: " <> ppr loc where - noCanDo n why = printForUser' $ + noCanDo n why = printForUser $ text "cannot list source code for " <> ppr n <> text ": " <> why list2 _other = outputStrLn "syntax: :list [ | | ]" -- 1.7.10.4