Commit 63a1a074 authored by Simon Marlow's avatar Simon Marlow

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

parent c80ca570
......@@ -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
......
......@@ -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>]"
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment