module Hadolint.Formatter.Codacy ( printResults, formatResult, ) where import qualified Control.Foldl as Foldl import Data.Aeson hiding (Result) import qualified Data.ByteString.Lazy.Char8 as B import Data.Sequence (Seq) import qualified Data.Text as Text import Hadolint.Formatter.Format (Result (..), errorPosition) import Hadolint.Rule (CheckFailure (..), RuleCode (..)) import Text.Megaparsec (TraversableStream) import Text.Megaparsec.Error import Text.Megaparsec.Pos (sourceLine, sourceName, unPos) import Text.Megaparsec.Stream (VisualStream) data Issue = Issue { Issue -> Text filename :: Text.Text, Issue -> Text msg :: Text.Text, Issue -> Text patternId :: Text.Text, Issue -> Int line :: Int } instance ToJSON Issue where toJSON :: Issue -> Value toJSON Issue {Int Text line :: Int patternId :: Text msg :: Text filename :: Text line :: Issue -> Int patternId :: Issue -> Text msg :: Issue -> Text filename :: Issue -> Text ..} = [Pair] -> Value object [Key "filename" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Text filename, Key "patternId" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Text patternId, Key "message" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Text msg, Key "line" Key -> Int -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Int line] errorToIssue :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue errorToIssue :: ParseErrorBundle s e -> Issue errorToIssue ParseErrorBundle s e err = Issue :: Text -> Text -> Text -> Int -> Issue Issue { filename :: Text filename = String -> Text Text.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ SourcePos -> String sourceName SourcePos pos, patternId :: Text patternId = Text "DL1000", msg :: Text msg = 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, line :: Int line = Int linenumber } where pos :: SourcePos pos = ParseErrorBundle s e -> SourcePos forall s e. TraversableStream s => ParseErrorBundle s e -> SourcePos errorPosition ParseErrorBundle s e err linenumber :: Int linenumber = Pos -> Int unPos (SourcePos -> Pos sourceLine SourcePos pos) checkToIssue :: Text.Text -> CheckFailure -> Issue checkToIssue :: Text -> CheckFailure -> Issue checkToIssue Text filename CheckFailure {Int Text RuleCode DLSeverity line :: CheckFailure -> Int message :: CheckFailure -> Text severity :: CheckFailure -> DLSeverity code :: CheckFailure -> RuleCode line :: Int message :: Text severity :: DLSeverity code :: RuleCode ..} = Issue :: Text -> Text -> Text -> Int -> Issue Issue { filename :: Text filename = Text filename, patternId :: Text patternId = RuleCode -> Text unRuleCode RuleCode code, msg :: Text msg = Text message, line :: Int line = Int line } formatResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Seq Issue formatResult :: Result s e -> Seq Issue formatResult (Result Text filename Seq (ParseErrorBundle s e) errors Failures checks) = Seq Issue allIssues where allIssues :: Seq Issue allIssues = Seq Issue errorMessages Seq Issue -> Seq Issue -> Seq Issue forall a. Semigroup a => a -> a -> a <> Seq Issue checkMessages errorMessages :: Seq Issue errorMessages = (ParseErrorBundle s e -> Issue) -> Seq (ParseErrorBundle s e) -> Seq Issue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ParseErrorBundle s e -> Issue forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue errorToIssue Seq (ParseErrorBundle s e) errors checkMessages :: Seq Issue checkMessages = (CheckFailure -> Issue) -> Failures -> Seq Issue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text -> CheckFailure -> Issue checkToIssue Text filename) Failures checks printResults :: (Foldable f, VisualStream s, TraversableStream s, ShowErrorComponent e) => f (Result s e) -> IO () printResults :: f (Result s e) -> IO () printResults f (Result s e) results = (Issue -> IO ()) -> Seq Issue -> IO () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ Issue -> IO () forall a. ToJSON a => a -> IO () output Seq Issue flattened where flattened :: Seq Issue flattened = Fold (Result s e) (Seq Issue) -> f (Result s e) -> Seq Issue forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b Foldl.fold ((Result s e -> Seq Issue) -> Fold (Seq Issue) (Seq Issue) -> Fold (Result s e) (Seq Issue) forall a b r. (a -> b) -> Fold b r -> Fold a r Foldl.premap Result s e -> Seq Issue forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Seq Issue formatResult Fold (Seq Issue) (Seq Issue) forall a. Monoid a => Fold a a Foldl.mconcat) f (Result s e) results output :: a -> IO () output a value = ByteString -> IO () B.putStrLn (a -> ByteString forall a. ToJSON a => a -> ByteString encode a value)