1{-# LANGUAGE DeriveDataTypeable #-} 2{-# LANGUAGE Safe #-} 3 4----------------------------------------------------------------------------- 5-- | 6-- Module : Text.Parsec.Error 7-- Copyright : (c) Daan Leijen 1999-2001, (c) Paolo Martini 2007 8-- License : BSD-style (see the LICENSE file) 9-- 10-- Maintainer : derek.a.elkins@gmail.com 11-- Stability : provisional 12-- Portability : portable 13-- 14-- Parse errors 15-- 16----------------------------------------------------------------------------- 17 18module Text.Parsec.Error 19 ( Message ( SysUnExpect, UnExpect, Expect, Message ) 20 , messageString 21 , ParseError, errorPos, errorMessages, errorIsUnknown 22 , showErrorMessages 23 , newErrorMessage, newErrorUnknown 24 , addErrorMessage, setErrorPos, setErrorMessage 25 , mergeError 26 ) where 27 28import Data.List ( nub, sort ) 29import Data.Typeable ( Typeable ) 30 31import Text.Parsec.Pos 32 33-- | This abstract data type represents parse error messages. There are 34-- four kinds of messages: 35-- 36-- > data Message = SysUnExpect String 37-- > | UnExpect String 38-- > | Expect String 39-- > | Message String 40-- 41-- The fine distinction between different kinds of parse errors allows 42-- the system to generate quite good error messages for the user. It 43-- also allows error messages that are formatted in different 44-- languages. Each kind of message is generated by different combinators: 45-- 46-- * A 'SysUnExpect' message is automatically generated by the 47-- 'Text.Parsec.Combinator.satisfy' combinator. The argument is the 48-- unexpected input. 49-- 50-- * A 'UnExpect' message is generated by the 'Text.Parsec.Prim.unexpected' 51-- combinator. The argument describes the 52-- unexpected item. 53-- 54-- * A 'Expect' message is generated by the 'Text.Parsec.Prim.<?>' 55-- combinator. The argument describes the expected item. 56-- 57-- * A 'Message' message is generated by the 'fail' 58-- combinator. The argument is some general parser message. 59 60data Message = SysUnExpect !String -- @ library generated unexpect 61 | UnExpect !String -- @ unexpected something 62 | Expect !String -- @ expecting something 63 | Message !String -- @ raw message 64 deriving ( Typeable ) 65 66instance Enum Message where 67 fromEnum (SysUnExpect _) = 0 68 fromEnum (UnExpect _) = 1 69 fromEnum (Expect _) = 2 70 fromEnum (Message _) = 3 71 toEnum _ = error "toEnum is undefined for Message" 72 73-- < Return 'True' only when 'compare' would return 'EQ'. 74 75instance Eq Message where 76 77 m1 == m2 = fromEnum m1 == fromEnum m2 78 79-- < Compares two error messages without looking at their content. Only 80-- the constructors are compared where: 81-- 82-- > 'SysUnExpect' < 'UnExpect' < 'Expect' < 'Message' 83 84instance Ord Message where 85 compare msg1 msg2 = compare (fromEnum msg1) (fromEnum msg2) 86 87-- | Extract the message string from an error message 88 89messageString :: Message -> String 90messageString (SysUnExpect s) = s 91messageString (UnExpect s) = s 92messageString (Expect s) = s 93messageString (Message s) = s 94 95-- | The abstract data type @ParseError@ represents parse errors. It 96-- provides the source position ('SourcePos') of the error 97-- and a list of error messages ('Message'). A @ParseError@ 98-- can be returned by the function 'Text.Parsec.Prim.parse'. @ParseError@ is an 99-- instance of the 'Show' and 'Eq' classes. 100 101data ParseError = ParseError !SourcePos [Message] 102 deriving ( Typeable ) 103 104-- | Extracts the source position from the parse error 105 106errorPos :: ParseError -> SourcePos 107errorPos (ParseError pos _msgs) 108 = pos 109 110-- | Extracts the list of error messages from the parse error 111 112errorMessages :: ParseError -> [Message] 113errorMessages (ParseError _pos msgs) 114 = sort msgs 115 116errorIsUnknown :: ParseError -> Bool 117errorIsUnknown (ParseError _pos msgs) 118 = null msgs 119 120-- < Create parse errors 121 122newErrorUnknown :: SourcePos -> ParseError 123newErrorUnknown pos 124 = ParseError pos [] 125 126newErrorMessage :: Message -> SourcePos -> ParseError 127newErrorMessage msg pos 128 = ParseError pos [msg] 129 130addErrorMessage :: Message -> ParseError -> ParseError 131addErrorMessage msg (ParseError pos msgs) 132 = ParseError pos (msg:msgs) 133 134setErrorPos :: SourcePos -> ParseError -> ParseError 135setErrorPos pos (ParseError _ msgs) 136 = ParseError pos msgs 137 138setErrorMessage :: Message -> ParseError -> ParseError 139setErrorMessage msg (ParseError pos msgs) 140 = ParseError pos (msg : filter (msg /=) msgs) 141 142mergeError :: ParseError -> ParseError -> ParseError 143mergeError e1@(ParseError pos1 msgs1) e2@(ParseError pos2 msgs2) 144 -- prefer meaningful errors 145 | null msgs2 && not (null msgs1) = e1 146 | null msgs1 && not (null msgs2) = e2 147 | otherwise 148 = case pos1 `compare` pos2 of 149 -- select the longest match 150 EQ -> ParseError pos1 (msgs1 ++ msgs2) 151 GT -> e1 152 LT -> e2 153 154instance Show ParseError where 155 show err 156 = show (errorPos err) ++ ":" ++ 157 showErrorMessages "or" "unknown parse error" 158 "expecting" "unexpected" "end of input" 159 (errorMessages err) 160 161instance Eq ParseError where 162 l == r 163 = errorPos l == errorPos r && messageStrs l == messageStrs r 164 where 165 messageStrs = map messageString . errorMessages 166 167-- Language independent show function 168 169-- TODO 170-- < The standard function for showing error messages. Formats a list of 171-- error messages in English. This function is used in the |Show| 172-- instance of |ParseError <#ParseError>|. The resulting string will be 173-- formatted like: 174-- 175-- |unexpected /{The first UnExpect or a SysUnExpect message}/; 176-- expecting /{comma separated list of Expect messages}/; 177-- /{comma separated list of Message messages}/ 178 179showErrorMessages :: 180 String -> String -> String -> String -> String -> [Message] -> String 181showErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEndOfInput msgs 182 | null msgs = msgUnknown 183 | otherwise = concat $ map ("\n"++) $ clean $ 184 [showSysUnExpect,showUnExpect,showExpect,showMessages] 185 where 186 (sysUnExpect,msgs1) = span ((SysUnExpect "") ==) msgs 187 (unExpect,msgs2) = span ((UnExpect "") ==) msgs1 188 (expect,messages) = span ((Expect "") ==) msgs2 189 190 showExpect = showMany msgExpecting expect 191 showUnExpect = showMany msgUnExpected unExpect 192 showSysUnExpect | not (null unExpect) || 193 null sysUnExpect = "" 194 | null firstMsg = msgUnExpected ++ " " ++ msgEndOfInput 195 | otherwise = msgUnExpected ++ " " ++ firstMsg 196 where 197 firstMsg = messageString (head sysUnExpect) 198 199 showMessages = showMany "" messages 200 201 -- helpers 202 showMany pre msgs3 = case clean (map messageString msgs3) of 203 [] -> "" 204 ms | null pre -> commasOr ms 205 | otherwise -> pre ++ " " ++ commasOr ms 206 207 commasOr [] = "" 208 commasOr [m] = m 209 commasOr ms = commaSep (init ms) ++ " " ++ msgOr ++ " " ++ last ms 210 211 commaSep = separate ", " . clean 212 213 separate _ [] = "" 214 separate _ [m] = m 215 separate sep (m:ms) = m ++ sep ++ separate sep ms 216 217 clean = nub . filter (not . null) 218