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 Prettyprinter (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 | Gnu | Checkstyle | Codacy | Sarif deriving (OutputFormat -> OutputFormat -> Bool 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 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 :: forall ann. 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 Gnu = Doc ann "gnu" 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 = forall a. (OutputFormat -> Parser a) -> Node Pos -> Parser a withOutputFormat forall (f :: * -> *) a. Applicative f => a -> f a pure withOutputFormat :: (OutputFormat -> Parser a) -> Node Pos -> Parser a withOutputFormat :: forall a. (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 -> forall a. String -> Node Pos -> Parser a typeMismatch String "output format" Node Pos v withOutputFormat OutputFormat -> Parser a _ Node Pos v = 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" = forall a. a -> Maybe a Just OutputFormat Json readMaybeOutputFormat Text "sonarqube" = forall a. a -> Maybe a Just OutputFormat SonarQube readMaybeOutputFormat Text "tty" = forall a. a -> Maybe a Just OutputFormat TTY readMaybeOutputFormat Text "codeclimate" = forall a. a -> Maybe a Just OutputFormat CodeclimateJson readMaybeOutputFormat Text "gitlab_codeclimate" = forall a. a -> Maybe a Just OutputFormat GitlabCodeclimateJson readMaybeOutputFormat Text "gnu" = forall a. a -> Maybe a Just OutputFormat Gnu readMaybeOutputFormat Text "checkstyle" = forall a. a -> Maybe a Just OutputFormat Checkstyle readMaybeOutputFormat Text "codacy" = forall a. a -> Maybe a Just OutputFormat Codacy readMaybeOutputFormat Text "sarif" = forall a. a -> Maybe a Just OutputFormat Sarif readMaybeOutputFormat Text _ = forall a. Maybe a Nothing data Result s e = Result { forall s e. Result s e -> Text fileName :: Text.Text, forall s e. Result s e -> Seq (ParseErrorBundle s e) errors :: Seq (ParseErrorBundle s e), forall s e. Result s e -> Failures checks :: Hadolint.Rule.Failures } toResult :: Text.Text -> Either (ParseErrorBundle s e) Hadolint.Rule.Failures -> Result s e toResult :: forall s e. 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 -> forall s e. Text -> Seq (ParseErrorBundle s e) -> Failures -> Result s e Result Text file (forall a. a -> Seq a Seq.singleton ParseErrorBundle s e err) forall a. Monoid a => a mempty Right Failures c -> forall s e. Text -> Seq (ParseErrorBundle s e) -> Failures -> Result s e Result Text file forall a. Monoid a => a mempty (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 = forall a b. (a -> b) -> [a] -> [b] map ( \Char c -> if Char c 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 :: forall s e. (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String errorMessageLine err :: ParseErrorBundle s e err@(ParseErrorBundle NonEmpty (ParseError s e) e PosState s _) = forall s e. TraversableStream s => ParseErrorBundle s e -> String errorPositionPretty ParseErrorBundle s e err forall a. [a] -> [a] -> [a] ++ String " " forall a. [a] -> [a] -> [a] ++ forall s e. (VisualStream s, ShowErrorComponent e) => ParseError s e -> String parseErrorTextPretty (forall a. NonEmpty a -> a NE.head NonEmpty (ParseError s e) e) errorMessage :: (VisualStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String errorMessage :: forall s e. (VisualStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String errorMessage (ParseErrorBundle NonEmpty (ParseError s e) e PosState s _) = forall a. [a] -> [a] reverse forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. (a -> Bool) -> [a] -> [a] dropWhile (forall a. Eq a => a -> a -> Bool == Char '\n') forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. [a] -> [a] reverse forall a b. (a -> b) -> a -> b $ forall s e. (VisualStream s, ShowErrorComponent e) => ParseError s e -> String parseErrorTextPretty (forall a. NonEmpty a -> a NE.head NonEmpty (ParseError s e) e) errorPositionPretty :: TraversableStream s => ParseErrorBundle s e -> String errorPositionPretty :: forall s e. TraversableStream s => ParseErrorBundle s e -> String errorPositionPretty ParseErrorBundle s e err = SourcePos -> String sourcePosPretty (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 :: forall s e. TraversableStream s => ParseErrorBundle s e -> SourcePos errorPosition (ParseErrorBundle NonEmpty (ParseError s e) e PosState s s) = let (Maybe String _, PosState s posState) = forall s. TraversableStream s => Int -> PosState s -> (Maybe String, PosState s) reachOffset (forall s e. ParseError s e -> Int errorOffset (forall a. NonEmpty a -> a NE.head NonEmpty (ParseError s e) e)) PosState s s in forall s. PosState s -> SourcePos pstateSourcePos PosState s posState