-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
-- Message - A library for dealing with compiler messages
--
-- Note: This module overwrites the functions declared in "Message"
--
-- January 2006,
-- Martin Engelke (men@informatik.uni-kiel.de)
--
module Message where
import Position
-------------------------------------------------------------------------------
-- Type for representing compiler messages (currently errors and warnings)
data Message = Message MessageType (Maybe Position) String
-- Data type for representing available compiler message types
data MessageType = Warning WarningType | Error deriving Eq
-- the different warnings are categorized by WarningType
data WarningType = UnrefTypeVar
| UnrefVar
| ShadowingVar
| IdleCaseAlt
| OverlapCase
| OverlapRules
| RulesNotTogether
| MultipleImportModule
| MultipleImportSymbol
| MultipleHiding
deriving Eq
-- An instance of Show for converting messages to readable strings
instance Show Message where
show (Message (Warning _) mpos msg) = showMessage "Warning" mpos msg
show (Message Error mpos msg) = showMessage "ERROR" mpos msg
-------------------------------------------------------------------------------
--
message :: MessageType -> Position -> String -> Message
message mtype pos msg = Message mtype (Just pos) msg
--
message_ :: MessageType -> String -> Message
message_ mtype msg = Message mtype Nothing msg
--
countMessages :: MessageType -> [Message] -> Int
countMessages mtype msgs = length (filter (((==) mtype) . messageType) msgs)
--
messageType :: Message -> MessageType
messageType (Message mtype _ _) = mtype
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--
showMessage :: String -> (Maybe Position) -> String -> String
showMessage what mpos msg
= what ++ ": " ++ pos ++ msg
where
pos = maybe "" (\p -> show p ++ ": ") mpos
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------