Even fancier CabalFileParseError rendering

Empty and non-empty lines

```
Errors encountered when parsing cabal file ./tree-diff.cabal:

tree-diff.cabal:102:7:
unexpected 'n'
expecting space, "&&", white space, "||", comma or end of input

   98 |       void               >=0.7.2    && <0.8
   99 |
  100 |       -- space and comments
  101 |
  102 |       nats               >=1.1.1    && <1.2,
      |       ^

tree-diff.cabal:86:48: version with tags

   85 |     tagged               >=0.8.5    && <0.9,
   86 |     text                 >=1.2.2.2  && <1.3-foo,
      |                                                ^

```

cabal-install/Distribution/Client/Utils/Parsec.hs

@@ -25,41 +25,75 @@ renderParseError filepath contents errors warnings = unlines $
     ++ renderedErrors
     ++ renderedWarnings
   where
-    -- lines of the input file.
-    ls = BS8.lines contents
+    -- lines of the input file. 'lines' is taken, so they are called rows
+    -- contents, line number, whether it's empty line
+    rows :: [(String, Int, Bool)]
+    rows = zipWith f (BS8.lines contents) [1..] where
+        f bs i = let s = fromUTF8BS bs in (s, i, isEmptyOrComment s)
 
-    nths :: Int -> [a] -> [a]
-    nths n | n <= 0 = take 2
-    nths n = take 3 . drop (n - 1)
+    rowsZipper = listToZipper rows
 
-    -- empty line before each error and warning
-    renderedErrors   = concatMap (prepend . renderError) errors
-    renderedWarnings = concatMap (prepend . renderWarning) warnings
+    isEmptyOrComment :: String -> Bool
+    isEmptyOrComment s = case dropWhile (== ' ') s of
+        ""          -> True   -- empty
+        ('-':'-':_) -> True   -- comment
+        _           -> False
 
-    prepend = ("" :)
+    -- empty line before each error and warning
+    renderedErrors   = concatMap (("" :) . renderError) errors
+    renderedWarnings = concatMap (("" :) . renderWarning) warnings
 
     renderError :: PError -> [String]
-    renderError e@(PError pos@(Position row _col) _)
+    renderError e@(PError pos@(Position row col) _)
         -- if position is 0:0, then it doesn't make sense to show input
         -- looks like, Parsec errors have line-feed in them
-        | pos == zeroPos = [trim $ showPError filepath e]
-        | otherwise      = [trim $ showPError filepath e, ""] ++
-            zipWith formatInputLine (nths (row - 1) ls) [row - 1 ..]
+        | pos == zeroPos = [trimLF $ showPError filepath e]
+        | otherwise      = [trimLF $ showPError filepath e, ""] ++
+            formatInput row col
 
     -- sometimes there are (especially trailing) newlines.
-    trim = dropWhile (== '\n') . reverse . dropWhile (== '\n') . reverse
+    trimLF :: String -> String
+    trimLF = dropWhile (== '\n') . reverse . dropWhile (== '\n') . reverse
 
     renderWarning :: PWarning -> [String]
-    renderWarning w@(PWarning _ pos@(Position row _col) _)
+    renderWarning w@(PWarning _ pos@(Position row col) _)
         | pos == zeroPos = [showPWarning filepath w]
         | otherwise      = [showPWarning filepath w, ""] ++
-            zipWith formatInputLine (nths (row - 1) ls) [row - 1 ..]
+            formatInput row col
 
     -- format line: prepend the given line number
-    formatInputLine :: BS.ByteString -> Int -> String
-    formatInputLine bs l =
-        showN l ++ " | " ++ fromUTF8BS bs
+    formatInput :: Int -> Int -> [String]
+    formatInput row col = case advance (row - 1) rowsZipper of
+        Zipper xs ys -> before ++ after where
+            before = case span (\(_, _, b) -> b) xs of
+                (_, [])     -> []
+                (zs, z : _) -> map formatInputLine $ z : reverse zs
+
+            after  = case ys of
+                []        -> []
+                (z : _zs) ->
+                    [ formatInputLine z                             -- error line
+                    , "      | " ++ replicate (col - 1) ' ' ++ "^"  -- pointer: ^
+                    ]
+                    -- do we need rows after?
+                    -- ++ map formatInputLine (take 1 zs)           -- one row after
+
+    formatInputLine :: (String, Int, Bool) -> String
+    formatInputLine (str, row, _) = leftPadShow row ++ " | " ++ str
 
     -- hopefully we don't need to work with over 99999 lines .cabal files
     -- at that point small glitches in error messages are hopefully fine.
-    showN n = let s = show n in replicate (5 - length s) ' ' ++ s
+    leftPadShow :: Int -> String
+    leftPadShow n = let s = show n in replicate (5 - length s) ' ' ++ s
+
+data Zipper a = Zipper [a] [a]
+
+listToZipper :: [a] -> Zipper a
+listToZipper = Zipper []
+
+advance :: Int -> Zipper a -> Zipper a
+advance n z@(Zipper xs ys)
+    | n <= 0 = z
+    | otherwise = case ys of
+        []      -> z
+        (y:ys') -> advance (n - 1) $ Zipper (y:xs) ys'