diff --git a/cabal-install/Distribution/Client/Utils/Parsec.hs b/cabal-install/Distribution/Client/Utils/Parsec.hs index 8d866d328397d77838a40338839dd6c8ea78e52a..13851efe6c4c9d1711c80042ac891d45d6d1efb3 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'