remove encoding of output using Haskeline; the IO library does it now (#3398)

diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index e065387..0b9239d 100644 (file)
--- 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 (file)
--- 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 [<line> | <module> <line> | <identifier>]"