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,
    errorMessage
  )
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, ShowErrorComponent e) =>
ParseErrorBundle s e -> FilePath
errorMessage 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