module UHC.Util.ParseErrPrettyPrint
( ppPos, ppErr, ppWarn
, ppTr
)
where
import Data.List
import UHC.Util.Pretty
import UU.Parsing
import UU.Scanner.Position( noPos, Pos, Position(..) )
ppPos :: Position p => p -> PP_Doc
ppPos p
= if l < 0 then empty else pp f >|< ppListSep "(" ")" "," [pp l,pp c]
where l = line p
c = column p
f = file p
ppMsg :: Position pos => String -> (String,pos) -> PP_Doc -> PP_Doc
ppMsg what (sym,pos) p
= "***" >#< what >#< "***"
>-< (if l > 0 && not (null sym)
then ppPos pos >#< s >|< ":"
else if l > 0
then ppPos pos >|< ":"
else if not (null sym)
then s >|< ":"
else empty
)
>-< indent 4 p
where s = "at symbol '" >|< pp sym >|< "'"
l = line pos
ppErr, ppWarn :: Position pos => (String,pos) -> PP_Doc -> PP_Doc
ppErr = ppMsg "ERROR"
ppWarn = ppMsg "WARNING"
ppTr :: PP_Doc -> PP_Doc
ppTr = ppMsg "TRACE" ("",noPos)
instance (Eq s, Show s, Show p, Position p) => PP (Message s p) where
pp (Msg expecting position action)
= ppErr ("",position)
( "Expecting :" >#< (hlist $ intersperse (pp " ") $ map pp $ showExp)
>#< (if null omitExp then empty else pp "...")
>-< "Repaired by:" >#< show action
)
where (showExp,omitExp) = splitAt 20 . words $ show expecting