implementation module GinCompilerLogParser import StdEnv import Maybe import ParserCombinators //import GenPrint import Map from GinParser import ::GPath(..), ::GPathNode(..), ::GResourceId(..) from GinPrinter import ::LineMap, ::Map from GinAbstractSyntax import ::FunctionMap, ::AIdentifier parseCleanIDELog :: String -> [CompilerErrorContext] parseCleanIDELog s = (snd o hd) (begin1 parser (fromString s)) where parser :: CParser Char [CompilerErrorContext] t parser = <*> parseHeader &> <*> parseCompilerError <& parseFooter parseCleanCompilerLog :: String -> [CompilerErrorContext] parseCleanCompilerLog s = (snd o hd) (begin1 parser (fromString s)) where parser :: CParser Char [CompilerErrorContext] t parser = <*> parseCompilerError parseHeader :: CParser Char Char t parseHeader = newline token ['Bring up to date...'] &> newline token ['Compiling...'] &> newline symbol '[' &> parseStringUntilCut (token [',]: module has changed']) &> newline symbol '[' &> parseStringUntilCut (token [',]: no abc file']) &> newline token ['Compiling \''] &> parseStringUntilCut (token ['\'.']) &> newline parseFooter :: CParser Char Char t parseFooter = token ['Linking...'] &> newline token ['Finished making.'] &> newline parseCompilerError :: CParser Char CompilerErrorContext t parseCompilerError = parseParseError parseUndefinedError parseOverloadingError parseTypeError parseOtherError parseParseError :: CParser Char CompilerErrorContext t parseParseError = parseSingleLineError "Parse error" "" ParseError parseUndefinedError :: CParser Char CompilerErrorContext t parseUndefinedError = parseSingleLineError "Error" " undefined" UndefinedError parseOverloadingError :: CParser Char CompilerErrorContext t parseOverloadingError = token ['Overloading error '] &> parseErrorContext <&> \context = token [': internal overloading of "'] &> parseStringUntilCut (symbol '"') <&> \function = parseStringUntilCut newlineOrEof &> yield ((OverloadingError function), context) parseTypeError :: CParser Char CompilerErrorContext t parseTypeError = token ['Type error '] &> parseErrorContext <&> \context = token [':'] &> parseTypeErrorPosition <&> \position = token [' cannot unify types:\n'] &> symbol ' ' &> parseStringUntilCut (symbol '\n') <&> \expectedType = symbol ' ' &> parseStringUntilCut newlineOrEof <&> \inferredType = yield ((TypeError { expectedType = expectedType, inferredType = inferredType, position = position }), context) where parseTypeErrorPosition :: CParser Char TypeErrorPosition t parseTypeErrorPosition = parseArgument parseNear parseArgument :: CParser Char TypeErrorPosition t parseArgument = token ['"argument '] &> int <&> \argnr = token [' of '] &> parseStringUntilCut (symbol '"') <&> \identifier = yield (TypeErrorArgument argnr identifier) parseNear :: CParser Char TypeErrorPosition t parseNear = token [' near '] &> parseStringUntilCut (token [' :']) <&> \identifier = yield (TypeErrorNear identifier) parseOtherError :: CParser Char CompilerErrorContext t parseOtherError = token ['Error '] &> parseErrorContext <&> \context = token [': '] &> parseUntilCut newlineOrEof <&> \message = yield (OtherError (toString message), context) parseSingleLineError :: String String (String -> CompilerError) -> CParser Char CompilerErrorContext t parseSingleLineError prefix postfix f = token (fromString prefix) &> symbol ' ' &> parseErrorContext <&> \context = token [': '] &> parseUntilCut (token (fromString postfix) &> newlineOrEof) <&> \message = yield (f (toString message), context) parseErrorContext :: CParser Char ErrorContext t parseErrorContext = symbol '[' &> parseStringUntilCut (symbol ',') <&> \filename = int <&> \line = parseMaybe (symbol ';' &> int) <&> \pos = parseMaybe (symbol ',') &> parseStringUntilCut (symbol ']') <&> \context = yield { ErrorContext | filename = filename, line = line, pos = pos, context = context } printError :: CompilerError -> String printError (ParseError err) = "Parse error: " +++ err printError (UndefinedError v) = "Undefined variable: " +++ v printError (OverloadingError f) = "Overloading error" printError (TypeError te) = "Type error:\nExpected type:" +++ te.expectedType +++ "\nActual type:" +++ te.inferredType printError (OtherError err) = err findPathErrors :: [CompilerErrorContext] FunctionMap LineMap -> [PathError] findPathErrors errorContexts functionMap lineMap = catMaybes (map findPathError errorContexts) where findPathError :: CompilerErrorContext -> Maybe PathError findPathError (error=:OverloadingError function,_) = case get function functionMap of Just path = Just (path, printError error) Nothing = Nothing findPathError (error,context) = case get context.line lineMap of Just path = Just (path, printError error) Nothing = Nothing //Parse utilities char :: CParser Char Char t char = psymbol where psymbol sc xc ac [x:ss] = sc x xc ac ss psymbol sc xc ac _ = xc ac newline :: CParser Char Char t newline = symbol '\n' newlineOrEof :: CParser Char Char t newlineOrEof = (newline eof <@ fromInt) parseUntilCut :: (CParser Char u t) -> CParser Char [Char] t parseUntilCut p = p <@ (\_ -> []) char <:&> parseUntilCut p parseStringUntilCut :: (CParser Char u t) -> CParser Char String t parseStringUntilCut p = parseUntilCut p <@ toString parseMaybe :: (CParser s u t) -> CParser s (Maybe u) t parseMaybe p = (p <&> \r = yield (Just r)) yield Nothing