{-# 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
  { CheckStyle -> String
file :: String,
    CheckStyle -> Int
line :: Int,
    CheckStyle -> Int
column :: Int,
    CheckStyle -> String
impact :: String,
    CheckStyle -> String
msg :: String,
    CheckStyle -> String
source :: String
  }

errorToCheckStyle :: (Stream s, ShowErrorComponent e) => ParseErrorBundle s e -> CheckStyle
errorToCheckStyle :: ParseErrorBundle s e -> CheckStyle
errorToCheckStyle err :: ParseErrorBundle s e
err =
  CheckStyle :: String -> Int -> Int -> String -> String -> String -> CheckStyle
CheckStyle
    { file :: String
file = SourcePos -> String
sourceName SourcePos
pos,
      line :: Int
line = Pos -> Int
unPos (SourcePos -> Pos
sourceLine SourcePos
pos),
      column :: Int
column = Pos -> Int
unPos (SourcePos -> Pos
sourceColumn SourcePos
pos),
      impact :: String
impact = Severity -> String
severityText Severity
ErrorC,
      msg :: String
msg = ParseErrorBundle s e -> String
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle s e
err,
      source :: String
source = "DL1000"
    }
  where
    pos :: SourcePos
pos = ParseErrorBundle s e -> SourcePos
forall s e. Stream s => ParseErrorBundle s e -> SourcePos
errorPosition ParseErrorBundle s e
err

ruleToCheckStyle :: RuleCheck -> CheckStyle
ruleToCheckStyle :: RuleCheck -> CheckStyle
ruleToCheckStyle RuleCheck {..} =
  CheckStyle :: String -> Int -> Int -> String -> String -> String -> CheckStyle
CheckStyle
    { file :: String
file = Filename -> String
Text.unpack Filename
filename,
      line :: Int
line = Int
linenumber,
      column :: Int
column = 1,
      impact :: String
impact = Severity -> String
severityText (Metadata -> Severity
severity Metadata
metadata),
      msg :: String
msg = Filename -> String
Text.unpack (Metadata -> Filename
message Metadata
metadata),
      source :: String
source = Filename -> String
Text.unpack (Metadata -> Filename
code Metadata
metadata)
    }

toXml :: [CheckStyle] -> Builder.Builder
toXml :: [CheckStyle] -> Builder
toXml checks :: [CheckStyle]
checks = String -> Builder -> Builder
wrap String
fileName ((CheckStyle -> Builder) -> [CheckStyle] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap CheckStyle -> Builder
convert [CheckStyle]
checks)
  where
    wrap :: String -> Builder -> Builder
wrap name :: String
name innerNode :: Builder
innerNode = "<file " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> String -> Builder
attr "name" String
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ">" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
innerNode Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "</file>"
    convert :: CheckStyle -> Builder
convert CheckStyle {..} =
      "<error "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> String -> Builder
attr "line" (Int -> String
forall a. Show a => a -> String
show Int
line) -- Beging the node construction
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> String -> Builder
attr "column" (Int -> String
forall a. Show a => a -> String
show Int
column)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> String -> Builder
attr "severity" String
impact
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> String -> Builder
attr "message" String
msg
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> String -> Builder
attr "source" String
source
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "/>"
    fileName :: String
fileName =
      case [CheckStyle]
checks of
        [] -> ""
        h :: CheckStyle
h : _ -> CheckStyle -> String
file CheckStyle
h

attr :: String -> String -> Builder.Builder
attr :: String -> String -> Builder
attr name :: String
name value :: String
value = String -> Builder
Builder.string8 String
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "='" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
Builder.string8 (String -> String
escape String
value) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "' "

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

formatResult :: (Stream s, ShowErrorComponent e) => Result s e -> Builder.Builder
formatResult :: Result s e -> Builder
formatResult (Result errors :: Seq (ParseErrorBundle s e)
errors checks :: Seq RuleCheck
checks) =
  "<?xml version='1.0' encoding='UTF-8'?><checkstyle version='4.3'>" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
xmlBody Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> "</checkstyle>"
  where
    xmlBody :: Builder
xmlBody = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
xmlChunks
    xmlChunks :: [Builder]
xmlChunks = ([CheckStyle] -> Builder) -> [[CheckStyle]] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [CheckStyle] -> Builder
toXml ((CheckStyle -> CheckStyle -> Bool)
-> [CheckStyle] -> [[CheckStyle]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy CheckStyle -> CheckStyle -> Bool
sameFileName [CheckStyle]
flatten)
    flatten :: [CheckStyle]
flatten = Seq CheckStyle -> [CheckStyle]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq CheckStyle -> [CheckStyle]) -> Seq CheckStyle -> [CheckStyle]
forall a b. (a -> b) -> a -> b
$ Seq CheckStyle
checkstyleErrors Seq CheckStyle -> Seq CheckStyle -> Seq CheckStyle
forall a. Semigroup a => a -> a -> a
<> Seq CheckStyle
checkstyleChecks
    checkstyleErrors :: Seq CheckStyle
checkstyleErrors = (ParseErrorBundle s e -> CheckStyle)
-> Seq (ParseErrorBundle s e) -> Seq CheckStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseErrorBundle s e -> CheckStyle
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> CheckStyle
errorToCheckStyle Seq (ParseErrorBundle s e)
errors
    checkstyleChecks :: Seq CheckStyle
checkstyleChecks = (RuleCheck -> CheckStyle) -> Seq RuleCheck -> Seq CheckStyle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RuleCheck -> CheckStyle
ruleToCheckStyle Seq RuleCheck
checks
    sameFileName :: CheckStyle -> CheckStyle -> Bool
sameFileName CheckStyle {file :: CheckStyle -> String
file = String
f1} CheckStyle {file :: CheckStyle -> String
file = String
f2} = String
f1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
f2

printResult :: (Stream s, ShowErrorComponent e) => Result s e -> IO ()
printResult :: Result s e -> IO ()
printResult result :: Result s e
result = ByteString -> IO ()
B.putStr (Builder -> ByteString
Builder.toLazyByteString (Result s e -> Builder
forall s e.
(Stream s, ShowErrorComponent e) =>
Result s e -> Builder
formatResult Result s e
result))