提交 22ae83e3 编写于 作者: V Vidar Holen

Gave Parsec errors proper positioning info

上级 d5587dd1
......@@ -3,7 +3,6 @@
module Shpell.Parser (Token(..), Note(..), Severity(..), parseShell, ParseResult(..), ParseNote(..), notesFromMap, Metadata(..), doAnalysis, doTransform, sortNotes) where
import Text.Parsec
import Text.Parsec.Pos (initialPos)
import Debug.Trace
import Control.Monad
import Control.Monad.Identity
......@@ -14,7 +13,9 @@ import qualified Control.Monad.State as Ms
import Data.Maybe
import Prelude hiding (readList)
import System.IO
import Text.Parsec.Error
import qualified Text.Regex as Re
import GHC.Exts (sortWith)
......@@ -993,8 +994,22 @@ sortNotes = sortBy compareNotes
data ParseResult = ParseResult { parseResult :: Maybe (Token, Map.Map Id Metadata), parseNotes :: [ParseNote] }
makeErrorFor parsecError =
ParseNote (errorPos parsecError) ErrorC $ getStringFromParsec $ errorMessages parsecError
getStringFromParsec errors =
case map snd $ sortWith fst $ map f errors of
(s:_) -> s
_ -> "Unknown error"
where f err =
case err of
UnExpect s -> (1, "Aborting due to unexpected " ++ s ++". Is this valid?")
SysUnExpect s -> (2, "Internal unexpected " ++ s ++ ". Submit a bug.")
Expect s -> (3, "Expected " ++ s ++ "")
Message s -> (4, "Message: " ++ s)
parseShell filename contents = do
case rp (parseWithNotes readScript) filename contents of
(Right (script, map, notes), parsenotes) -> ParseResult (Just (script, map)) (nub $ sortNotes $ notes ++ parsenotes)
(Left err, p) -> ParseResult Nothing (nub $ sortNotes $ (ParseNote (initialPos "-") ErrorC $ "Parsing failed: " ++ (show err)):(p))
(Left err, p) -> ParseResult Nothing (nub $ sortNotes $ (makeErrorFor err):p)
......@@ -4,6 +4,7 @@ import Shpell.Parser
import Shpell.Analytics
import Data.Maybe
import Text.Parsec.Pos
import Data.List
shpellCheck :: String -> [ShpellComment]
shpellCheck script =
......@@ -14,7 +15,7 @@ shpellCheck script =
return $ notesFromMap newMap
)
in
map formatNote $ sortNotes allNotes
map formatNote $ nub $ sortNotes allNotes
data ShpellComment = ShpellComment { shpellLine :: Int, shpellColumn :: Int, shpellSeverity :: String, shpellComment :: String }
......
......@@ -32,13 +32,17 @@ doFile path colorFunc = do
doInput filename contents colorFunc = do
let fileLines = lines contents
let lineCount = length fileLines
let comments = shpellCheck contents
let groups = groupWith shpellLine comments
if not $ null comments then do
mapM_ (\x -> do
let line = fileLines !! (shpellLine (head x) - 1)
let lineNum = shpellLine (head x)
let line = if lineNum < 1 || lineNum >= lineCount
then ""
else fileLines !! (lineNum - 1)
putStrLn ""
putStrLn $ colorFunc "message" ("In " ++ filename ++" line " ++ (show $ shpellLine (head x)) ++ ":")
putStrLn $ colorFunc "message" ("In " ++ filename ++" line " ++ (show $ lineNum) ++ ":")
putStrLn (colorFunc "source" line)
mapM (\c -> putStrLn (colorFunc (shpellSeverity c) $ cuteIndent c)) x
putStrLn ""
......
Markdown is supported
0% .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑!
想要评论请 注册