{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hadolint.Formatter.Checkstyle
( printResult,
formatResult,
)
where
import qualified Data.ByteString.Builder as Builder
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Foldable (toList)
import Data.List (groupBy)
import Data.Monoid (mconcat, (<>))
import qualified Data.Text as Text
import Hadolint.Formatter.Format
import Hadolint.Rules (Metadata (..), RuleCheck (..))
import ShellCheck.Interface
import Text.Megaparsec (Stream)
import Text.Megaparsec.Error
import Text.Megaparsec.Pos (sourceColumn, sourceLine, sourceName, unPos)
data CheckStyle = CheckStyle
{ file :: String,
line :: Int,
column :: Int,
impact :: String,
msg :: String,
source :: String
}
errorToCheckStyle :: (Stream s, ShowErrorComponent e) => ParseErrorBundle s e -> CheckStyle
errorToCheckStyle err =
CheckStyle
{ file = sourceName pos,
line = unPos (sourceLine pos),
column = unPos (sourceColumn pos),
impact = severityText ErrorC,
msg = errorBundlePretty err,
source = "DL1000"
}
where
pos = errorPosition err
ruleToCheckStyle :: RuleCheck -> CheckStyle
ruleToCheckStyle RuleCheck {..} =
CheckStyle
{ file = Text.unpack filename,
line = linenumber,
column = 1,
impact = severityText (severity metadata),
msg = Text.unpack (message metadata),
source = Text.unpack (code metadata)
}
toXml :: [CheckStyle] -> Builder.Builder
toXml checks = wrap fileName (foldMap convert checks)
where
wrap name innerNode = " attr "name" name <> ">" <> innerNode <> ""
convert CheckStyle {..} =
" attr "line" (show line) -- Beging the node construction
<> attr "column" (show column)
<> attr "severity" impact
<> attr "message" msg
<> attr "source" source
<> "/>"
fileName =
case checks of
[] -> ""
h : _ -> file h
attr :: String -> String -> Builder.Builder
attr name value = Builder.string8 name <> "='" <> Builder.string8 (escape value) <> "' "
escape :: String -> String
escape = concatMap doEscape
where
doEscape c =
if isOk c
then [c]
else "" ++ show (ord c) ++ ";"
isOk x = any (\check -> check x) [isAsciiUpper, isAsciiLower, isDigit, (`elem` [' ', '.', '/'])]
formatResult :: (Stream s, ShowErrorComponent e) => Result s e -> Builder.Builder
formatResult (Result errors checks) =
"" <> xmlBody <> ""
where
xmlBody = mconcat xmlChunks
xmlChunks = fmap toXml (groupBy sameFileName flatten)
flatten = toList $ checkstyleErrors <> checkstyleChecks
checkstyleErrors = fmap errorToCheckStyle errors
checkstyleChecks = fmap ruleToCheckStyle checks
sameFileName CheckStyle {file = f1} CheckStyle {file = f2} = f1 == f2
printResult :: (Stream s, ShowErrorComponent e) => Result s e -> IO ()
printResult result = B.putStr (Builder.toLazyByteString (formatResult result))