summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-09-18 12:10:32 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-09-23 20:43:48 -0400
commita997fa01d907fc1992dc8c3ebc73f98e7a1486f7 (patch)
treea31df1df050c5b65aa30cd2d5eff69fe025c5c09
parenta584366b1d363039247f73f6dcdd3514994ad600 (diff)
downloadhaskell-a997fa01d907fc1992dc8c3ebc73f98e7a1486f7.tar.gz
Preliminary work towards removing DynFlags -> Driver.Ppr dependency
-rw-r--r--compiler/GHC/Driver/Session.hs7
1 files changed, 4 insertions, 3 deletions
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 9c5864b4c1..2e37d5847d 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -240,7 +240,6 @@ import GHC.Unit.Home
import GHC.Unit.Types
import GHC.Unit.Parser
import GHC.Unit.Module
-import GHC.Driver.Ppr
import {-# SOURCE #-} GHC.Driver.Plugins
import {-# SOURCE #-} GHC.Driver.Hooks
import GHC.Builtin.Names ( mAIN )
@@ -1386,9 +1385,10 @@ jsonLogAction dflags reason severity srcSpan msg
defaultLogActionHPutStrDoc dflags stdout
(withPprStyle (PprCode CStyle) (doc $$ text ""))
where
+ str = renderWithContext (initSDocContext dflags defaultUserStyle) msg
doc = renderJSON $
JSObject [ ( "span", json srcSpan )
- , ( "doc" , JSString (showSDoc dflags msg) )
+ , ( "doc" , JSString str )
, ( "severity", json severity )
, ( "reason" , json reason )
]
@@ -1990,8 +1990,9 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
= runCmdLine (processArgs activeFlags args) dflags0
-- See Note [Handling errors when parsing commandline flags]
+ let rdr = renderWithContext (initSDocContext dflags0 defaultUserStyle)
unless (null errs) $ liftIO $ throwGhcExceptionIO $ errorsToGhcException $
- map ((showPpr dflags0 . getLoc &&& unLoc) . errMsg) $ errs
+ map ((rdr . ppr . getLoc &&& unLoc) . errMsg) $ errs
-- check for disabled flags in safe haskell
let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1