Gave Parsec errors proper positioning info
This commit is contained in:
parent
d5587dd104
commit
22ae83e372
|
@ -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 ""
|
||||
|
|
Loading…
Reference in New Issue