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
|
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
|
||||||
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
|
||||||
|
|
||||||
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
|
||||||
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 =
|
||||||
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
|
||||||
|
|
||||||
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 ""
|
||||||
|
|
Loading…
Reference in New Issue