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