hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Rename GmPprEnv fields rs* → gpe*

Browse Source
This commit is contained in:
Nikolay Yakimov 2015-08-11 18:57:17 +03:00
parent e7329a9d24
commit 72c43a9210
1 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
Language/Haskell/GhcMod/Logger.hs
View File

@ -37,9 +37,9 @@ data Log = Log [String] Builder
newtype LogRef = LogRef (IORef Log) newtype LogRef = LogRef (IORef Log)
data GmPprEnv = GmPprEnv { rsDynFlags :: DynFlags data GmPprEnv = GmPprEnv { gpeDynFlags :: DynFlags
, rsPprStyle :: PprStyle , gpePprStyle :: PprStyle
, rsMapFile :: FilePath -> FilePath , gpeMapFile :: FilePath -> FilePath
} }
type GmPprEnvM a = Reader GmPprEnv a type GmPprEnvM a = Reader GmPprEnv a
@ -59,7 +59,7 @@ readAndClearLogRef (LogRef ref) = do
appendLogRef :: GmPprEnv -> DynFlags -> LogRef -> DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO () appendLogRef :: GmPprEnv -> DynFlags -> LogRef -> DynFlags -> Severity -> SrcSpan -> PprStyle -> SDoc -> IO ()
appendLogRef rs df (LogRef ref) _ sev src st msg = modifyIORef ref update appendLogRef rs df (LogRef ref) _ sev src st msg = modifyIORef ref update
where where
l = runReader (ppMsg src sev msg) rs{rsDynFlags=df, rsPprStyle=st} l = runReader (ppMsg src sev msg) rs{gpeDynFlags=df, gpePprStyle=st}
update lg@(Log ls b) update lg@(Log ls b)
| l `elem` ls = lg | l `elem` ls = lg
| otherwise = Log (l:ls) (b . (l:)) | otherwise = Log (l:ls) (b . (l:))
@ -92,9 +92,9 @@ withLogger' env action = do
pu = icPrintUnqual dflags (hsc_IC env) pu = icPrintUnqual dflags (hsc_IC env)
stl = mkUserStyle pu AllTheWay stl = mkUserStyle pu AllTheWay
st = GmPprEnv { st = GmPprEnv {
rsDynFlags = dflags gpeDynFlags = dflags
, rsPprStyle = stl , gpePprStyle = stl
, rsMapFile = rfm , gpeMapFile = rfm
} }
setLogger df = Gap.setLogAction df $ appendLogRef st df logref setLogger df = Gap.setLogAction df $ appendLogRef st df logref
@ -128,8 +128,8 @@ errsToStr = mapM ppErrMsg
ppErrMsg :: ErrMsg -> GmPprEnvM String ppErrMsg :: ErrMsg -> GmPprEnvM String
ppErrMsg err = do ppErrMsg err = do
dflag <- asks rsDynFlags dflag <- asks gpeDynFlags
st <- asks rsPprStyle st <- asks gpePprStyle
let ext = showPage dflag st (errMsgExtraInfo err) let ext = showPage dflag st (errMsgExtraInfo err)
m <- ppMsg spn SevError msg m <- ppMsg spn SevError msg
return $ m ++ (if null ext then "" else "\n" ++ ext) return $ m ++ (if null ext then "" else "\n" ++ ext)
@ -139,16 +139,16 @@ ppErrMsg err = do
ppMsg :: SrcSpan -> Severity-> SDoc -> GmPprEnvM String ppMsg :: SrcSpan -> Severity-> SDoc -> GmPprEnvM String
ppMsg spn sev msg = do ppMsg spn sev msg = do
dflag <- asks rsDynFlags dflag <- asks gpeDynFlags
st <- asks rsPprStyle st <- asks gpePprStyle
let cts = showPage dflag st msg let cts = showPage dflag st msg
prefix <- ppMsgPrefix spn sev cts prefix <- ppMsgPrefix spn sev cts
return $ prefix ++ cts return $ prefix ++ cts
ppMsgPrefix :: SrcSpan -> Severity -> String -> GmPprEnvM String ppMsgPrefix :: SrcSpan -> Severity -> String -> GmPprEnvM String
ppMsgPrefix spn sev cts = do ppMsgPrefix spn sev cts = do
dflag <- asks rsDynFlags dflag <- asks gpeDynFlags
mr <- asks rsMapFile mr <- asks gpeMapFile
let defaultPrefix let defaultPrefix
| Gap.isDumpSplices dflag = "" | Gap.isDumpSplices dflag = ""
| otherwise = checkErrorPrefix | otherwise = checkErrorPrefix