{-# 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 (TraversableStream)
import Text.Megaparsec.Error
import Text.Megaparsec.Pos (sourceColumn, sourceLine, sourceName, unPos)
import Text.Megaparsec.Stream (VisualStream)

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 :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> CheckStyle
errorToCheckStyle :: ParseErrorBundle s e -> CheckStyle
errorToCheckStyle 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.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle s e
err,
      source :: String
source = String
"DL1000"
    }
  where
    pos :: SourcePos
pos = ParseErrorBundle s e -> SourcePos
forall s e.
TraversableStream s =>
ParseErrorBundle s e -> SourcePos
errorPosition ParseErrorBundle s e
err

ruleToCheckStyle :: RuleCheck -> CheckStyle
ruleToCheckStyle :: RuleCheck -> CheckStyle
ruleToCheckStyle RuleCheck {Bool
Int
Filename
Metadata
success :: RuleCheck -> Bool
linenumber :: RuleCheck -> Int
filename :: RuleCheck -> Filename
metadata :: RuleCheck -> Metadata
success :: Bool
linenumber :: Int
filename :: Filename
metadata :: Metadata
..} =
  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 = Int
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 [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 String
name Builder
innerNode = Builder
"<file " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> String -> Builder
attr String
"name" String
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
innerNode Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"</file>"
    convert :: CheckStyle -> Builder
convert CheckStyle {Int
String
source :: String
msg :: String
impact :: String
column :: Int
line :: Int
file :: String
source :: CheckStyle -> String
msg :: CheckStyle -> String
impact :: CheckStyle -> String
column :: CheckStyle -> Int
line :: CheckStyle -> Int
file :: CheckStyle -> String
..} =
      Builder
"<error "
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> String -> Builder
attr String
"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 String
"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 String
"severity" String
impact
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> String -> Builder
attr String
"message" String
msg
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> String -> Builder
attr String
"source" String
source
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"/>"
    fileName :: String
fileName =
      case [CheckStyle]
checks of
        [] -> String
""
        CheckStyle
h : [CheckStyle]
_ -> CheckStyle -> String
file CheckStyle
h

attr :: String -> String -> Builder.Builder
attr :: String -> String -> Builder
attr String
name String
value = String -> Builder
Builder.string8 String
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"='" 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
<> Builder
"' "

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 Char
c =
      if Char -> Bool
isOk Char
c
        then [Char
c]
        else String
"&#" 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]
++ String
";"
    isOk :: Char -> Bool
isOk Char
x = ((Char -> Bool) -> Bool) -> [Char -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\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` [Char
' ', Char
'.', Char
'/'])]

formatResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Builder.Builder
formatResult :: Result s e -> Builder
formatResult (Result Seq (ParseErrorBundle s e)
errors Seq RuleCheck
checks) =
  Builder
"<?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
<> Builder
"</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.
(VisualStream s, TraversableStream 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 :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> IO ()
printResult :: Result s e -> IO ()
printResult Result s e
result = ByteString -> IO ()
B.putStr (Builder -> ByteString
Builder.toLazyByteString (Result s e -> Builder
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> Builder
formatResult Result s e
result))