Move library into src/

This commit is contained in:
Oleg Grenrus 2018-03-08 19:57:40 +02:00
parent b33607b048
commit cd7c077ecc
18 changed files with 3 additions and 0 deletions

View file

@ -0,0 +1,95 @@
{-
Copyright 2012-2015 Vidar Holen
This file is part of ShellCheck.
https://www.shellcheck.net
ShellCheck is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
ShellCheck is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module ShellCheck.Formatter.CheckStyle (format) where
import ShellCheck.Interface
import ShellCheck.Formatter.Format
import Data.Char
import Data.List
import GHC.Exts
import System.IO
format :: IO Formatter
format = return Formatter {
header = do
putStrLn "<?xml version='1.0' encoding='UTF-8'?>"
putStrLn "<checkstyle version='4.3'>",
onFailure = outputError,
onResult = outputResults,
footer = putStrLn "</checkstyle>"
}
outputResults cr sys =
if null comments
then outputFile (crFilename cr) "" []
else mapM_ outputGroup fileGroups
where
comments = crComments cr
fileGroups = groupWith sourceFile comments
outputGroup group = do
let filename = sourceFile (head group)
result <- (siReadFile sys) filename
let contents = either (const "") id result
outputFile filename contents group
outputFile filename contents warnings = do
let comments = makeNonVirtual warnings contents
putStrLn . formatFile filename $ comments
formatFile name comments = concat [
"<file ", attr "name" name, ">\n",
concatMap formatComment comments,
"</file>"
]
formatComment c = concat [
"<error ",
attr "line" $ show . lineNo $ c,
attr "column" $ show . colNo $ c,
attr "severity" . severity $ severityText c,
attr "message" $ messageText c,
attr "source" $ "ShellCheck.SC" ++ show (codeNo c),
"/>\n"
]
outputError file error = putStrLn $ concat [
"<file ", attr "name" file, ">\n",
"<error ",
attr "line" "1",
attr "column" "1",
attr "severity" "error",
attr "message" error,
attr "source" "ShellCheck",
"/>\n",
"</file>"
]
attr s v = concat [ s, "='", escape v, "' " ]
escape = concatMap escape'
escape' c = if isOk c then [c] else "&#" ++ show (ord c) ++ ";"
isOk x = any ($x) [isAsciiUpper, isAsciiLower, isDigit, (`elem` " ./")]
severity "error" = "error"
severity "warning" = "warning"
severity _ = "info"

View file

@ -0,0 +1,67 @@
{-
Copyright 2012-2015 Vidar Holen
This file is part of ShellCheck.
https://www.shellcheck.net
ShellCheck is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
ShellCheck is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module ShellCheck.Formatter.Format where
import ShellCheck.Data
import ShellCheck.Interface
-- A formatter that carries along an arbitrary piece of data
data Formatter = Formatter {
header :: IO (),
onResult :: CheckResult -> SystemInterface IO -> IO (),
onFailure :: FilePath -> ErrorMessage -> IO (),
footer :: IO ()
}
sourceFile (PositionedComment pos _ _) = posFile pos
lineNo (PositionedComment pos _ _) = posLine pos
endLineNo (PositionedComment _ end _) = posLine end
colNo (PositionedComment pos _ _) = posColumn pos
endColNo (PositionedComment _ end _) = posColumn end
codeNo (PositionedComment _ _ (Comment _ code _)) = code
messageText (PositionedComment _ _ (Comment _ _ t)) = t
severityText :: PositionedComment -> String
severityText (PositionedComment _ _ (Comment c _ _)) =
case c of
ErrorC -> "error"
WarningC -> "warning"
InfoC -> "info"
StyleC -> "style"
-- Realign comments from a tabstop of 8 to 1
makeNonVirtual comments contents =
map fix comments
where
ls = lines contents
fix c@(PositionedComment start end comment) = PositionedComment start {
posColumn = realignColumn lineNo colNo c
} end {
posColumn = realignColumn endLineNo endColNo c
} comment
realignColumn lineNo colNo c =
if lineNo c > 0 && lineNo c <= fromIntegral (length ls)
then real (ls !! fromIntegral (lineNo c - 1)) 0 0 (colNo c)
else colNo c
real _ r v target | target <= v = r
real [] r v _ = r -- should never happen
real ('\t':rest) r v target =
real rest (r+1) (v + 8 - (v `mod` 8)) target
real (_:rest) r v target = real rest (r+1) (v+1) target

View file

@ -0,0 +1,65 @@
{-
Copyright 2012-2015 Vidar Holen
This file is part of ShellCheck.
https://www.shellcheck.net
ShellCheck is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
ShellCheck is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module ShellCheck.Formatter.GCC (format) where
import ShellCheck.Interface
import ShellCheck.Formatter.Format
import Data.List
import GHC.Exts
import System.IO
format :: IO Formatter
format = return Formatter {
header = return (),
footer = return (),
onFailure = outputError,
onResult = outputAll
}
outputError file error = hPutStrLn stderr $ file ++ ": " ++ error
outputAll cr sys = mapM_ f groups
where
comments = crComments cr
groups = groupWith sourceFile comments
f :: [PositionedComment] -> IO ()
f group = do
let filename = sourceFile (head group)
result <- (siReadFile sys) filename
let contents = either (const "") id result
outputResult filename contents group
outputResult filename contents warnings = do
let comments = makeNonVirtual warnings contents
mapM_ (putStrLn . formatComment filename) comments
formatComment filename c = concat [
filename, ":",
show $ lineNo c, ":",
show $ colNo c, ": ",
case severityText c of
"error" -> "error"
"warning" -> "warning"
_ -> "note",
": ",
concat . lines $ messageText c,
" [SC", show $ codeNo c, "]"
]

View file

@ -0,0 +1,60 @@
{-
Copyright 2012-2015 Vidar Holen
This file is part of ShellCheck.
https://www.shellcheck.net
ShellCheck is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
ShellCheck is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module ShellCheck.Formatter.JSON (format) where
import ShellCheck.Interface
import ShellCheck.Formatter.Format
import Data.IORef
import GHC.Exts
import System.IO
import Text.JSON
format = do
ref <- newIORef []
return Formatter {
header = return (),
onResult = collectResult ref,
onFailure = outputError,
footer = finish ref
}
instance JSON (PositionedComment) where
showJSON comment@(PositionedComment start end (Comment level code string)) = makeObj [
("file", showJSON $ posFile start),
("line", showJSON $ posLine start),
("endLine", showJSON $ posLine end),
("column", showJSON $ posColumn start),
("endColumn", showJSON $ posColumn end),
("level", showJSON $ severityText comment),
("code", showJSON code),
("message", showJSON string)
]
readJSON = undefined
outputError file msg = hPutStrLn stderr $ file ++ ": " ++ msg
collectResult ref result _ =
modifyIORef ref (\x -> crComments result ++ x)
finish ref = do
list <- readIORef ref
putStrLn $ encodeStrict list

View file

@ -0,0 +1,98 @@
{-
Copyright 2012-2015 Vidar Holen
This file is part of ShellCheck.
https://www.shellcheck.net
ShellCheck is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
ShellCheck is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
module ShellCheck.Formatter.TTY (format) where
import ShellCheck.Interface
import ShellCheck.Formatter.Format
import Data.List
import GHC.Exts
import System.Info
import System.IO
format :: FormatterOptions -> IO Formatter
format options = return Formatter {
header = return (),
footer = return (),
onFailure = outputError options,
onResult = outputResult options
}
colorForLevel level =
case level of
"error" -> 31 -- red
"warning" -> 33 -- yellow
"info" -> 32 -- green
"style" -> 32 -- green
"message" -> 1 -- bold
"source" -> 0 -- none
_ -> 0 -- none
outputError options file error = do
color <- getColorFunc $ foColorOption options
hPutStrLn stderr $ color "error" $ file ++ ": " ++ error
outputResult options result sys = do
color <- getColorFunc $ foColorOption options
let comments = crComments result
let fileGroups = groupWith sourceFile comments
mapM_ (outputForFile color sys) fileGroups
outputForFile color sys comments = do
let fileName = sourceFile (head comments)
result <- (siReadFile sys) fileName
let contents = either (const "") id result
let fileLines = lines contents
let lineCount = fromIntegral $ length fileLines
let groups = groupWith lineNo comments
mapM_ (\x -> do
let lineNum = lineNo (head x)
let line = if lineNum < 1 || lineNum > lineCount
then ""
else fileLines !! fromIntegral (lineNum - 1)
putStrLn ""
putStrLn $ color "message" $
"In " ++ fileName ++" line " ++ show lineNum ++ ":"
putStrLn (color "source" line)
mapM_ (\c -> putStrLn (color (severityText c) $ cuteIndent c)) x
putStrLn ""
) groups
cuteIndent :: PositionedComment -> String
cuteIndent comment =
replicate (fromIntegral $ colNo comment - 1) ' ' ++
"^-- " ++ code (codeNo comment) ++ ": " ++ messageText comment
code code = "SC" ++ show code
getColorFunc colorOption = do
term <- hIsTerminalDevice stdout
let windows = "mingw" `isPrefixOf` os
let isUsableTty = term && not windows
let useColor = case colorOption of
ColorAlways -> True
ColorNever -> False
ColorAuto -> isUsableTty
return $ if useColor then colorComment else const id
where
colorComment level comment =
ansi (colorForLevel level) ++ comment ++ clear
clear = ansi 0
ansi n = "\x1B[" ++ show n ++ "m"