defining errorMsgSpan.

This commit is contained in:
Kazu Yamamoto 2013-11-19 12:28:59 +09:00
parent beaf3c0a4e
commit 7fbd983172
2 changed files with 11 additions and 11 deletions

View File

@ -52,22 +52,12 @@ errBagToStrList dflag ls = map (ppErrMsg dflag ls) . reverse . bagToList
---------------------------------------------------------------- ----------------------------------------------------------------
#if __GLASGOW_HASKELL__ >= 707
ppErrMsg :: DynFlags -> LineSeparator -> ErrMsg -> String ppErrMsg :: DynFlags -> LineSeparator -> ErrMsg -> String
ppErrMsg dflag ls err = ppMsg spn SevError dflag ls msg ++ ext ppErrMsg dflag ls err = ppMsg spn SevError dflag ls msg ++ ext
where where
spn = errMsgSpan err spn = Gap.errorMsgSpan err
msg = errMsgShortDoc err msg = errMsgShortDoc err
ext = showMsg dflag ls (errMsgExtraInfo err) ext = showMsg dflag ls (errMsgExtraInfo err)
#else
ppErrMsg :: DynFlags -> LineSeparator -> ErrMsg -> String
ppErrMsg dflag ls err = ppMsg spn SevError dflag ls msg ++ ext
where
spn = head (errMsgSpans err)
msg = errMsgShortDoc err
ext = showMsg dflag ls (errMsgExtraInfo err)
#endif
ppMsg :: SrcSpan -> Severity-> DynFlags -> LineSeparator -> SDoc -> String ppMsg :: SrcSpan -> Severity-> DynFlags -> LineSeparator -> SDoc -> String
ppMsg spn sev dflag ls@(LineSeparator lsep) msg = prefix ++ cts ++ lsep ppMsg spn sev dflag ls@(LineSeparator lsep) msg = prefix ++ cts ++ lsep

View File

@ -19,6 +19,7 @@ module Language.Haskell.GhcMod.Gap (
, infoThing , infoThing
, pprInfo , pprInfo
, HasType(..) , HasType(..)
, errorMsgSpan
#if __GLASGOW_HASKELL__ >= 702 #if __GLASGOW_HASKELL__ >= 702
#else #else
, module Pretty , module Pretty
@ -280,3 +281,12 @@ pprInfo pefas (thing, fixity, insts)
| otherwise = ppr fx <+> ppr (getName thing) | otherwise = ppr fx <+> ppr (getName thing)
#endif #endif
----------------------------------------------------------------
----------------------------------------------------------------
errorMsgSpan :: ErrMsg -> SrcSpan
#if __GLASGOW_HASKELL__ >= 707
errorMsgSpan = errMsgSpan
#else
errorMsgSpan = head . errMsgSpans
#endif