module Hadolint.Formatter.Format ( OutputFormat (..), Result (..), Text.Megaparsec.Error.errorBundlePretty, errorMessage, errorMessageLine, errorPosition, errorPositionPretty, severityText, stripNewlines, readMaybeOutputFormat, toResult, ) where import Data.Default import Data.Sequence (Seq) import Data.Text (Text) import Data.Text.Prettyprint.Doc (Pretty, pretty) import Data.YAML import Text.Megaparsec (TraversableStream (..), pstateSourcePos) import Text.Megaparsec.Error import Text.Megaparsec.Pos (SourcePos, sourcePosPretty) import Text.Megaparsec.Stream (VisualStream) import qualified Data.List.NonEmpty as NE import qualified Data.Sequence as Seq import qualified Data.Text as Text import qualified Hadolint.Rule data OutputFormat = Json | SonarQube | TTY | CodeclimateJson | GitlabCodeclimateJson | Checkstyle | Codacy | Sarif deriving (OutputFormat -> OutputFormat -> Bool (OutputFormat -> OutputFormat -> Bool) -> (OutputFormat -> OutputFormat -> Bool) -> Eq OutputFormat forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: OutputFormat -> OutputFormat -> Bool $c/= :: OutputFormat -> OutputFormat -> Bool == :: OutputFormat -> OutputFormat -> Bool $c== :: OutputFormat -> OutputFormat -> Bool Eq, Int -> OutputFormat -> ShowS [OutputFormat] -> ShowS OutputFormat -> String (Int -> OutputFormat -> ShowS) -> (OutputFormat -> String) -> ([OutputFormat] -> ShowS) -> Show OutputFormat forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [OutputFormat] -> ShowS $cshowList :: [OutputFormat] -> ShowS show :: OutputFormat -> String $cshow :: OutputFormat -> String showsPrec :: Int -> OutputFormat -> ShowS $cshowsPrec :: Int -> OutputFormat -> ShowS Show) instance Pretty OutputFormat where pretty :: OutputFormat -> Doc ann pretty OutputFormat Json = Doc ann "json" pretty OutputFormat SonarQube = Doc ann "sonarqube" pretty OutputFormat TTY = Doc ann "tty" pretty OutputFormat CodeclimateJson = Doc ann "codeclimate" pretty OutputFormat GitlabCodeclimateJson = Doc ann "gitlab_codeclimate" pretty OutputFormat Checkstyle = Doc ann "checkstyle" pretty OutputFormat Codacy = Doc ann "codacy" pretty OutputFormat Sarif = Doc ann "sarif" instance Semigroup OutputFormat where OutputFormat _ <> :: OutputFormat -> OutputFormat -> OutputFormat <> OutputFormat f = OutputFormat f instance Monoid OutputFormat where mempty :: OutputFormat mempty = OutputFormat TTY instance FromYAML OutputFormat where parseYAML :: Node Pos -> Parser OutputFormat parseYAML = (OutputFormat -> Parser OutputFormat) -> Node Pos -> Parser OutputFormat forall a. (OutputFormat -> Parser a) -> Node Pos -> Parser a withOutputFormat OutputFormat -> Parser OutputFormat forall (f :: * -> *) a. Applicative f => a -> f a pure withOutputFormat :: (OutputFormat -> Parser a) -> Node Pos -> Parser a withOutputFormat :: (OutputFormat -> Parser a) -> Node Pos -> Parser a withOutputFormat OutputFormat -> Parser a f v :: Node Pos v@(Scalar Pos _ (SStr Text b)) = case Text -> Maybe OutputFormat readMaybeOutputFormat Text b of Just OutputFormat out -> OutputFormat -> Parser a f OutputFormat out Maybe OutputFormat Nothing -> String -> Node Pos -> Parser a forall a. String -> Node Pos -> Parser a typeMismatch String "output format" Node Pos v withOutputFormat OutputFormat -> Parser a _ Node Pos v = String -> Node Pos -> Parser a forall a. String -> Node Pos -> Parser a typeMismatch String "output format" Node Pos v instance Default OutputFormat where def :: OutputFormat def = OutputFormat TTY readMaybeOutputFormat :: Text -> Maybe OutputFormat readMaybeOutputFormat :: Text -> Maybe OutputFormat readMaybeOutputFormat Text "json" = OutputFormat -> Maybe OutputFormat forall a. a -> Maybe a Just OutputFormat Json readMaybeOutputFormat Text "sonarqube" = OutputFormat -> Maybe OutputFormat forall a. a -> Maybe a Just OutputFormat SonarQube readMaybeOutputFormat Text "tty" = OutputFormat -> Maybe OutputFormat forall a. a -> Maybe a Just OutputFormat TTY readMaybeOutputFormat Text "codeclimate" = OutputFormat -> Maybe OutputFormat forall a. a -> Maybe a Just OutputFormat CodeclimateJson readMaybeOutputFormat Text "gitlab_codeclimate" = OutputFormat -> Maybe OutputFormat forall a. a -> Maybe a Just OutputFormat GitlabCodeclimateJson readMaybeOutputFormat Text "checkstyle" = OutputFormat -> Maybe OutputFormat forall a. a -> Maybe a Just OutputFormat Checkstyle readMaybeOutputFormat Text "codacy" = OutputFormat -> Maybe OutputFormat forall a. a -> Maybe a Just OutputFormat Codacy readMaybeOutputFormat Text "sarif" = OutputFormat -> Maybe OutputFormat forall a. a -> Maybe a Just OutputFormat Sarif readMaybeOutputFormat Text _ = Maybe OutputFormat forall a. Maybe a Nothing data Result s e = Result { Result s e -> Text fileName :: Text.Text, Result s e -> Seq (ParseErrorBundle s e) errors :: Seq (ParseErrorBundle s e), Result s e -> Failures checks :: Hadolint.Rule.Failures } toResult :: Text.Text -> Either (ParseErrorBundle s e) Hadolint.Rule.Failures -> Result s e toResult :: Text -> Either (ParseErrorBundle s e) Failures -> Result s e toResult Text file Either (ParseErrorBundle s e) Failures res = case Either (ParseErrorBundle s e) Failures res of Left ParseErrorBundle s e err -> Text -> Seq (ParseErrorBundle s e) -> Failures -> Result s e forall s e. Text -> Seq (ParseErrorBundle s e) -> Failures -> Result s e Result Text file (ParseErrorBundle s e -> Seq (ParseErrorBundle s e) forall a. a -> Seq a Seq.singleton ParseErrorBundle s e err) Failures forall a. Monoid a => a mempty Right Failures c -> Text -> Seq (ParseErrorBundle s e) -> Failures -> Result s e forall s e. Text -> Seq (ParseErrorBundle s e) -> Failures -> Result s e Result Text file Seq (ParseErrorBundle s e) forall a. Monoid a => a mempty (Failures -> Failures forall a. Ord a => Seq a -> Seq a Seq.unstableSort Failures c) severityText :: Hadolint.Rule.DLSeverity -> Text.Text severityText :: DLSeverity -> Text severityText DLSeverity s = case DLSeverity s of DLSeverity Hadolint.Rule.DLErrorC -> Text "error" DLSeverity Hadolint.Rule.DLWarningC -> Text "warning" DLSeverity Hadolint.Rule.DLInfoC -> Text "info" DLSeverity Hadolint.Rule.DLStyleC -> Text "style" DLSeverity _ -> Text "" stripNewlines :: String -> String stripNewlines :: ShowS stripNewlines = (Char -> Char) -> ShowS forall a b. (a -> b) -> [a] -> [b] map ( \Char c -> if Char c Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '\n' then Char ' ' else Char c ) errorMessageLine :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String errorMessageLine :: ParseErrorBundle s e -> String errorMessageLine err :: ParseErrorBundle s e err@(ParseErrorBundle NonEmpty (ParseError s e) e PosState s _) = ParseErrorBundle s e -> String forall s e. TraversableStream s => ParseErrorBundle s e -> String errorPositionPretty ParseErrorBundle s e err String -> ShowS forall a. [a] -> [a] -> [a] ++ String " " String -> ShowS forall a. [a] -> [a] -> [a] ++ ParseError s e -> String forall s e. (VisualStream s, ShowErrorComponent e) => ParseError s e -> String parseErrorTextPretty (NonEmpty (ParseError s e) -> ParseError s e forall a. NonEmpty a -> a NE.head NonEmpty (ParseError s e) e) errorMessage :: (VisualStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String errorMessage :: ParseErrorBundle s e -> String errorMessage (ParseErrorBundle NonEmpty (ParseError s e) e PosState s _) = ShowS forall a. [a] -> [a] reverse ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . (Char -> Bool) -> ShowS forall a. (a -> Bool) -> [a] -> [a] dropWhile (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '\n') ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . ShowS forall a. [a] -> [a] reverse ShowS -> ShowS forall a b. (a -> b) -> a -> b $ ParseError s e -> String forall s e. (VisualStream s, ShowErrorComponent e) => ParseError s e -> String parseErrorTextPretty (NonEmpty (ParseError s e) -> ParseError s e forall a. NonEmpty a -> a NE.head NonEmpty (ParseError s e) e) errorPositionPretty :: TraversableStream s => ParseErrorBundle s e -> String errorPositionPretty :: ParseErrorBundle s e -> String errorPositionPretty ParseErrorBundle s e err = SourcePos -> String sourcePosPretty (ParseErrorBundle s e -> SourcePos forall s e. TraversableStream s => ParseErrorBundle s e -> SourcePos errorPosition ParseErrorBundle s e err) errorPosition :: TraversableStream s => ParseErrorBundle s e -> Text.Megaparsec.Pos.SourcePos errorPosition :: ParseErrorBundle s e -> SourcePos errorPosition (ParseErrorBundle NonEmpty (ParseError s e) e PosState s s) = let (Maybe String _, PosState s posState) = Int -> PosState s -> (Maybe String, PosState s) forall s. TraversableStream s => Int -> PosState s -> (Maybe String, PosState s) reachOffset (ParseError s e -> Int forall s e. ParseError s e -> Int errorOffset (NonEmpty (ParseError s e) -> ParseError s e forall a. NonEmpty a -> a NE.head NonEmpty (ParseError s e) e)) PosState s s in PosState s -> SourcePos forall s. PosState s -> SourcePos pstateSourcePos PosState s posState