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

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

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 :: FilePath -> ByteString -> NonEmpty PError -> [PWarning] -> FilePath
renderParseError FilePath
filepath ByteString
contents NonEmpty PError
errors [PWarning]
warnings = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
    [ FilePath
"Errors encountered when parsing cabal file " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
filepath FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
":"
    ]
    [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
renderedErrors
    [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
renderedWarnings
  where
    filepath' :: FilePath
filepath' = FilePath -> FilePath
normalise FilePath
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 :: [(FilePath, Int, Bool)]
rows = (ByteString -> Int -> (FilePath, Int, Bool))
-> [ByteString] -> [Int] -> [(FilePath, Int, Bool)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ByteString -> Int -> (FilePath, Int, Bool)
forall b. ByteString -> b -> (FilePath, b, Bool)
f (ByteString -> [ByteString]
BS8.lines ByteString
contents) [Int
1..] where
        f :: ByteString -> b -> (FilePath, b, Bool)
f ByteString
bs b
i = let s :: FilePath
s = ByteString -> FilePath
fromUTF8BS ByteString
bs in (FilePath
s, b
i, FilePath -> Bool
isEmptyOrComment FilePath
s)

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

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

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

    renderError :: PError -> [String]
    renderError :: PError -> [FilePath]
renderError (PError pos :: Position
pos@(Position Int
row Int
col) FilePath
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 = [FilePath]
msgs
        | Bool
otherwise      = [FilePath]
msgs [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [FilePath]
formatInput Int
row Int
col
      where
        msgs :: [FilePath]
msgs = [ FilePath
"", FilePath
filepath' FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
":" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Position -> FilePath
showPos Position
pos FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": error:", FilePath -> FilePath
trimLF FilePath
msg, FilePath
"" ]

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

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

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

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

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

data Zipper a = Zipper [a] [a]

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

advance :: Int -> Zipper a -> Zipper a
advance :: 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
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys'