{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Hadolint.Formatter.Codeclimate ( printResult, formatResult, ) where import Data.Aeson hiding (Result) import qualified Data.ByteString.Lazy as B import Data.Monoid ((<>)) import Data.Sequence (Seq) import qualified Data.Text as Text import GHC.Generics import Hadolint.Formatter.Format (Result (..), errorPosition) import Hadolint.Rules (Metadata (..), RuleCheck (..)) import ShellCheck.Interface import Text.Megaparsec (Stream) import Text.Megaparsec.Error import Text.Megaparsec.Pos (sourceColumn, sourceLine, sourceName, unPos) data Issue = Issue { Issue -> String checkName :: String, Issue -> String description :: String, Issue -> Location location :: Location, Issue -> String impact :: String } data Location = LocLine String Int | LocPos String Pos instance ToJSON Location where toJSON :: Location -> Value toJSON (LocLine path :: String path l :: Int l) = [Pair] -> Value object ["path" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String path, "lines" Text -> Value -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= [Pair] -> Value object ["begin" Text -> Int -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Int l, "end" Text -> Int -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Int l]] toJSON (LocPos path :: String path pos :: Pos pos) = [Pair] -> Value object ["path" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String path, "positions" Text -> Value -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= [Pair] -> Value object ["begin" Text -> Pos -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Pos pos, "end" Text -> Pos -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Pos pos]] data Pos = Pos { Pos -> Int line :: Int, Pos -> Int column :: Int } deriving ((forall x. Pos -> Rep Pos x) -> (forall x. Rep Pos x -> Pos) -> Generic Pos forall x. Rep Pos x -> Pos forall x. Pos -> Rep Pos x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep Pos x -> Pos $cfrom :: forall x. Pos -> Rep Pos x Generic) instance ToJSON Pos instance ToJSON Issue where toJSON :: Issue -> Value toJSON Issue {..} = [Pair] -> Value object [ "type" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= ("issue" :: String), "check_name" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String checkName, "description" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String description, "categories" Text -> [String] -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= (["Bug Risk"] :: [String]), "location" Text -> Location -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= Location location, "severity" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= String impact ] errorToIssue :: (Stream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue errorToIssue :: ParseErrorBundle s e -> Issue errorToIssue err :: ParseErrorBundle s e err = Issue :: String -> String -> Location -> String -> Issue Issue { checkName :: String checkName = "DL1000", description :: String description = ParseErrorBundle s e -> String forall s e. (Stream s, ShowErrorComponent e) => ParseErrorBundle s e -> String errorBundlePretty ParseErrorBundle s e err, location :: Location location = String -> Pos -> Location LocPos (SourcePos -> String sourceName SourcePos pos) Pos :: Int -> Int -> Pos Pos {..}, impact :: String impact = Severity -> String severityText Severity ErrorC } where pos :: SourcePos pos = ParseErrorBundle s e -> SourcePos forall s e. Stream s => ParseErrorBundle s e -> SourcePos errorPosition ParseErrorBundle s e err line :: Int line = Pos -> Int unPos (SourcePos -> Pos sourceLine SourcePos pos) column :: Int column = Pos -> Int unPos (SourcePos -> Pos sourceColumn SourcePos pos) checkToIssue :: RuleCheck -> Issue checkToIssue :: RuleCheck -> Issue checkToIssue RuleCheck {..} = Issue :: String -> String -> Location -> String -> Issue Issue { checkName :: String checkName = Text -> String Text.unpack (Metadata -> Text code Metadata metadata), description :: String description = Text -> String Text.unpack (Metadata -> Text message Metadata metadata), location :: Location location = String -> Int -> Location LocLine (Text -> String Text.unpack Text filename) Int linenumber, impact :: String impact = Severity -> String severityText (Metadata -> Severity severity Metadata metadata) } severityText :: Severity -> String severityText :: Severity -> String severityText severity :: Severity severity = case Severity severity of ErrorC -> "blocker" WarningC -> "major" InfoC -> "info" StyleC -> "minor" formatResult :: (Stream s, ShowErrorComponent e) => Result s e -> Seq Issue formatResult :: Result s e -> Seq Issue formatResult (Result errors :: Seq (ParseErrorBundle s e) errors checks :: 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. (Stream 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 :: (Stream s, ShowErrorComponent e) => Result s e -> IO () printResult :: Result s e -> IO () printResult result :: 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. (Stream s, ShowErrorComponent e) => Result s e -> Seq Issue formatResult Result s e result) where output :: a -> IO () output value :: a value = do ByteString -> IO () B.putStr (a -> ByteString forall a. ToJSON a => a -> ByteString encode a value) ByteString -> IO () B.putStr (Word8 -> ByteString B.singleton 0x00)