From 46ae8b2eed12cb69b5e259b4930324dcccb7e12d Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Mon, 26 Nov 2018 06:26:41 +0200
Subject: [PATCH] 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,
| ^
```
---
.../Distribution/Client/Utils/Parsec.hs | 74 ++++++++++++++-----
1 file changed, 54 insertions(+), 20 deletions(-)
diff --git a/cabal-install/Distribution/Client/Utils/Parsec.hs b/cabal-install/Distribution/Client/Utils/Parsec.hs
index 8d866d3283..13851efe6c 100644
--- a/cabal-install/Distribution/Client/Utils/Parsec.hs
+++ b/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'
--
GitLab