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 :: String -> ByteString -> NonEmpty PError -> [PWarning] -> String
renderParseError String
filepath ByteString
contents NonEmpty PError
errors [PWarning]
warnings = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
    [ String
"Errors encountered when parsing cabal file " forall a. Semigroup a => a -> a -> a
<> String
filepath forall a. Semigroup a => a -> a -> a
<> String
":"
    ]
    forall a. [a] -> [a] -> [a]
++ [String]
renderedErrors
    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 = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall a. [a] -> Zipper a
listToZipper [(String, Int, Bool)]
rows

    isEmptyOrComment :: String -> Bool
    isEmptyOrComment :: String -> Bool
isEmptyOrComment String
s = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (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   = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PError -> [String]
renderError NonEmpty PError
errors
    renderedWarnings :: [String]
renderedWarnings = 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 forall a. Eq a => a -> a -> Bool
== Position
zeroPos = [String]
msgs
        | Bool
otherwise      = [String]
msgs forall a. [a] -> [a] -> [a]
++ Int -> Int -> [String]
formatInput Int
row Int
col
      where
        msgs :: [String]
msgs = [ String
"", String
filepath' forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ Position -> String
showPos Position
pos 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 forall a. Eq a => a -> a -> Bool
== Position
zeroPos = [String]
msgs
        | Bool
otherwise      = [String]
msgs forall a. [a] -> [a] -> [a]
++ Int -> Int -> [String]
formatInput Int
row Int
col
      where
        msgs :: [String]
msgs = [ String
"", String
filepath' forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ Position -> String
showPos Position
pos 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 = forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'\n') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'\n') forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Int -> Zipper a -> Zipper a
advance (Int
row 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 forall a. [a] -> [a] -> [a]
++ [String]
after where
            before :: [String]
before = case 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)]
_) -> forall a b. (a -> b) -> [a] -> [b]
map (String, Int, Bool) -> String
formatInputLine forall a b. (a -> b) -> a -> b
$ (String, Int, Bool)
z forall a. a -> [a] -> [a]
: 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
"      | " forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
col forall a. Num a => a -> a -> a
- Int
1) Char
' ' 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 forall a. [a] -> [a] -> [a]
++ 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 = forall a. Show a => a -> String
show Int
n in forall a. Int -> a -> [a]
replicate (Int
5 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' ' forall a. [a] -> [a] -> [a]
++ String
s

data Zipper a = Zipper [a] [a]

listToZipper :: [a] -> Zipper a
listToZipper :: forall a. [a] -> Zipper a
listToZipper = 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 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') -> forall a. Int -> Zipper a -> Zipper a
advance (Int
n forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a] -> Zipper a
Zipper (a
yforall a. a -> [a] -> [a]
:[a]
xs) [a]
ys'