module Distribution.Client.Utils.Parsec
  ( renderParseError
  ) where

import Distribution.Client.Compat.Prelude
import System.FilePath (normalise)
import Prelude ()

import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

import Distribution.Parsec (PError (..), PWarning (..), Position (..), showPos, zeroPos)
import Distribution.Simple.Utils (fromUTF8BS)

-- | Render parse error highlighting the part of the input file.
renderParseError
  :: FilePath
  -> BS.ByteString
  -> NonEmpty PError
  -> [PWarning]
  -> String
renderParseError :: String -> ByteString -> NonEmpty PError -> [PWarning] -> String
renderParseError String
filepath ByteString
contents NonEmpty PError
errors [PWarning]
warnings =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    [ String
"Errors encountered when parsing cabal file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
filepath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":"
    ]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
renderedErrors
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
renderedWarnings
  where
    filepath' :: String
filepath' = String -> String
normalise String
filepath

    -- 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 :: [(String, Int, Bool)]
rows = (ByteString -> Int -> (String, Int, Bool))
-> [ByteString] -> [Int] -> [(String, Int, Bool)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ByteString -> Int -> (String, Int, Bool)
forall {b}. ByteString -> b -> (String, b, Bool)
f (ByteString -> [ByteString]
BS8.lines ByteString
contents) [Int
1 ..]
      where
        f :: ByteString -> b -> (String, b, Bool)
f ByteString
bs b
i = let s :: String
s = ByteString -> String
fromUTF8BS ByteString
bs in (String
s, b
i, String -> Bool
isEmptyOrComment String
s)

    rowsZipper :: Zipper (String, Int, Bool)
rowsZipper = [(String, Int, Bool)] -> Zipper (String, Int, Bool)
forall a. [a] -> Zipper a
listToZipper [(String, Int, Bool)]
rows

    isEmptyOrComment :: String -> Bool
    isEmptyOrComment :: String -> Bool
isEmptyOrComment String
s = case (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') String
s of
      String
"" -> Bool
True -- empty
      (Char
'-' : Char
'-' : String
_) -> Bool
True -- comment
      String
_ -> Bool
False

    renderedErrors :: [String]
renderedErrors = (PError -> [String]) -> NonEmpty PError -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PError -> [String]
renderError NonEmpty PError
errors
    renderedWarnings :: [String]
renderedWarnings = (PWarning -> [String]) -> [PWarning] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PWarning -> [String]
renderWarning [PWarning]
warnings

    renderError :: PError -> [String]
    renderError :: PError -> [String]
renderError (PError pos :: Position
pos@(Position Int
row Int
col) String
msg)
      -- if position is 0:0, then it doesn't make sense to show input
      -- looks like, Parsec errors have line-feed in them
      | Position
pos Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
zeroPos = [String]
msgs
      | Bool
otherwise = [String]
msgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [String]
formatInput Int
row Int
col
      where
        msgs :: [String]
msgs = [String
"", String
filepath' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
showPos Position
pos String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": error:", String -> String
trimLF String
msg, String
""]

    renderWarning :: PWarning -> [String]
    renderWarning :: PWarning -> [String]
renderWarning (PWarning PWarnType
_ pos :: Position
pos@(Position Int
row Int
col) String
msg)
      | Position
pos Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
zeroPos = [String]
msgs
      | Bool
otherwise = [String]
msgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [String]
formatInput Int
row Int
col
      where
        msgs :: [String]
msgs = [String
"", String
filepath' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
showPos Position
pos String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": warning:", String -> String
trimLF String
msg, String
""]

    -- sometimes there are (especially trailing) newlines.
    trimLF :: String -> String
    trimLF :: String -> String
trimLF = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse

    -- format line: prepend the given line number
    formatInput :: Int -> Int -> [String]
    formatInput :: Int -> Int -> [String]
formatInput Int
row Int
col = case Int -> Zipper (String, Int, Bool) -> Zipper (String, Int, Bool)
forall a. Int -> Zipper a -> Zipper a
advance (Int
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Zipper (String, Int, Bool)
rowsZipper of
      Zipper [(String, Int, Bool)]
xs [(String, Int, Bool)]
ys -> [String]
before [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
after
        where
          before :: [String]
before = case ((String, Int, Bool) -> Bool)
-> [(String, Int, Bool)]
-> ([(String, Int, Bool)], [(String, Int, Bool)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\(String
_, Int
_, Bool
b) -> Bool
b) [(String, Int, Bool)]
xs of
            ([(String, Int, Bool)]
_, []) -> []
            ([(String, Int, Bool)]
zs, (String, Int, Bool)
z : [(String, Int, Bool)]
_) -> ((String, Int, Bool) -> String)
-> [(String, Int, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int, Bool) -> String
formatInputLine ([(String, Int, Bool)] -> [String])
-> [(String, Int, Bool)] -> [String]
forall a b. (a -> b) -> a -> b
$ (String, Int, Bool)
z (String, Int, Bool)
-> [(String, Int, Bool)] -> [(String, Int, Bool)]
forall a. a -> [a] -> [a]
: [(String, Int, Bool)] -> [(String, Int, Bool)]
forall a. [a] -> [a]
reverse [(String, Int, Bool)]
zs

          after :: [String]
after = case [(String, Int, Bool)]
ys of
            [] -> []
            ((String, Int, Bool)
z : [(String, Int, Bool)]
_zs) ->
              [ (String, Int, Bool) -> String
formatInputLine (String, Int, Bool)
z -- error line
              , String
"      | " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^" -- pointer: ^
              ]
    -- do we need rows after?
    -- ++ map formatInputLine (take 1 zs)           -- one row after

    formatInputLine :: (String, Int, Bool) -> String
    formatInputLine :: (String, Int, Bool) -> String
formatInputLine (String
str, Int
row, Bool
_) = Int -> String
leftPadShow Int
row String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" | " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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.
    leftPadShow :: Int -> String
    leftPadShow :: Int -> String
leftPadShow Int
n = let s :: String
s = Int -> String
forall a. Show a => a -> String
show Int
n in Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

data Zipper a = Zipper [a] [a]

listToZipper :: [a] -> Zipper a
listToZipper :: forall a. [a] -> Zipper a
listToZipper = [a] -> [a] -> Zipper a
forall a. [a] -> [a] -> Zipper a
Zipper []

advance :: Int -> Zipper a -> Zipper a
advance :: forall a. Int -> Zipper a -> Zipper a
advance Int
n z :: Zipper a
z@(Zipper [a]
xs [a]
ys)
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Zipper a
z
  | Bool
otherwise = case [a]
ys of
      [] -> Zipper a
z
      (a
y : [a]
ys') -> Int -> Zipper a -> Zipper a
forall a. Int -> Zipper a -> Zipper a
advance (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Zipper a -> Zipper a) -> Zipper a -> Zipper a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> Zipper a
forall a. [a] -> [a] -> Zipper a
Zipper (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs) [a]
ys'