module Hadolint.Formatter.Checkstyle ( printResults )
where

import qualified Data.ByteString.Lazy.Char8 as B
import Data.Foldable
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import Hadolint.Formatter.Format
  ( Result (..),
    errorBundlePretty,
    errorPosition,
    severityText,
  )
import Hadolint.Rule (CheckFailure (..), DLSeverity (..), RuleCode (..))
import Text.Megaparsec (TraversableStream)
import Text.Megaparsec.Error
  ( ParseErrorBundle,
    ShowErrorComponent,
  )
import Text.Megaparsec.Pos (sourceColumn, sourceLine, unPos)
import Text.Megaparsec.Stream (VisualStream)
import qualified Text.XML as XML

errorToNode ::
  (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
  ParseErrorBundle s e -> XML.Node
errorToNode :: forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> Node
errorToNode ParseErrorBundle s e
err =
  Element -> Node
XML.NodeElement XML.Element
    { elementName :: Name
elementName = Name
"error",
      elementAttributes :: Map Name Text
elementAttributes =
        [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (Name
"line", String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Linenumber -> String
forall a. Show a => a -> String
show (Linenumber -> String) -> Linenumber -> String
forall a b. (a -> b) -> a -> b
$ Pos -> Linenumber
unPos (Pos -> Linenumber) -> Pos -> Linenumber
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine (SourcePos -> Pos) -> SourcePos -> Pos
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle s e -> SourcePos
forall s e.
TraversableStream s =>
ParseErrorBundle s e -> SourcePos
errorPosition ParseErrorBundle s e
err),
            (Name
"column", String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Linenumber -> String
forall a. Show a => a -> String
show (Linenumber -> String) -> Linenumber -> String
forall a b. (a -> b) -> a -> b
$ Pos -> Linenumber
unPos (Pos -> Linenumber) -> Pos -> Linenumber
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceColumn (SourcePos -> Pos) -> SourcePos -> Pos
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle s e -> SourcePos
forall s e.
TraversableStream s =>
ParseErrorBundle s e -> SourcePos
errorPosition ParseErrorBundle s e
err),
            (Name
"severity", DLSeverity -> Text
severityText DLSeverity
DLErrorC),
            (Name
"message", String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle s e -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle s e
err)
          ],
      elementNodes :: [Node]
elementNodes = []
    }

checkToNode :: CheckFailure -> XML.Node
checkToNode :: CheckFailure -> Node
checkToNode CheckFailure {Linenumber
Text
RuleCode
DLSeverity
code :: RuleCode
severity :: DLSeverity
message :: Text
line :: Linenumber
line :: CheckFailure -> Linenumber
message :: CheckFailure -> Text
severity :: CheckFailure -> DLSeverity
code :: CheckFailure -> RuleCode
..} =
  Element -> Node
XML.NodeElement XML.Element
    { elementName :: Name
elementName = Name
"error",
      elementAttributes :: Map Name Text
elementAttributes =
        [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
          [ (Name
"line", String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Linenumber -> String
forall a. Show a => a -> String
show Linenumber
line),
            (Name
"column", Text
"1"),
            (Name
"severity", DLSeverity -> Text
severityText DLSeverity
severity),
            (Name
"message", Text
message),
            (Name
"source", RuleCode -> Text
unRuleCode RuleCode
code)
          ],
      elementNodes :: [Node]
elementNodes = []
    }

renderNodes ::
  (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
  Result s e -> [XML.Node]
renderNodes :: forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> [Node]
renderNodes (Result Text
_ Seq (ParseErrorBundle s e)
errors Failures
checks) =
  if Bool
isEmpty then [] else Seq Node -> [Node]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ( Seq Node
errorNodes Seq Node -> Seq Node -> Seq Node
forall a. Semigroup a => a -> a -> a
<> Seq Node
checkNodes )
  where
    errorNodes :: Seq Node
errorNodes = (ParseErrorBundle s e -> Node)
-> Seq (ParseErrorBundle s e) -> Seq Node
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseErrorBundle s e -> Node
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> Node
errorToNode Seq (ParseErrorBundle s e)
errors
    checkNodes :: Seq Node
checkNodes = (CheckFailure -> Node) -> Failures -> Seq Node
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CheckFailure -> Node
checkToNode Failures
checks
    isEmpty :: Bool
isEmpty = Failures -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Failures
checks Bool -> Bool -> Bool
&& Seq (ParseErrorBundle s e) -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (ParseErrorBundle s e)
errors

toFile ::
  (VisualStream s, TraversableStream s, ShowErrorComponent e) =>
  Result s e -> Maybe FilePath -> XML.Node
toFile :: forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> Maybe String -> Node
toFile Result s e
results Maybe String
filePathInReport =
  Element -> Node
XML.NodeElement XML.Element
    { elementName :: Name
elementName = Name
"file",
      elementAttributes :: Map Name Text
elementAttributes = [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name
"name", Text
filepath)],
      elementNodes :: [Node]
elementNodes = Result s e -> [Node]
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> [Node]
renderNodes Result s e
results
    }
  where
    filepath :: Text
filepath = if Maybe String -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe String
filePathInReport then Result s e -> Text
forall {s} {e}. Result s e -> Text
filename Result s e
results else Maybe String -> Text
getFilePath Maybe String
filePathInReport
    filename :: Result s e -> Text
filename Result {fileName :: forall {s} {e}. Result s e -> Text
fileName=Text
fn} = Text
fn

renderResults ::
  (Foldable f, VisualStream s, TraversableStream s, ShowErrorComponent e) =>
  f (Result s e) -> Maybe FilePath -> XML.Element
renderResults :: forall (f :: * -> *) s e.
(Foldable f, VisualStream s, TraversableStream s,
 ShowErrorComponent e) =>
f (Result s e) -> Maybe String -> Element
renderResults f (Result s e)
results Maybe String
filePathInReport = XML.Element
  { elementName :: Name
elementName = Name
"checkstyle",
    elementAttributes :: Map Name Text
elementAttributes = [(Name, Text)] -> Map Name Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name
"version", Text
"4.3")],
    elementNodes :: [Node]
elementNodes = (Result s e -> Maybe Node) -> [Result s e] -> [Node]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe Result s e -> Maybe Node
forall {s} {e}.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> Maybe Node
maybeFile ( f (Result s e) -> [Result s e]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f (Result s e)
results )
  }
  where
    maybeFile :: Result s e -> Maybe Node
maybeFile Result s e
r = if Result s e -> Bool
forall {s} {e}. Result s e -> Bool
isEmpty Result s e
r then Maybe Node
forall a. Maybe a
Nothing else Node -> Maybe Node
forall a. a -> Maybe a
Just (Node -> Maybe Node) -> Node -> Maybe Node
forall a b. (a -> b) -> a -> b
$ Result s e -> Maybe String -> Node
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> Maybe String -> Node
toFile Result s e
r Maybe String
filePathInReport
    isEmpty :: Result s e -> Bool
isEmpty Result {errors :: forall s e. Result s e -> Seq (ParseErrorBundle s e)
errors=Seq (ParseErrorBundle s e)
e, checks :: forall s e. Result s e -> Failures
checks=Failures
c} = Seq (ParseErrorBundle s e) -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq (ParseErrorBundle s e)
e Bool -> Bool -> Bool
&& Failures -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Failures
c

printResults ::
  (Foldable f, VisualStream s, TraversableStream s, ShowErrorComponent e) =>
  f (Result s e) -> Maybe FilePath -> IO ()
printResults :: forall (f :: * -> *) s e.
(Foldable f, VisualStream s, TraversableStream s,
 ShowErrorComponent e) =>
f (Result s e) -> Maybe String -> IO ()
printResults f (Result s e)
results Maybe String
filePathInReport =
  ByteString -> IO ()
B.putStr (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ RenderSettings -> Document -> ByteString
XML.renderLBS RenderSettings
settings Document
document
  where
    settings :: RenderSettings
settings = RenderSettings
forall a. Default a => a
XML.def -- use default render settings
    document :: Document
document =
      XML.Document
        { documentPrologue :: Prologue
documentPrologue = [Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
XML.Prologue [] Maybe Doctype
forall a. Maybe a
Nothing [],
          documentRoot :: Element
documentRoot = f (Result s e) -> Maybe String -> Element
forall (f :: * -> *) s e.
(Foldable f, VisualStream s, TraversableStream s,
 ShowErrorComponent e) =>
f (Result s e) -> Maybe String -> Element
renderResults f (Result s e)
results Maybe String
filePathInReport,
          documentEpilogue :: [Miscellaneous]
documentEpilogue = []
        }

getFilePath :: Maybe FilePath -> Text.Text
getFilePath :: Maybe String -> Text
getFilePath Maybe String
Nothing = Text
""
getFilePath (Just String
filePath) = [String] -> Text
toText [String
filePath]

toText :: [FilePath] -> Text.Text
toText :: [String] -> Text
toText = (String -> Text) -> [String] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap String -> Text
Text.pack