module ShellCheck.Formatter.TTY (format) where
import ShellCheck.Fixer
import ShellCheck.Interface
import ShellCheck.Formatter.Format
import Control.Monad
import Data.Array
import Data.Foldable
import Data.Ord
import Data.IORef
import Data.List
import Data.Maybe
import GHC.Exts
import System.IO
import System.Info
wikiLink :: [Char]
wikiLink = [Char]
"https://www.shellcheck.net/wiki/"
type Ranking = (Char, Severity, Integer)
type ColorFunc = (String -> String -> String)
format :: FormatterOptions -> IO Formatter
format :: FormatterOptions -> IO Formatter
format FormatterOptions
options = do
IORef [(Ranking, Integer, [Char])]
topErrorRef <- [(Ranking, Integer, [Char])]
-> IO (IORef [(Ranking, Integer, [Char])])
forall a. a -> IO (IORef a)
newIORef []
Formatter -> IO Formatter
forall (m :: * -> *) a. Monad m => a -> m a
return Formatter :: IO ()
-> (CheckResult -> SystemInterface IO -> IO ())
-> ([Char] -> [Char] -> IO ())
-> IO ()
-> Formatter
Formatter {
header :: IO ()
header = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
footer :: IO ()
footer = IORef [(Ranking, Integer, [Char])] -> IO ()
outputWiki IORef [(Ranking, Integer, [Char])]
topErrorRef,
onFailure :: [Char] -> [Char] -> IO ()
onFailure = FormatterOptions -> [Char] -> [Char] -> IO ()
outputError FormatterOptions
options,
onResult :: CheckResult -> SystemInterface IO -> IO ()
onResult = FormatterOptions
-> IORef [(Ranking, Integer, [Char])]
-> CheckResult
-> SystemInterface IO
-> IO ()
outputResult FormatterOptions
options IORef [(Ranking, Integer, [Char])]
topErrorRef
}
colorForLevel :: [Char] -> p
colorForLevel [Char]
level =
case [Char]
level of
[Char]
"error" -> p
31
[Char]
"warning" -> p
33
[Char]
"info" -> p
32
[Char]
"style" -> p
32
[Char]
"verbose" -> p
32
[Char]
"message" -> p
1
[Char]
"source" -> p
0
[Char]
_ -> p
0
rankError :: PositionedComment -> Ranking
rankError :: PositionedComment -> Ranking
rankError PositionedComment
err = (Char
ranking, Comment -> Severity
cSeverity (Comment -> Severity) -> Comment -> Severity
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Comment
pcComment PositionedComment
err, Comment -> Integer
cCode (Comment -> Integer) -> Comment -> Integer
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Comment
pcComment PositionedComment
err)
where
ranking :: Char
ranking =
if Comment -> Integer
cCode (PositionedComment -> Comment
pcComment PositionedComment
err) Integer -> [Integer] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Integer]
uninteresting
then Char
'Z'
else Char
'A'
uninteresting :: [Integer]
uninteresting = [
Integer
1009,
Integer
1019,
Integer
1036,
Integer
1047,
Integer
1062,
Integer
1070,
Integer
1072,
Integer
1073,
Integer
1088,
Integer
1089
]
IORef [(Ranking, Integer, [Char])]
errRef [PositionedComment]
comments Int
max = do
[(Ranking, Integer, [Char])]
previous <- IORef [(Ranking, Integer, [Char])]
-> IO [(Ranking, Integer, [Char])]
forall a. IORef a -> IO a
readIORef IORef [(Ranking, Integer, [Char])]
errRef
let current :: [(Ranking, Integer, [Char])]
current = (PositionedComment -> (Ranking, Integer, [Char]))
-> [PositionedComment] -> [(Ranking, Integer, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (\PositionedComment
x -> (PositionedComment -> Ranking
rankError PositionedComment
x, Comment -> Integer
cCode (Comment -> Integer) -> Comment -> Integer
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Comment
pcComment PositionedComment
x, Comment -> [Char]
cMessage (Comment -> [Char]) -> Comment -> [Char]
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Comment
pcComment PositionedComment
x)) [PositionedComment]
comments
IORef [(Ranking, Integer, [Char])]
-> [(Ranking, Integer, [Char])] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [(Ranking, Integer, [Char])]
errRef ([(Ranking, Integer, [Char])] -> IO ())
-> ([(Ranking, Integer, [Char])] -> [(Ranking, Integer, [Char])])
-> [(Ranking, Integer, [Char])]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Ranking, Integer, [Char])] -> [(Ranking, Integer, [Char])]
forall a. Int -> [a] -> [a]
take Int
max ([(Ranking, Integer, [Char])] -> [(Ranking, Integer, [Char])])
-> ([(Ranking, Integer, [Char])] -> [(Ranking, Integer, [Char])])
-> [(Ranking, Integer, [Char])]
-> [(Ranking, Integer, [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ranking, Integer, [Char]) -> (Ranking, Integer, [Char]) -> Bool)
-> [(Ranking, Integer, [Char])] -> [(Ranking, Integer, [Char])]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Ranking, Integer, [Char]) -> (Ranking, Integer, [Char]) -> Bool
forall a b c b c. Eq a => (a, b, c) -> (a, b, c) -> Bool
equal ([(Ranking, Integer, [Char])] -> [(Ranking, Integer, [Char])])
-> ([(Ranking, Integer, [Char])] -> [(Ranking, Integer, [Char])])
-> [(Ranking, Integer, [Char])]
-> [(Ranking, Integer, [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Ranking, Integer, [Char])] -> [(Ranking, Integer, [Char])]
forall a. Ord a => [a] -> [a]
sort ([(Ranking, Integer, [Char])] -> IO ())
-> [(Ranking, Integer, [Char])] -> IO ()
forall a b. (a -> b) -> a -> b
$ [(Ranking, Integer, [Char])]
previous [(Ranking, Integer, [Char])]
-> [(Ranking, Integer, [Char])] -> [(Ranking, Integer, [Char])]
forall a. [a] -> [a] -> [a]
++ [(Ranking, Integer, [Char])]
current
where
fst3 :: (a, b, c) -> a
fst3 (a
x,b
_,c
_) = a
x
equal :: (a, b, c) -> (a, b, c) -> Bool
equal (a, b, c)
x (a, b, c)
y = (a, b, c) -> a
forall a b c. (a, b, c) -> a
fst3 (a, b, c)
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a, b, c) -> a
forall a b c. (a, b, c) -> a
fst3 (a, b, c)
y
outputWiki :: IORef [(Ranking, Integer, String)] -> IO ()
outputWiki :: IORef [(Ranking, Integer, [Char])] -> IO ()
outputWiki IORef [(Ranking, Integer, [Char])]
errRef = do
[(Ranking, Integer, [Char])]
issues <- IORef [(Ranking, Integer, [Char])]
-> IO [(Ranking, Integer, [Char])]
forall a. IORef a -> IO a
readIORef IORef [(Ranking, Integer, [Char])]
errRef
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Ranking, Integer, [Char])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Ranking, Integer, [Char])]
issues) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
[Char] -> IO ()
putStrLn [Char]
"For more information:"
((Ranking, Integer, [Char]) -> IO ())
-> [(Ranking, Integer, [Char])] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ranking, Integer, [Char]) -> IO ()
forall a a. Show a => (a, a, [Char]) -> IO ()
showErr [(Ranking, Integer, [Char])]
issues
where
showErr :: (a, a, [Char]) -> IO ()
showErr (a
_, a
code, [Char]
msg) =
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
wikiLink [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"SC" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
code [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" -- " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
shorten [Char]
msg
limit :: Int
limit = Int
36
shorten :: [Char] -> [Char]
shorten [Char]
msg =
if [Char] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
msg Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
limit
then [Char]
msg
else (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
limitInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3) [Char]
msg) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"..."
outputError :: FormatterOptions -> [Char] -> [Char] -> IO ()
outputError FormatterOptions
options [Char]
file [Char]
error = do
[Char] -> [Char] -> [Char]
color <- ColorOption -> IO ([Char] -> [Char] -> [Char])
getColorFunc (ColorOption -> IO ([Char] -> [Char] -> [Char]))
-> ColorOption -> IO ([Char] -> [Char] -> [Char])
forall a b. (a -> b) -> a -> b
$ FormatterOptions -> ColorOption
foColorOption FormatterOptions
options
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
color [Char]
"error" ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
error
outputResult :: FormatterOptions
-> IORef [(Ranking, Integer, [Char])]
-> CheckResult
-> SystemInterface IO
-> IO ()
outputResult FormatterOptions
options IORef [(Ranking, Integer, [Char])]
ref CheckResult
result SystemInterface IO
sys = do
[Char] -> [Char] -> [Char]
color <- ColorOption -> IO ([Char] -> [Char] -> [Char])
getColorFunc (ColorOption -> IO ([Char] -> [Char] -> [Char]))
-> ColorOption -> IO ([Char] -> [Char] -> [Char])
forall a b. (a -> b) -> a -> b
$ FormatterOptions -> ColorOption
foColorOption FormatterOptions
options
let comments :: [PositionedComment]
comments = CheckResult -> [PositionedComment]
crComments CheckResult
result
IORef [(Ranking, Integer, [Char])]
-> [PositionedComment] -> Int -> IO ()
appendComments IORef [(Ranking, Integer, [Char])]
ref [PositionedComment]
comments (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ FormatterOptions -> Integer
foWikiLinkCount FormatterOptions
options)
let fileGroups :: [[PositionedComment]]
fileGroups = (PositionedComment -> [Char])
-> [PositionedComment] -> [[PositionedComment]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith PositionedComment -> [Char]
sourceFile [PositionedComment]
comments
([PositionedComment] -> IO ()) -> [[PositionedComment]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (([Char] -> [Char] -> [Char])
-> SystemInterface IO -> [PositionedComment] -> IO ()
outputForFile [Char] -> [Char] -> [Char]
color SystemInterface IO
sys) [[PositionedComment]]
fileGroups
outputForFile :: ([Char] -> [Char] -> [Char])
-> SystemInterface IO -> [PositionedComment] -> IO ()
outputForFile [Char] -> [Char] -> [Char]
color SystemInterface IO
sys [PositionedComment]
comments = do
let fileName :: [Char]
fileName = PositionedComment -> [Char]
sourceFile ([PositionedComment] -> PositionedComment
forall a. [a] -> a
head [PositionedComment]
comments)
Either [Char] [Char]
result <- SystemInterface IO
-> Maybe Bool -> [Char] -> IO (Either [Char] [Char])
forall (m :: * -> *).
SystemInterface m
-> Maybe Bool -> [Char] -> m (Either [Char] [Char])
siReadFile SystemInterface IO
sys (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) [Char]
fileName
let contents :: [Char]
contents = ([Char] -> [Char])
-> ([Char] -> [Char]) -> Either [Char] [Char] -> [Char]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> [Char] -> [Char]
forall a b. a -> b -> a
const [Char]
"") [Char] -> [Char]
forall a. a -> a
id Either [Char] [Char]
result
let fileLinesList :: [[Char]]
fileLinesList = [Char] -> [[Char]]
lines [Char]
contents
let lineCount :: Int
lineCount = [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
fileLinesList
let fileLines :: Array Int [Char]
fileLines = (Int, Int) -> [[Char]] -> Array Int [Char]
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1, Int
lineCount) [[Char]]
fileLinesList
let groups :: [[PositionedComment]]
groups = (PositionedComment -> Integer)
-> [PositionedComment] -> [[PositionedComment]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith PositionedComment -> Integer
lineNo [PositionedComment]
comments
[[PositionedComment]] -> ([PositionedComment] -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[PositionedComment]]
groups (([PositionedComment] -> IO ()) -> IO ())
-> ([PositionedComment] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[PositionedComment]
commentsForLine -> do
let lineNum :: Int
lineNum = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Integer
lineNo ([PositionedComment] -> PositionedComment
forall a. [a] -> a
head [PositionedComment]
commentsForLine)
let line :: [Char]
line = if Int
lineNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
lineNum Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lineCount
then [Char]
""
else Array Int [Char]
fileLines Array Int [Char] -> Int -> [Char]
forall i e. Ix i => Array i e -> i -> e
! Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineNum
[Char] -> IO ()
putStrLn [Char]
""
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
color [Char]
"message" ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char]
"In " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
fileName [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" line " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lineNum [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
":"
[Char] -> IO ()
putStrLn ([Char] -> [Char] -> [Char]
color [Char]
"source" [Char]
line)
[PositionedComment] -> (PositionedComment -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PositionedComment]
commentsForLine ((PositionedComment -> IO ()) -> IO ())
-> (PositionedComment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PositionedComment
c -> [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
color (PositionedComment -> [Char]
severityText PositionedComment
c) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ PositionedComment -> [Char]
cuteIndent PositionedComment
c
[Char] -> IO ()
putStrLn [Char]
""
([Char] -> [Char] -> [Char])
-> [PositionedComment] -> Int -> Array Int [Char] -> IO ()
showFixedString [Char] -> [Char] -> [Char]
color [PositionedComment]
commentsForLine (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineNum) Array Int [Char]
fileLines
sliceFile :: Fix -> Array Int String -> (Fix, Array Int String)
sliceFile :: Fix -> Array Int [Char] -> (Fix, Array Int [Char])
sliceFile Fix
fix Array Int [Char]
lines =
((Position -> Position) -> Fix -> Fix
mapPositions Position -> Position
adjust Fix
fix, Array Int [Char] -> Array Int [Char]
sliceLines Array Int [Char]
lines)
where
(Int
minLine, Int
maxLine) =
((Int, Int) -> Position -> (Int, Int))
-> (Int, Int) -> [Position] -> (Int, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\(Int
mm, Int
mx) Position
pos -> ((Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
mm (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Position -> Integer
posLine Position
pos), (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
mx (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Position -> Integer
posLine Position
pos)))
(Int
forall a. Bounded a => a
maxBound, Int
forall a. Bounded a => a
minBound) ([Position] -> (Int, Int)) -> [Position] -> (Int, Int)
forall a b. (a -> b) -> a -> b
$
(Replacement -> [Position]) -> [Replacement] -> [Position]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Replacement
x -> [Replacement -> Position
repStartPos Replacement
x, Replacement -> Position
repEndPos Replacement
x]) ([Replacement] -> [Position]) -> [Replacement] -> [Position]
forall a b. (a -> b) -> a -> b
$ Fix -> [Replacement]
fixReplacements Fix
fix
sliceLines :: Array Int String -> Array Int String
sliceLines :: Array Int [Char] -> Array Int [Char]
sliceLines = (Int, Int) -> (Int -> Int) -> Array Int [Char] -> Array Int [Char]
forall i j e.
(Ix i, Ix j) =>
(i, i) -> (i -> j) -> Array j e -> Array i e
ixmap (Int
1, Int
maxLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (\Int
x -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
minLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
adjust :: Position -> Position
adjust Position
pos =
Position
pos {
posLine :: Integer
posLine = Position -> Integer
posLine Position
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minLine) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
}
showFixedString :: ColorFunc -> [PositionedComment] -> Int -> Array Int String -> IO ()
showFixedString :: ([Char] -> [Char] -> [Char])
-> [PositionedComment] -> Int -> Array Int [Char] -> IO ()
showFixedString [Char] -> [Char] -> [Char]
color [PositionedComment]
comments Int
lineNum Array Int [Char]
fileLines =
let line :: [Char]
line = Array Int [Char]
fileLines Array Int [Char] -> Int -> [Char]
forall i e. Ix i => Array i e -> i -> e
! Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineNum in
case (PositionedComment -> Maybe Fix) -> [PositionedComment] -> [Fix]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PositionedComment -> Maybe Fix
pcFix [PositionedComment]
comments of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Fix]
fixes -> do
let mergedFix :: Fix
mergedFix = [Fix] -> Fix
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Fix]
fixes
let (Fix
excerptFix, Array Int [Char]
excerpt) = Fix -> Array Int [Char] -> (Fix, Array Int [Char])
sliceFile Fix
mergedFix Array Int [Char]
fileLines
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
color [Char]
"message" [Char]
"Did you mean: "
[Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Fix -> Array Int [Char] -> [[Char]]
applyFix Fix
excerptFix Array Int [Char]
excerpt
cuteIndent :: PositionedComment -> String
cuteIndent :: PositionedComment -> [Char]
cuteIndent PositionedComment
comment =
Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Integer
colNo PositionedComment
comment Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Char
' ' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
makeArrow [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
code (PositionedComment -> Integer
codeNo PositionedComment
comment) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PositionedComment -> [Char]
severityText PositionedComment
comment [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"): " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PositionedComment -> [Char]
messageText PositionedComment
comment
where
arrow :: a -> [Char]
arrow a
n = Char
'^' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int) -> a -> Int
forall a b. (a -> b) -> a -> b
$ a
na -> a -> a
forall a. Num a => a -> a -> a
-a
2) Char
'-' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"^"
makeArrow :: [Char]
makeArrow =
let sameLine :: Bool
sameLine = PositionedComment -> Integer
lineNo PositionedComment
comment Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== PositionedComment -> Integer
endLineNo PositionedComment
comment
delta :: Integer
delta = PositionedComment -> Integer
endColNo PositionedComment
comment Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- PositionedComment -> Integer
colNo PositionedComment
comment
in
if Bool
sameLine Bool -> Bool -> Bool
&& Integer
delta Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
2 Bool -> Bool -> Bool
&& Integer
delta Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
32 then Integer -> [Char]
forall a. Integral a => a -> [Char]
arrow Integer
delta else [Char]
"^--"
code :: a -> [Char]
code a
num = [Char]
"SC" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
num
getColorFunc :: ColorOption -> IO ColorFunc
getColorFunc :: ColorOption -> IO ([Char] -> [Char] -> [Char])
getColorFunc ColorOption
colorOption = do
Bool
useColor <- ColorOption -> IO Bool
shouldOutputColor ColorOption
colorOption
([Char] -> [Char] -> [Char]) -> IO ([Char] -> [Char] -> [Char])
forall (m :: * -> *) a. Monad m => a -> m a
return (([Char] -> [Char] -> [Char]) -> IO ([Char] -> [Char] -> [Char]))
-> ([Char] -> [Char] -> [Char]) -> IO ([Char] -> [Char] -> [Char])
forall a b. (a -> b) -> a -> b
$ if Bool
useColor then [Char] -> [Char] -> [Char]
colorComment else ([Char] -> [Char]) -> [Char] -> [Char] -> [Char]
forall a b. a -> b -> a
const [Char] -> [Char]
forall a. a -> a
id
where
colorComment :: [Char] -> [Char] -> [Char]
colorComment [Char]
level [Char]
comment =
Integer -> [Char]
forall a. Show a => a -> [Char]
ansi ([Char] -> Integer
forall p. Num p => [Char] -> p
colorForLevel [Char]
level) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
comment [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
clear
clear :: [Char]
clear = Integer -> [Char]
forall a. Show a => a -> [Char]
ansi Integer
0
ansi :: a -> [Char]
ansi a
n = [Char]
"\x1B[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"m"