{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Hadolint.Formatter.Codacy ( printResult, formatResult, ) where import Data.Aeson hiding (Result) import qualified Data.ByteString.Lazy.Char8 as B import Data.Monoid ((<>)) import Data.Sequence (Seq) import qualified Data.Text as Text import Hadolint.Formatter.Format (Result (..), errorPosition) import Hadolint.Rules (Metadata (..), RuleCheck (..)) import Text.Megaparsec (TraversableStream) import Text.Megaparsec.Error import Text.Megaparsec.Pos (sourceLine, sourceName, unPos) import Text.Megaparsec.Stream (VisualStream) data Issue = Issue { Issue -> String filename :: String, Issue -> String msg :: String, Issue -> String patternId :: String, Issue -> Int line :: Int } instance ToJSON Issue where toJSON :: Issue -> Value toJSON Issue {Int String line :: Int patternId :: String msg :: String filename :: String line :: Issue -> Int patternId :: Issue -> String msg :: Issue -> String filename :: Issue -> String ..} = [Pair] -> Value object [Text "filename" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String filename, Text "patternId" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String patternId, Text "message" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String msg, Text "line" Text -> Int -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 :: String -> String -> String -> Int -> Issue Issue { filename :: String filename = SourcePos -> String sourceName SourcePos pos, patternId :: String patternId = String "DL1000", 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, 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 :: RuleCheck -> Issue checkToIssue :: RuleCheck -> Issue checkToIssue RuleCheck {Bool Int Text Metadata success :: RuleCheck -> Bool linenumber :: RuleCheck -> Int filename :: RuleCheck -> Text metadata :: RuleCheck -> Metadata success :: Bool linenumber :: Int filename :: Text metadata :: Metadata ..} = Issue :: String -> String -> String -> Int -> Issue Issue { filename :: String filename = Text -> String Text.unpack Text filename, patternId :: String patternId = Text -> String Text.unpack (Metadata -> Text code Metadata metadata), msg :: String msg = Text -> String Text.unpack (Metadata -> Text message Metadata metadata), line :: Int line = Int linenumber } formatResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Seq Issue formatResult :: Result s e -> Seq Issue formatResult (Result Seq (ParseErrorBundle s e) errors Seq RuleCheck 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 = (RuleCheck -> Issue) -> Seq RuleCheck -> Seq Issue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap RuleCheck -> Issue checkToIssue Seq RuleCheck checks printResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> IO () printResult :: Result s e -> IO () printResult Result s e result = (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 (Result s e -> Seq Issue forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Seq Issue formatResult Result s e result) where output :: a -> IO () output a value = ByteString -> IO () B.putStrLn (a -> ByteString forall a. ToJSON a => a -> ByteString encode a value)