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

Qualifid names for checking!

This commit is contained in:
Kazu Yamamoto 2012-02-08 16:57:24 +09:00
parent 27c1c4fa3d
commit 167f0d46f2
1 changed files with 11 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
ErrMsg.hs
View File

@ -36,7 +36,7 @@ setLogger True df = do
let newdf = df { log_action = appendLog ref } let newdf = df { log_action = appendLog ref }
return (newdf, reverse <$> readIORef ref) return (newdf, reverse <$> readIORef ref)
where where
appendLog ref _ src _ msg = modifyIORef ref (\ls -> ppMsg src msg : ls) appendLog ref _ src stl msg = modifyIORef ref (\ls -> ppMsg src msg stl : ls)
---------------------------------------------------------------- ----------------------------------------------------------------
@ -49,36 +49,33 @@ errBagToStrList = map ppErrMsg . reverse . bagToList
---------------------------------------------------------------- ----------------------------------------------------------------
ppErrMsg :: ErrMsg -> String ppErrMsg :: ErrMsg -> String
ppErrMsg err = ppMsg spn msg ++ ext ppErrMsg err = ppMsg spn msg defaultUserStyle ++ ext
where where
spn = head (errMsgSpans err) spn = head (errMsgSpans err)
msg = errMsgShortDoc err msg = errMsgShortDoc err
ext = showMsg (errMsgExtraInfo err) ext = showMsg (errMsgExtraInfo err) defaultUserStyle
ppMsg :: SrcSpan -> Message -> String ppMsg :: SrcSpan -> Message -> PprStyle -> String
#if __GLASGOW_HASKELL__ >= 702 #if __GLASGOW_HASKELL__ >= 702
ppMsg (UnhelpfulSpan _) _ = undefined ppMsg (UnhelpfulSpan _) _ _ = undefined
ppMsg (RealSrcSpan src) msg ppMsg (RealSrcSpan src) msg _ = undefined
#else #else
ppMsg src msg ppMsg src msg stl
#endif #endif
= file ++ ":" ++ line ++ ":" ++ col ++ ":" ++ cts ++ "\0" = file ++ ":" ++ line ++ ":" ++ col ++ ":" ++ cts ++ "\0"
where where
file = takeFileName $ unpackFS (srcSpanFile src) file = takeFileName $ unpackFS (srcSpanFile src)
line = show (srcSpanStartLine src) line = show (srcSpanStartLine src)
col = show (srcSpanStartCol src) col = show (srcSpanStartCol src)
cts = showMsg msg cts = showMsg msg stl
---------------------------------------------------------------- ----------------------------------------------------------------
style :: PprStyle showMsg :: SDoc -> PprStyle -> String
style = mkUserStyle neverQualify AllTheWay
showMsg :: SDoc -> String
#if __GLASGOW_HASKELL__ >= 702 #if __GLASGOW_HASKELL__ >= 702
showMsg d = map toNull $ renderWithStyle d style showMsg d stl = map toNull $ renderWithStyle d stl
#else #else
showMsg d = map toNull . Pretty.showDocWith PageMode $ d style showMsg d stl = map toNull . Pretty.showDocWith PageMode $ d stl
#endif #endif
where where
toNull '\n' = '\0' toNull '\n' = '\0'