module Hadolint.Formatter.Json ( 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, severityText) import Hadolint.Rule (CheckFailure (..), DLSeverity (..), unRuleCode) import Text.Megaparsec (TraversableStream) import Text.Megaparsec.Error import Text.Megaparsec.Pos (sourceColumn, sourceLine, sourceName, unPos) import Text.Megaparsec.Stream (VisualStream) data JsonFormat s e = JsonCheck Text.Text CheckFailure | JsonParseError (ParseErrorBundle s e) instance (VisualStream s, TraversableStream s, ShowErrorComponent e) => ToJSON (JsonFormat s e) where toJSON :: JsonFormat s e -> Value toJSON (JsonCheck Text filename CheckFailure {Linenumber Text RuleCode DLSeverity line :: CheckFailure -> Linenumber message :: CheckFailure -> Text severity :: CheckFailure -> DLSeverity code :: CheckFailure -> RuleCode line :: Linenumber message :: Text severity :: DLSeverity code :: RuleCode ..}) = [Pair] -> Value object [ Text "file" Text -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Text filename, Text "line" Text -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Linenumber line, Text "column" Text -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= (Linenumber 1 :: Int), Text "level" Text -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= DLSeverity -> Text severityText DLSeverity severity, Text "code" Text -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= RuleCode -> Text unRuleCode RuleCode code, Text "message" Text -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Text message ] toJSON (JsonParseError ParseErrorBundle s e err) = [Pair] -> Value object [ Text "file" Text -> FilePath -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= SourcePos -> FilePath sourceName SourcePos pos, Text "line" Text -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Pos -> Linenumber unPos (SourcePos -> Pos sourceLine SourcePos pos), Text "column" Text -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Pos -> Linenumber unPos (SourcePos -> Pos sourceColumn SourcePos pos), Text "level" Text -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= DLSeverity -> Text severityText DLSeverity DLErrorC, Text "code" Text -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= (Text "DL1000" :: Text.Text), Text "message" Text -> FilePath -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= ParseErrorBundle s e -> FilePath forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> FilePath errorBundlePretty ParseErrorBundle s e err ] where pos :: SourcePos pos = ParseErrorBundle s e -> SourcePos forall s e. TraversableStream s => ParseErrorBundle s e -> SourcePos errorPosition ParseErrorBundle s e err printResults :: (VisualStream s, TraversableStream s, ShowErrorComponent e, Foldable f) => f (Result s e) -> IO () printResults :: f (Result s e) -> IO () printResults f (Result s e) results = ByteString -> IO () B.putStr (ByteString -> IO ()) -> (Seq (JsonFormat s e) -> ByteString) -> Seq (JsonFormat s e) -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . Seq (JsonFormat s e) -> ByteString forall a. ToJSON a => a -> ByteString encode (Seq (JsonFormat s e) -> IO ()) -> Seq (JsonFormat s e) -> IO () forall a b. (a -> b) -> a -> b $ Seq (JsonFormat s e) flattened where flattened :: Seq (JsonFormat s e) flattened = Fold (Result s e) (Seq (JsonFormat s e)) -> f (Result s e) -> Seq (JsonFormat s e) forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b Foldl.fold ((Result s e -> Seq (JsonFormat s e)) -> Fold (Seq (JsonFormat s e)) (Seq (JsonFormat s e)) -> Fold (Result s e) (Seq (JsonFormat s e)) forall a b r. (a -> b) -> Fold b r -> Fold a r Foldl.premap Result s e -> Seq (JsonFormat s e) forall s e. Result s e -> Seq (JsonFormat s e) formatResult Fold (Seq (JsonFormat s e)) (Seq (JsonFormat s e)) forall a. Monoid a => Fold a a Foldl.mconcat) f (Result s e) results formatResult :: Result s e -> Seq (JsonFormat s e) formatResult :: Result s e -> Seq (JsonFormat s e) formatResult (Result Text fileName Seq (ParseErrorBundle s e) errors Failures checks) = Seq (JsonFormat s e) allMessages where allMessages :: Seq (JsonFormat s e) allMessages = Seq (JsonFormat s e) errorMessages Seq (JsonFormat s e) -> Seq (JsonFormat s e) -> Seq (JsonFormat s e) forall a. Semigroup a => a -> a -> a <> Seq (JsonFormat s e) forall s e. Seq (JsonFormat s e) checkMessages errorMessages :: Seq (JsonFormat s e) errorMessages = (ParseErrorBundle s e -> JsonFormat s e) -> Seq (ParseErrorBundle s e) -> Seq (JsonFormat s e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ParseErrorBundle s e -> JsonFormat s e forall s e. ParseErrorBundle s e -> JsonFormat s e JsonParseError Seq (ParseErrorBundle s e) errors checkMessages :: Seq (JsonFormat s e) checkMessages = (CheckFailure -> JsonFormat s e) -> Failures -> Seq (JsonFormat s e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text -> CheckFailure -> JsonFormat s e forall s e. Text -> CheckFailure -> JsonFormat s e JsonCheck Text fileName) Failures checks