module Hadolint.Formatter.SonarQube ( formatResult, printResults ) 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, 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 SonarQubeFormat s e = SonarQubeCheck Text.Text CheckFailure | SonarQubeError (ParseErrorBundle s e) instance (VisualStream s, TraversableStream s, ShowErrorComponent e) => ToJSON (SonarQubeFormat s e) where toJSON :: SonarQubeFormat s e -> Value toJSON (SonarQubeCheck 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 [ Key "engineId" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= String -> Text Text.pack String "Hadolint", Key "ruleId" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= RuleCode -> Text unRuleCode RuleCode code, Key "severity" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= DLSeverity -> Text toSeverity DLSeverity severity, Key "type" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= DLSeverity -> Text toType DLSeverity severity, Key "primaryLocation" Key -> Value -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= [Pair] -> Value object [ Key "message" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Text message, Key "filePath" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Text filename, Key "textRange" Key -> Value -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= [Pair] -> Value object [ Key "startLine" Key -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Linenumber line, Key "endLine" Key -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Linenumber line, Key "startColumn" Key -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= (Linenumber 0 :: Int), Key "endColumn" Key -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= (Linenumber 1 :: Int) ] ] ] toJSON (SonarQubeError ParseErrorBundle s e err) = [Pair] -> Value object [ Key "engineId" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= String -> Text Text.pack String "Hadolint", Key "ruleId" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= String -> Text Text.pack String "DL1000", Key "severity" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= String -> Text Text.pack String "BLOCKER", Key "type" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= String -> Text Text.pack String "BUG", Key "primaryLocation" Key -> Value -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= [Pair] -> Value object [ Key "message" Key -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= ParseErrorBundle s e -> String forall s e. (VisualStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String errorMessage ParseErrorBundle s e err, Key "filePath" Key -> Text -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= String -> Text Text.pack (SourcePos -> String sourceName SourcePos pos), Key "textRange" Key -> Value -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= [Pair] -> Value object [ Key "startLine" Key -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Linenumber linenumber, Key "endLine" Key -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Linenumber linenumber, Key "startColumn" Key -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Linenumber column, Key "endColumn" Key -> Linenumber -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Linenumber column ] ] ] where pos :: SourcePos pos = ParseErrorBundle s e -> SourcePos forall s e. TraversableStream s => ParseErrorBundle s e -> SourcePos errorPosition ParseErrorBundle s e err linenumber :: Linenumber linenumber = Pos -> Linenumber unPos (Pos -> Linenumber) -> Pos -> Linenumber forall a b. (a -> b) -> a -> b $ SourcePos -> Pos sourceLine SourcePos pos column :: Linenumber column = Pos -> Linenumber unPos (Pos -> Linenumber) -> Pos -> Linenumber forall a b. (a -> b) -> a -> b $ SourcePos -> Pos sourceColumn SourcePos pos formatResult :: Result s e -> Seq (SonarQubeFormat s e) formatResult :: Result s e -> Seq (SonarQubeFormat s e) formatResult (Result Text filename Seq (ParseErrorBundle s e) errors Failures checks) = Seq (SonarQubeFormat s e) allMessages where allMessages :: Seq (SonarQubeFormat s e) allMessages = Seq (SonarQubeFormat s e) errorMessages Seq (SonarQubeFormat s e) -> Seq (SonarQubeFormat s e) -> Seq (SonarQubeFormat s e) forall a. Semigroup a => a -> a -> a <> Seq (SonarQubeFormat s e) forall s e. Seq (SonarQubeFormat s e) checkMessages errorMessages :: Seq (SonarQubeFormat s e) errorMessages = (ParseErrorBundle s e -> SonarQubeFormat s e) -> Seq (ParseErrorBundle s e) -> Seq (SonarQubeFormat s e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ParseErrorBundle s e -> SonarQubeFormat s e forall s e. ParseErrorBundle s e -> SonarQubeFormat s e SonarQubeError Seq (ParseErrorBundle s e) errors checkMessages :: Seq (SonarQubeFormat s e) checkMessages = (CheckFailure -> SonarQubeFormat s e) -> Failures -> Seq (SonarQubeFormat s e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (Text -> CheckFailure -> SonarQubeFormat s e forall s e. Text -> CheckFailure -> SonarQubeFormat s e SonarQubeCheck Text filename) Failures checks 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 ()) -> (Value -> ByteString) -> Value -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> ByteString forall a. ToJSON a => a -> ByteString encode (Value -> IO ()) -> Value -> IO () forall a b. (a -> b) -> a -> b $ [Pair] -> Value object [ Key "issues" Key -> Seq (SonarQubeFormat s e) -> Pair forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Seq (SonarQubeFormat s e) flattened ] where flattened :: Seq (SonarQubeFormat s e) flattened = Fold (Result s e) (Seq (SonarQubeFormat s e)) -> f (Result s e) -> Seq (SonarQubeFormat s e) forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b Foldl.fold ((Result s e -> Seq (SonarQubeFormat s e)) -> Fold (Seq (SonarQubeFormat s e)) (Seq (SonarQubeFormat s e)) -> Fold (Result s e) (Seq (SonarQubeFormat s e)) forall a b r. (a -> b) -> Fold b r -> Fold a r Foldl.premap Result s e -> Seq (SonarQubeFormat s e) forall s e. Result s e -> Seq (SonarQubeFormat s e) formatResult Fold (Seq (SonarQubeFormat s e)) (Seq (SonarQubeFormat s e)) forall a. Monoid a => Fold a a Foldl.mconcat) f (Result s e) results toType :: DLSeverity -> Text.Text toType :: DLSeverity -> Text toType DLSeverity DLErrorC = Text "BUG" toType DLSeverity _ = Text "CODE_SMELL" toSeverity :: DLSeverity -> Text.Text toSeverity :: DLSeverity -> Text toSeverity DLSeverity DLErrorC = Text "CRITICAL" toSeverity DLSeverity DLWarningC = Text "MAJOR" toSeverity DLSeverity DLInfoC = Text "MINOR" toSeverity DLSeverity _ = Text "INFO"