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