From 22ae83e3723c4dfe62a408ba299fb7fc1e8d6abc Mon Sep 17 00:00:00 2001
From: Vidar Holen <spam@vidarholen.net>
Date: Sun, 4 Nov 2012 18:58:34 -0800
Subject: [PATCH] Gave Parsec errors proper positioning info

---
 Shpell/Parser.hs | 19 +++++++++++++++++--
 Shpell/Simple.hs |  3 ++-
 shpell.hs        |  8 ++++++--
 3 files changed, 25 insertions(+), 5 deletions(-)

diff --git a/Shpell/Parser.hs b/Shpell/Parser.hs
index dd5eefb..091d5d6 100644
--- a/Shpell/Parser.hs
+++ b/Shpell/Parser.hs
@@ -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)
 
diff --git a/Shpell/Simple.hs b/Shpell/Simple.hs
index 122dacc..6c58085 100644
--- a/Shpell/Simple.hs
+++ b/Shpell/Simple.hs
@@ -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 }
 
diff --git a/shpell.hs b/shpell.hs
index 6a183dc..33b4d3a 100644
--- a/shpell.hs
+++ b/shpell.hs
@@ -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 ""
-- 
GitLab