{-
    Copyright 2012-2019 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 :: IO Formatter
format = forall (m :: * -> *) a. Monad m => a -> m a
return Formatter {
    header :: IO ()
header = do
        String -> IO ()
putStrLn String
"<?xml version='1.0' encoding='UTF-8'?>"
        String -> IO ()
putStrLn String
"<checkstyle version='4.3'>",

    onFailure :: String -> String -> IO ()
onFailure = String -> String -> IO ()
outputError,
    onResult :: CheckResult -> SystemInterface IO -> IO ()
onResult = CheckResult -> SystemInterface IO -> IO ()
outputResults,

    footer :: IO ()
footer = String -> IO ()
putStrLn String
"</checkstyle>"
}

outputResults :: CheckResult -> SystemInterface IO -> IO ()
outputResults CheckResult
cr SystemInterface IO
sys =
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PositionedComment]
comments
    then String -> String -> [PositionedComment] -> IO ()
outputFile (CheckResult -> String
crFilename CheckResult
cr) String
"" []
    else forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [PositionedComment] -> IO ()
outputGroup [[PositionedComment]]
fileGroups
  where
    comments :: [PositionedComment]
comments = CheckResult -> [PositionedComment]
crComments CheckResult
cr
    fileGroups :: [[PositionedComment]]
fileGroups = forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupWith PositionedComment -> String
sourceFile [PositionedComment]
comments
    outputGroup :: [PositionedComment] -> IO ()
outputGroup [PositionedComment]
group = do
        let filename :: String
filename = PositionedComment -> String
sourceFile (forall a. [a] -> a
head [PositionedComment]
group)
        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
        String -> String -> [PositionedComment] -> IO ()
outputFile String
filename String
contents [PositionedComment]
group

outputFile :: String -> String -> [PositionedComment] -> IO ()
outputFile String
filename String
contents [PositionedComment]
warnings = do
    let comments :: [PositionedComment]
comments = [PositionedComment] -> String -> [PositionedComment]
makeNonVirtual [PositionedComment]
warnings String
contents
    String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}.
Foldable t =>
String -> t PositionedComment -> String
formatFile String
filename forall a b. (a -> b) -> a -> b
$ [PositionedComment]
comments

formatFile :: String -> t PositionedComment -> String
formatFile String
name t PositionedComment
comments = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
    String
"<file ", String -> String -> String
attr String
"name" String
name, String
">\n",
        forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PositionedComment -> String
formatComment t PositionedComment
comments,
    String
"</file>"
    ]

formatComment :: PositionedComment -> String
formatComment PositionedComment
c = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
    String
"<error ",
    String -> String -> String
attr String
"line" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionedComment -> Integer
lineNo forall a b. (a -> b) -> a -> b
$ PositionedComment
c,
    String -> String -> String
attr String
"column" forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionedComment -> Integer
colNo forall a b. (a -> b) -> a -> b
$ PositionedComment
c,
    String -> String -> String
attr String
"severity" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
severity forall a b. (a -> b) -> a -> b
$ PositionedComment -> String
severityText PositionedComment
c,
    String -> String -> String
attr String
"message" forall a b. (a -> b) -> a -> b
$ PositionedComment -> String
messageText PositionedComment
c,
    String -> String -> String
attr String
"source" forall a b. (a -> b) -> a -> b
$ String
"ShellCheck.SC" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (PositionedComment -> Integer
codeNo PositionedComment
c),
    String
"/>\n"
    ]

outputError :: String -> String -> IO ()
outputError String
file String
error = String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
    String
"<file ", String -> String -> String
attr String
"name" String
file, String
">\n",
    String
"<error ",
        String -> String -> String
attr String
"line" String
"1",
        String -> String -> String
attr String
"column" String
"1",
        String -> String -> String
attr String
"severity" String
"error",
        String -> String -> String
attr String
"message" String
error,
        String -> String -> String
attr String
"source" String
"ShellCheck",
    String
"/>\n",
    String
"</file>"
    ]


attr :: String -> String -> String
attr String
s String
v = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
s, String
"='", String -> String
escape String
v, String
"' " ]
escape :: String -> String
escape = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escape'
escape' :: Char -> String
escape' Char
c = if Char -> Bool
isOk Char
c then [Char
c] else String
"&#" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Char -> Int
ord Char
c) forall a. [a] -> [a] -> [a]
++ String
";"
isOk :: Char -> Bool
isOk Char
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b. (a -> b) -> a -> b
$ Char
x) [Char -> Bool
isAsciiUpper, Char -> Bool
isAsciiLower, Char -> Bool
isDigit, (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
" ./")]

severity :: String -> String
severity String
"error" = String
"error"
severity String
"warning" = String
"warning"
severity String
_ = String
"info"