{-# LANGUAGE CPP #-}
module Curry.Base.Message
( Message (..), message, posMessage, showWarning, showError
, ppMessage, ppWarning, ppError, ppMessages
) where
#if __GLASGOW_HASKELL__ >= 804
import Prelude hiding ((<>))
#endif
import Data.Maybe (fromMaybe)
import Curry.Base.Position
import Curry.Base.Pretty
data Message = Message
{ msgPos :: Maybe Position
, msgTxt :: Doc
}
instance Eq Message where
Message p1 t1 == Message p2 t2 = (p1, show t1) == (p2, show t2)
instance Ord Message where
Message p1 t1 `compare` Message p2 t2 = compare (p1, show t1) (p2, show t2)
instance Show Message where
showsPrec _ = shows . ppMessage
instance HasPosition Message where
getPosition = fromMaybe NoPos . msgPos
setPosition p m = m { msgPos = Just p }
instance Pretty Message where
pPrint = ppMessage
message :: Doc -> Message
message = Message Nothing
posMessage :: HasPosition p => p -> Doc -> Message
posMessage p msg = Message (Just $ getPosition p) msg
showWarning :: Message -> String
showWarning = show . ppWarning
showError :: Message -> String
showError = show . ppError
ppMessage :: Message -> Doc
ppMessage = ppAs ""
ppWarning :: Message -> Doc
ppWarning = ppAs "Warning"
ppError :: Message -> Doc
ppError = ppAs "Error"
ppAs :: String -> Message -> Doc
ppAs key (Message mbPos txt) = posPP <+> keyPP $$ nest 4 txt
where
posPP = maybe empty ((<> colon) . ppPosition) mbPos
keyPP = if null key then empty else text key <> colon
ppMessages :: (Message -> Doc) -> [Message] -> Doc
ppMessages ppFun = foldr (\m ms -> text "" $+$ m $+$ ms) empty . map ppFun