module Hadolint.Formatter.Json
  ( printResults,
    formatResult,
  )
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, severityText)
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 JsonFormat s e
  = JsonCheck Text.Text CheckFailure
  | JsonParseError (ParseErrorBundle s e)

instance (VisualStream s, TraversableStream s, ShowErrorComponent e) => ToJSON (JsonFormat s e) where
  toJSON :: JsonFormat s e -> Value
toJSON (JsonCheck 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
      [ Text
"file" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
filename,
        Text
"line" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Linenumber
line,
        Text
"column" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Linenumber
1 :: Int),
        Text
"level" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DLSeverity -> Text
severityText DLSeverity
severity,
        Text
"code" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RuleCode -> Text
unRuleCode RuleCode
code,
        Text
"message" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
message
      ]
  toJSON (JsonParseError ParseErrorBundle s e
err) =
    [Pair] -> Value
object
      [ Text
"file" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SourcePos -> FilePath
sourceName SourcePos
pos,
        Text
"line" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Pos -> Linenumber
unPos (SourcePos -> Pos
sourceLine SourcePos
pos),
        Text
"column" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Pos -> Linenumber
unPos (SourcePos -> Pos
sourceColumn SourcePos
pos),
        Text
"level" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DLSeverity -> Text
severityText DLSeverity
DLErrorC,
        Text
"code" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Text
"DL1000" :: Text.Text),
        Text
"message" Text -> FilePath -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ParseErrorBundle s e -> FilePath
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorBundlePretty ParseErrorBundle s e
err
      ]
    where
      pos :: SourcePos
pos = ParseErrorBundle s e -> SourcePos
forall s e.
TraversableStream s =>
ParseErrorBundle s e -> SourcePos
errorPosition ParseErrorBundle s e
err

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 ())
-> (Seq (JsonFormat s e) -> ByteString)
-> Seq (JsonFormat s e)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq (JsonFormat s e) -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Seq (JsonFormat s e) -> IO ()) -> Seq (JsonFormat s e) -> IO ()
forall a b. (a -> b) -> a -> b
$ Seq (JsonFormat s e)
flattened
  where
    flattened :: Seq (JsonFormat s e)
flattened = Fold (Result s e) (Seq (JsonFormat s e))
-> f (Result s e) -> Seq (JsonFormat s e)
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Foldl.fold ((Result s e -> Seq (JsonFormat s e))
-> Fold (Seq (JsonFormat s e)) (Seq (JsonFormat s e))
-> Fold (Result s e) (Seq (JsonFormat s e))
forall a b r. (a -> b) -> Fold b r -> Fold a r
Foldl.premap Result s e -> Seq (JsonFormat s e)
forall s e. Result s e -> Seq (JsonFormat s e)
formatResult Fold (Seq (JsonFormat s e)) (Seq (JsonFormat s e))
forall a. Monoid a => Fold a a
Foldl.mconcat) f (Result s e)
results

formatResult :: Result s e -> Seq (JsonFormat s e)
formatResult :: Result s e -> Seq (JsonFormat s e)
formatResult (Result Text
fileName Seq (ParseErrorBundle s e)
errors Failures
checks) = Seq (JsonFormat s e)
allMessages
  where
    allMessages :: Seq (JsonFormat s e)
allMessages = Seq (JsonFormat s e)
errorMessages Seq (JsonFormat s e)
-> Seq (JsonFormat s e) -> Seq (JsonFormat s e)
forall a. Semigroup a => a -> a -> a
<> Seq (JsonFormat s e)
forall s e. Seq (JsonFormat s e)
checkMessages
    errorMessages :: Seq (JsonFormat s e)
errorMessages = (ParseErrorBundle s e -> JsonFormat s e)
-> Seq (ParseErrorBundle s e) -> Seq (JsonFormat s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseErrorBundle s e -> JsonFormat s e
forall s e. ParseErrorBundle s e -> JsonFormat s e
JsonParseError Seq (ParseErrorBundle s e)
errors
    checkMessages :: Seq (JsonFormat s e)
checkMessages = (CheckFailure -> JsonFormat s e)
-> Failures -> Seq (JsonFormat s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> CheckFailure -> JsonFormat s e
forall s e. Text -> CheckFailure -> JsonFormat s e
JsonCheck Text
fileName) Failures
checks