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

Use less generic name for reader monad/state in Logger

Browse Source
This commit is contained in:
Nikolay Yakimov 2015-07-02 13:17:49 +03:00
parent 2504f643e9
commit 1efacbef88
1 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -38,12 +38,12 @@ data Log = Log [String] Builder
newtype LogRef = LogRef (IORef Log) newtype LogRef = LogRef (IORef Log)
data ReaderState = ReaderState { rsDynFlags :: DynFlags data GmPprEnv = GmPprEnv { rsDynFlags :: DynFlags
, rsPprStyle :: PprStyle , rsPprStyle :: PprStyle
, rsMapFile :: FilePath -> FilePath , rsMapFile :: FilePath -> FilePath
} }
type ReaderM a = Reader ReaderState a type GmPprEnvM a = Reader GmPprEnv a
emptyLog :: Log emptyLog :: Log
emptyLog = Log [] id emptyLog = Log [] id
@ -57,7 +57,7 @@ readAndClearLogRef (LogRef ref) = do
writeIORef ref emptyLog writeIORef ref emptyLog
return $ b [] return $ b []
appendLogRef :: ReaderState -> 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{rsDynFlags=df, rsPprStyle=st}
@ -101,7 +101,7 @@ withLogger' env action = do
let dflags = hsc_dflags env let dflags = hsc_dflags env
pu = icPrintUnqual dflags (hsc_IC env) pu = icPrintUnqual dflags (hsc_IC env)
stl = mkUserStyle pu AllTheWay stl = mkUserStyle pu AllTheWay
st = ReaderState { st = GmPprEnv {
rsDynFlags = dflags rsDynFlags = dflags
, rsPprStyle = stl , rsPprStyle = stl
, rsMapFile = \key -> , rsMapFile = \key ->
@ -131,15 +131,15 @@ errBagToStrList env errs = let
---------------------------------------------------------------- ----------------------------------------------------------------
-- | Converting 'SourceError' to 'String'. -- | Converting 'SourceError' to 'String'.
sourceError :: SourceError -> ReaderM [String] sourceError :: SourceError -> GmPprEnvM [String]
sourceError = errsToStr . reverse . bagToList . srcErrorMessages sourceError = errsToStr . reverse . bagToList . srcErrorMessages
errsToStr :: [ErrMsg] -> ReaderM [String] errsToStr :: [ErrMsg] -> GmPprEnvM [String]
errsToStr = mapM ppErrMsg errsToStr = mapM ppErrMsg
---------------------------------------------------------------- ----------------------------------------------------------------
ppErrMsg :: ErrMsg -> ReaderM String ppErrMsg :: ErrMsg -> GmPprEnvM String
ppErrMsg err = do ppErrMsg err = do
dflag <- asks rsDynFlags dflag <- asks rsDynFlags
st <- asks rsPprStyle st <- asks rsPprStyle
@ -150,7 +150,7 @@ ppErrMsg err = do
spn = Gap.errorMsgSpan err spn = Gap.errorMsgSpan err
msg = errMsgShortDoc err msg = errMsgShortDoc err
ppMsg :: SrcSpan -> Severity-> SDoc -> ReaderM String ppMsg :: SrcSpan -> Severity-> SDoc -> GmPprEnvM String
ppMsg spn sev msg = do ppMsg spn sev msg = do
dflag <- asks rsDynFlags dflag <- asks rsDynFlags
st <- asks rsPprStyle st <- asks rsPprStyle
@ -158,7 +158,7 @@ ppMsg spn sev msg = do
prefix <- ppMsgPrefix spn sev cts prefix <- ppMsgPrefix spn sev cts
return $ prefix ++ cts return $ prefix ++ cts
ppMsgPrefix :: SrcSpan -> Severity -> String -> ReaderM String ppMsgPrefix :: SrcSpan -> Severity -> String -> GmPprEnvM String
ppMsgPrefix spn sev cts = do ppMsgPrefix spn sev cts = do
dflag <- asks rsDynFlags dflag <- asks rsDynFlags
mr <- asks rsMapFile mr <- asks rsMapFile