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 GHC.Exts
import System.IO
import System.Info
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 <- forall a. a -> IO (IORef a)
newIORef []
forall (m :: * -> *) a. Monad m => a -> m a
return Formatter {
header :: IO ()
header = 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 forall a b. (a -> b) -> a -> b
$ PositionedComment -> Comment
pcComment PositionedComment
err, Comment -> Integer
cCode 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) 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 <- forall a. IORef a -> IO a
readIORef IORef [(Ranking, Integer, String)]
errRef
let current :: [(Ranking, Integer, String)]
current = forall a b. (a -> b) -> [a] -> [b]
map (\PositionedComment
x -> (PositionedComment -> Ranking
rankError PositionedComment
x, Comment -> Integer
cCode forall a b. (a -> b) -> a -> b
$ PositionedComment -> Comment
pcComment PositionedComment
x, Comment -> String
cMessage forall a b. (a -> b) -> a -> b
$ PositionedComment -> Comment
pcComment PositionedComment
x)) [PositionedComment]
comments
forall a. IORef a -> a -> IO ()
writeIORef IORef [(Ranking, Integer, String)]
errRef forall a b. (a -> b) -> a -> b
$! forall a. NFData a => a -> a
force forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
max forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy forall {a} {b} {c} {b} {c}. Eq a => (a, b, c) -> (a, b, c) -> Bool
equal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ [(Ranking, Integer, String)]
previous 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 = forall {a} {b} {c}. (a, b, c) -> a
fst3 (a, b, c)
x forall a. Eq a => a -> a -> Bool
== 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 <- forall a. IORef a -> IO a
readIORef IORef [(Ranking, Integer, String)]
errRef
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Ranking, Integer, String)]
issues) forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn String
"For more information:"
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ 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 forall a b. (a -> b) -> a -> b
$ String
" " forall a. [a] -> [a] -> [a]
++ String
wikiLink forall a. [a] -> [a] -> [a]
++ String
"SC" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
code forall a. [a] -> [a] -> [a]
++ String
" -- " forall a. [a] -> [a] -> [a]
++ String -> String
shorten String
msg
limit :: Int
limit = Int
36
shorten :: String -> String
shorten String
msg =
if forall (t :: * -> *) a. Foldable t => t a -> Int
length String
msg forall a. Ord a => a -> a -> Bool
< Int
limit
then String
msg
else (forall a. Int -> [a] -> [a]
take (Int
limitforall a. Num a => a -> a -> a
-Int
3) String
msg) forall a. [a] -> [a] -> [a]
++ String
"..."
outputError :: FormatterOptions -> String -> String -> IO ()
outputError FormatterOptions
options String
file String
error = do
ColorFunc
color <- ColorOption -> IO ColorFunc
getColorFunc forall a b. (a -> b) -> a -> b
$ FormatterOptions -> ColorOption
foColorOption FormatterOptions
options
Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ ColorFunc
color String
"error" forall a b. (a -> b) -> a -> b
$ String
file forall a. [a] -> [a] -> [a]
++ 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
ColorFunc
color <- ColorOption -> IO ColorFunc
getColorFunc 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ FormatterOptions -> Integer
foWikiLinkCount FormatterOptions
options)
let fileGroups :: [[PositionedComment]]
fileGroups = forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith PositionedComment -> String
sourceFile [PositionedComment]
comments
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ColorFunc -> SystemInterface IO -> [PositionedComment] -> IO ()
outputForFile ColorFunc
color SystemInterface IO
sys) [[PositionedComment]]
fileGroups
outputForFile :: ColorFunc -> SystemInterface IO -> [PositionedComment] -> IO ()
outputForFile ColorFunc
color SystemInterface IO
sys [PositionedComment]
comments = do
let fileName :: String
fileName = PositionedComment -> String
sourceFile (forall a. [a] -> a
head [PositionedComment]
comments)
Either String String
result <- forall (m :: * -> *).
SystemInterface m
-> Maybe Bool -> String -> m (Either String String)
siReadFile SystemInterface IO
sys (forall a. a -> Maybe a
Just Bool
True) String
fileName
let contents :: String
contents = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const String
"") forall a. a -> a
id Either String String
result
let fileLinesList :: [String]
fileLinesList = String -> [String]
lines String
contents
let lineCount :: Int
lineCount = forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
fileLinesList
let fileLines :: Array Int String
fileLines = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1, Int
lineCount) [String]
fileLinesList
let groups :: [[PositionedComment]]
groups = forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith PositionedComment -> Integer
lineNo [PositionedComment]
comments
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[PositionedComment]]
groups forall a b. (a -> b) -> a -> b
$ \[PositionedComment]
commentsForLine -> do
let lineNum :: Int
lineNum = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ PositionedComment -> Integer
lineNo (forall a. [a] -> a
head [PositionedComment]
commentsForLine)
let line :: String
line = if Int
lineNum forall a. Ord a => a -> a -> Bool
< Int
1 Bool -> Bool -> Bool
|| Int
lineNum forall a. Ord a => a -> a -> Bool
> Int
lineCount
then String
""
else Array Int String
fileLines forall i e. Ix i => Array i e -> i -> e
! forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineNum
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ ColorFunc
color String
"message" forall a b. (a -> b) -> a -> b
$
String
"In " forall a. [a] -> [a] -> [a]
++ String
fileName forall a. [a] -> [a] -> [a]
++String
" line " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
lineNum forall a. [a] -> [a] -> [a]
++ String
":"
String -> IO ()
putStrLn (ColorFunc
color String
"source" String
line)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PositionedComment]
commentsForLine forall a b. (a -> b) -> a -> b
$ \PositionedComment
c -> String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ ColorFunc
color (PositionedComment -> String
severityText PositionedComment
c) forall a b. (a -> b) -> a -> b
$ PositionedComment -> String
cuteIndent PositionedComment
c
String -> IO ()
putStrLn String
""
ColorFunc
-> [PositionedComment] -> Int -> Array Int String -> IO ()
showFixedString ColorFunc
color [PositionedComment]
commentsForLine (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) =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\(Int
mm, Int
mx) Position
pos -> ((forall a. Ord a => a -> a -> a
min Int
mm forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Position -> Integer
posLine Position
pos), (forall a. Ord a => a -> a -> a
max Int
mx forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Position -> Integer
posLine Position
pos)))
(forall a. Bounded a => a
maxBound, forall a. Bounded a => a
minBound) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Replacement
x -> [Replacement -> Position
repStartPos Replacement
x, Replacement -> Position
repEndPos Replacement
x]) 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 = forall i j e.
(Ix i, Ix j) =>
(i, i) -> (i -> j) -> Array j e -> Array i e
ixmap (Int
1, Int
maxLine forall a. Num a => a -> a -> a
- Int
minLine forall a. Num a => a -> a -> a
+ Int
1) (\Int
x -> Int
x forall a. Num a => a -> a -> a
+ Int
minLine 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 forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minLine) forall a. Num a => a -> a -> a
+ Integer
1
}
showFixedString :: ColorFunc -> [PositionedComment] -> Int -> Array Int String -> IO ()
showFixedString :: ColorFunc
-> [PositionedComment] -> Int -> Array Int String -> IO ()
showFixedString ColorFunc
color [PositionedComment]
comments Int
lineNum Array Int String
fileLines =
let line :: String
line = Array Int String
fileLines forall i e. Ix i => Array i e -> i -> e
! forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lineNum in
case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PositionedComment -> Maybe Fix
pcFix [PositionedComment]
comments of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Fix]
fixes -> do
let mergedFix :: Fix
mergedFix = 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 forall a b. (a -> b) -> a -> b
$ ColorFunc
color String
"message" String
"Did you mean: "
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines 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 =
forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ PositionedComment -> Integer
colNo PositionedComment
comment forall a. Num a => a -> a -> a
- Integer
1) Char
' ' forall a. [a] -> [a] -> [a]
++
String
makeArrow forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
code (PositionedComment -> Integer
codeNo PositionedComment
comment) forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ PositionedComment -> String
severityText PositionedComment
comment forall a. [a] -> [a] -> [a]
++ String
"): " forall a. [a] -> [a] -> [a]
++ PositionedComment -> String
messageText PositionedComment
comment
where
arrow :: a -> String
arrow a
n = Char
'^' forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ a
nforall a. Num a => a -> a -> a
-a
2) Char
'-' forall a. [a] -> [a] -> [a]
++ String
"^"
makeArrow :: String
makeArrow =
let sameLine :: Bool
sameLine = PositionedComment -> Integer
lineNo PositionedComment
comment forall a. Eq a => a -> a -> Bool
== PositionedComment -> Integer
endLineNo PositionedComment
comment
delta :: Integer
delta = PositionedComment -> Integer
endColNo PositionedComment
comment forall a. Num a => a -> a -> a
- PositionedComment -> Integer
colNo PositionedComment
comment
in
if Bool
sameLine Bool -> Bool -> Bool
&& Integer
delta forall a. Ord a => a -> a -> Bool
> Integer
2 Bool -> Bool -> Bool
&& Integer
delta forall a. Ord a => a -> a -> Bool
< Integer
32 then forall {a}. Integral a => a -> String
arrow Integer
delta else String
"^--"
code :: a -> String
code a
num = String
"SC" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
num
getColorFunc :: ColorOption -> IO ColorFunc
getColorFunc :: ColorOption -> IO ColorFunc
getColorFunc ColorOption
colorOption = do
Bool
useColor <- ColorOption -> IO Bool
shouldOutputColor ColorOption
colorOption
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
useColor then ColorFunc
colorComment else forall a b. a -> b -> a
const forall a. a -> a
id
where
colorComment :: ColorFunc
colorComment String
level String
comment =
forall a. Show a => a -> String
ansi (forall {a}. Num a => String -> a
colorForLevel String
level) forall a. [a] -> [a] -> [a]
++ String
comment forall a. [a] -> [a] -> [a]
++ String
clear
clear :: String
clear = forall a. Show a => a -> String
ansi Integer
0
ansi :: a -> String
ansi a
n = String
"\x1B[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
n forall a. [a] -> [a] -> [a]
++ String
"m"