module ShellCheck.Formatter.TTY (format) where
import ShellCheck.Fixer
import ShellCheck.Interface
import ShellCheck.Formatter.Format
import Control.DeepSeq
import Control.Monad
import Data.Array
import Data.Foldable
import Data.Ord
import Data.IORef
import Data.List
import Data.Maybe
import System.IO
import System.Info
import qualified Data.List.NonEmpty as NE
wikiLink :: String
wikiLink = String
"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, String)]
topErrorRef <- [(Ranking, Integer, String)]
-> IO (IORef [(Ranking, Integer, String)])
forall a. a -> IO (IORef a)
newIORef []
Formatter -> IO Formatter
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Formatter {
header :: IO ()
header = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (),
footer :: IO ()
footer = IORef [(Ranking, Integer, String)] -> IO ()
outputWiki IORef [(Ranking, Integer, String)]
topErrorRef,
onFailure :: String -> String -> IO ()
onFailure = FormatterOptions -> String -> String -> IO ()
outputError FormatterOptions
options,
onResult :: CheckResult -> SystemInterface IO -> IO ()
onResult = FormatterOptions
-> IORef [(Ranking, Integer, String)]
-> CheckResult
-> SystemInterface IO
-> IO ()
outputResult FormatterOptions
options IORef [(Ranking, Integer, String)]
topErrorRef
}
colorForLevel :: String -> a
colorForLevel String
level =
case String
level of
String
"error" -> a
31
String
"warning" -> a
33
String
"info" -> a
32
String
"style" -> a
32
String
"verbose" -> a
32
String
"message" -> a
1
String
"source" -> a
0
String
_ -> a
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 a. Eq a => a -> [a] -> 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, String)]
errRef [PositionedComment]
comments Int
max = do
[(Ranking, Integer, String)]
previous <- IORef [(Ranking, Integer, String)]
-> IO [(Ranking, Integer, String)]
forall a. IORef a -> IO a
readIORef IORef [(Ranking, Integer, String)]
errRef
let current :: [(Ranking, Integer, String)]
current = (PositionedComment -> (Ranking, Integer, String))
-> [PositionedComment] -> [(Ranking, Integer, String)]
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 -> String
cMessage (Comment -> String) -> Comment -> String
forall a b. (a -> b) -> a -> b
$ PositionedComment -> Comment
pcComment PositionedComment
x)) [PositionedComment]
comments
IORef [(Ranking, Integer, String)]
-> [(Ranking, Integer, String)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [(Ranking, Integer, String)]
errRef ([(Ranking, Integer, String)] -> IO ())
-> [(Ranking, Integer, String)] -> IO ()
forall a b. (a -> b) -> a -> b
$! [(Ranking, Integer, String)] -> [(Ranking, Integer, String)]
forall a. NFData a => a -> a
force ([(Ranking, Integer, String)] -> [(Ranking, Integer, String)])
-> ([(Ranking, Integer, String)] -> [(Ranking, Integer, String)])
-> [(Ranking, Integer, String)]
-> [(Ranking, Integer, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Ranking, Integer, String)] -> [(Ranking, Integer, String)]
forall a. Int -> [a] -> [a]
take Int
max ([(Ranking, Integer, String)] -> [(Ranking, Integer, String)])
-> ([(Ranking, Integer, String)] -> [(Ranking, Integer, String)])
-> [(Ranking, Integer, String)]
-> [(Ranking, Integer, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Ranking, Integer, String) -> (Ranking, Integer, String) -> Bool)
-> [(Ranking, Integer, String)] -> [(Ranking, Integer, String)]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Ranking, Integer, String) -> (Ranking, Integer, String) -> Bool
forall {a} {b} {c} {b} {c}. Eq a => (a, b, c) -> (a, b, c) -> Bool
equal ([(Ranking, Integer, String)] -> [(Ranking, Integer, String)])
-> ([(Ranking, Integer, String)] -> [(Ranking, Integer, String)])
-> [(Ranking, Integer, String)]
-> [(Ranking, Integer, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Ranking, Integer, String)] -> [(Ranking, Integer, String)]
forall a. Ord a => [a] -> [a]
sort ([(Ranking, Integer, String)] -> [(Ranking, Integer, String)])
-> [(Ranking, Integer, String)] -> [(Ranking, Integer, String)]
forall a b. (a -> b) -> a -> b
$ [(Ranking, Integer, String)]
previous [(Ranking, Integer, String)]
-> [(Ranking, Integer, String)] -> [(Ranking, Integer, String)]
forall a. [a] -> [a] -> [a]
++ [(Ranking, Integer, String)]
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, String)] -> IO ()
outputWiki IORef [(Ranking, Integer, String)]
errRef = do
[(Ranking, Integer, String)]
issues <- IORef [(Ranking, Integer, String)]
-> IO [(Ranking, Integer, String)]
forall a. IORef a -> IO a
readIORef IORef [(Ranking, Integer, String)]
errRef
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Ranking, Integer, String)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Ranking, Integer, String)]
issues) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn String
"For more information:"
((Ranking, Integer, String) -> IO ())
-> [(Ranking, Integer, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ranking, Integer, String) -> IO ()
forall {a} {a}. Show a => (a, a, String) -> IO ()
showErr [(Ranking, Integer, String)]
issues
where
showErr :: (a, a, String) -> IO ()
showErr (a
_, a
code, String
msg) =
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wikiLink String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"SC" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
code String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" -- " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
shorten String
msg
limit :: Int
limit = Int
36
shorten :: String -> String
shorten String
msg =
if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
msg Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
limit
then String
msg
else (Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
limitInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
3) String
msg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."
outputError :: FormatterOptions -> String -> String -> IO ()
outputError FormatterOptions
options String
file String
error = do
String -> String -> String
color <- ColorOption -> IO (String -> String -> String)
getColorFunc (ColorOption -> IO (String -> String -> String))
-> ColorOption -> IO (String -> String -> String)
forall a b. (a -> b) -> a -> b
$ FormatterOptions -> ColorOption
foColorOption FormatterOptions
options
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
color String
"error" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
error
outputResult :: FormatterOptions
-> IORef [(Ranking, Integer, String)]
-> CheckResult
-> SystemInterface IO
-> IO ()
outputResult FormatterOptions
options IORef [(Ranking, Integer, String)]
ref CheckResult
result SystemInterface IO
sys = do
String -> String -> String
color <- ColorOption -> IO (String -> String -> String)
getColorFunc (ColorOption -> IO (String -> String -> String))
-> ColorOption -> IO (String -> String -> String)
forall a b. (a -> b) -> a -> b
$ FormatterOptions -> ColorOption
foColorOption FormatterOptions
options
let comments :: [PositionedComment]
comments = CheckResult -> [PositionedComment]
crComments CheckResult
result
IORef [(Ranking, Integer, String)]
-> [PositionedComment] -> Int -> IO ()
appendComments IORef [(Ranking, Integer, String)]
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 :: [NonEmpty PositionedComment]
fileGroups = (PositionedComment -> String)
-> [PositionedComment] -> [NonEmpty PositionedComment]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
NE.groupWith PositionedComment -> String
sourceFile [PositionedComment]
comments
(NonEmpty PositionedComment -> IO ())
-> [NonEmpty PositionedComment] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String -> String -> String)
-> SystemInterface IO -> NonEmpty PositionedComment -> IO ()
outputForFile String -> String -> String
color SystemInterface IO
sys) [NonEmpty PositionedComment]
fileGroups
outputForFile :: (String -> String -> String)
-> SystemInterface IO -> NonEmpty PositionedComment -> IO ()
outputForFile String -> String -> String
color SystemInterface IO
sys NonEmpty PositionedComment
comments = do
let fileName :: String
fileName = PositionedComment -> String
sourceFile (NonEmpty PositionedComment -> PositionedComment
forall a. NonEmpty a -> a
NE.head NonEmpty PositionedComment
comments)
Either String String
result <- SystemInterface IO
-> Maybe Bool -> String -> IO (Either String String)
forall (m :: * -> *).
SystemInterface m
-> Maybe Bool -> String -> m (Either String String)
siReadFile SystemInterface IO
sys (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) String
fileName
let contents :: String
contents = (String -> String)
-> (String -> String) -> Either String String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> String
forall a b. a -> b -> a
const String
"") String -> String
forall a. a -> a
id Either String String
result
let fileLinesList :: [String]
fileLinesList = String -> [String]
lines String
contents
let lineCount :: Int
lineCount = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
fileLinesList
let fileLines :: Array Int String
fileLines = (Int, Int) -> [String] -> Array Int String
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1, Int
lineCount) [String]
fileLinesList
let groups :: [NonEmpty PositionedComment]
groups = (PositionedComment -> Integer)
-> NonEmpty PositionedComment -> [NonEmpty PositionedComment]
forall (f :: * -> *) b a.
(Foldable f, Eq b) =>
(a -> b) -> f a -> [NonEmpty a]
NE.groupWith PositionedComment -> Integer
lineNo NonEmpty PositionedComment
comments
[NonEmpty PositionedComment]
-> (NonEmpty PositionedComment -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [NonEmpty PositionedComment]
groups ((NonEmpty PositionedComment -> IO ()) -> IO ())
-> (NonEmpty PositionedComment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NonEmpty 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 (NonEmpty PositionedComment -> PositionedComment
forall a. NonEmpty a -> a
NE.head NonEmpty PositionedComment
commentsForLine)
let line :: String
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 String
""
else Array Int String
fileLines Array Int String -> Int -> String
forall i e. Ix i => Array i e -> i -> e
! Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineNum
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
color String
"message" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
String
"In " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fileName String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" line " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lineNum String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
String -> IO ()
putStrLn (String -> String -> String
color String
"source" String
line)
NonEmpty PositionedComment -> (PositionedComment -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ NonEmpty PositionedComment
commentsForLine ((PositionedComment -> IO ()) -> IO ())
-> (PositionedComment -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \PositionedComment
c -> String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
color (PositionedComment -> String
severityText PositionedComment
c) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ PositionedComment -> String
cuteIndent PositionedComment
c
String -> IO ()
putStrLn String
""
(String -> String -> String)
-> [PositionedComment] -> Int -> Array Int String -> IO ()
showFixedString String -> String -> String
color (NonEmpty PositionedComment -> [PositionedComment]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty PositionedComment
commentsForLine) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineNum) Array Int String
fileLines
sliceFile :: Fix -> Array Int String -> (Fix, Array Int String)
sliceFile :: Fix -> Array Int String -> (Fix, Array Int String)
sliceFile Fix
fix Array Int String
lines =
((Position -> Position) -> Fix -> Fix
mapPositions Position -> Position
adjust Fix
fix, Array Int String -> Array Int String
sliceLines Array Int String
lines)
where
(Int
minLine, Int
maxLine) =
((Int, Int) -> Position -> (Int, Int))
-> (Int, Int) -> [Position] -> (Int, Int)
forall b a. (b -> a -> b) -> b -> [a] -> b
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 String -> Array Int String
sliceLines = (Int, Int) -> (Int -> Int) -> Array Int String -> Array Int String
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 = posLine pos - (fromIntegral minLine) + 1
}
showFixedString :: ColorFunc -> [PositionedComment] -> Int -> Array Int String -> IO ()
showFixedString :: (String -> String -> String)
-> [PositionedComment] -> Int -> Array Int String -> IO ()
showFixedString String -> String -> String
color [PositionedComment]
comments Int
lineNum Array Int String
fileLines =
let line :: String
line = Array Int String
fileLines Array Int String -> Int -> String
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Fix]
fixes -> do
let mergedFix :: Fix
mergedFix = [Fix] -> Fix
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [Fix]
fixes
let (Fix
excerptFix, Array Int String
excerpt) = Fix -> Array Int String -> (Fix, Array Int String)
sliceFile Fix
mergedFix Array Int String
fileLines
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
color String
"message" String
"Did you mean: "
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Fix -> Array Int String -> [String]
applyFix Fix
excerptFix Array Int String
excerpt
cuteIndent :: PositionedComment -> String
cuteIndent :: PositionedComment -> String
cuteIndent PositionedComment
comment =
Int -> Char -> String
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
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
makeArrow String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
code (PositionedComment -> Integer
codeNo PositionedComment
comment) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PositionedComment -> String
severityText PositionedComment
comment String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PositionedComment -> String
messageText PositionedComment
comment
where
arrow :: a -> String
arrow a
n = Char
'^' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> Char -> String
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
'-' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"^"
makeArrow :: String
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 -> String
forall {a}. Integral a => a -> String
arrow Integer
delta else String
"^--"
code :: a -> String
code a
num = String
"SC" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
num
getColorFunc :: ColorOption -> IO ColorFunc
getColorFunc :: ColorOption -> IO (String -> String -> String)
getColorFunc ColorOption
colorOption = do
Bool
useColor <- ColorOption -> IO Bool
shouldOutputColor ColorOption
colorOption
(String -> String -> String) -> IO (String -> String -> String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> String -> String) -> IO (String -> String -> String))
-> (String -> String -> String) -> IO (String -> String -> String)
forall a b. (a -> b) -> a -> b
$ if Bool
useColor then String -> String -> String
colorComment else (String -> String) -> String -> String -> String
forall a b. a -> b -> a
const String -> String
forall a. a -> a
id
where
colorComment :: String -> String -> String
colorComment String
level String
comment =
Integer -> String
forall a. Show a => a -> String
ansi (String -> Integer
forall {a}. Num a => String -> a
colorForLevel String
level) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
comment String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
clear
clear :: String
clear = Integer -> String
forall a. Show a => a -> String
ansi Integer
0
ansi :: a -> String
ansi a
n = String
"\x1B[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"m"