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

Gave Parsec errors proper positioning info

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