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" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Text filename, Key "patternId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Text patternId, Key "message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Text msg, Key "line" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Int line] errorToIssue :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue errorToIssue :: forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue errorToIssue ParseErrorBundle s e err = Issue { filename :: Text filename = String -> Text Text.pack forall a b. (a -> b) -> a -> b $ SourcePos -> String sourceName SourcePos pos, patternId :: Text patternId = Text "DL1000", msg :: Text msg = String -> Text Text.pack forall a b. (a -> b) -> a -> b $ 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 = 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 { 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 :: forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => 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 forall a. Semigroup a => a -> a -> a <> Seq Issue checkMessages errorMessages :: Seq Issue errorMessages = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue errorToIssue Seq (ParseErrorBundle s e) errors checkMessages :: Seq Issue checkMessages = 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 :: forall (f :: * -> *) s e. (Foldable f, VisualStream s, TraversableStream s, ShowErrorComponent e) => f (Result s e) -> IO () printResults f (Result s e) results = forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ forall {a}. ToJSON a => a -> IO () output Seq Issue flattened where flattened :: Seq Issue flattened = forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b Foldl.fold (forall a b r. (a -> b) -> Fold b r -> Fold a r Foldl.premap forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Seq Issue formatResult forall a. Monoid a => Fold a a Foldl.mconcat) f (Result s e) results output :: a -> IO () output a value = ByteString -> IO () B.putStrLn (forall a. ToJSON a => a -> ByteString encode a value)