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)
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
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
(Char
'-':Char
'-':FilePath
_) -> Bool
True
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)
| 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
"" ]
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
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
, 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
"^"
]
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
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'