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, errorMessage ) 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, ShowErrorComponent e) => ParseErrorBundle s e -> FilePath errorMessage 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