{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Hadolint.Formatter.Json
  ( printResult,
    formatResult,
  )
where

import Data.Aeson hiding (Result)
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Monoid ((<>))
import Hadolint.Formatter.Format (Result (..), errorPosition, severityText)
import Hadolint.Rules (Metadata (..), RuleCheck (..))
import ShellCheck.Interface
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 RuleCheck
  | JsonParseError (ParseErrorBundle s e)

instance (VisualStream s, TraversableStream s, ShowErrorComponent e) => ToJSON (JsonFormat s e) where
  toJSON :: JsonFormat s e -> Value
toJSON (JsonCheck RuleCheck {Bool
Linenumber
Filename
Metadata
success :: RuleCheck -> Bool
linenumber :: RuleCheck -> Linenumber
filename :: RuleCheck -> Filename
metadata :: RuleCheck -> Metadata
success :: Bool
linenumber :: Linenumber
filename :: Filename
metadata :: Metadata
..}) =
    [Pair] -> Value
object
      [ Filename
"file" Filename -> Filename -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= Filename
filename,
        Filename
"line" Filename -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= Linenumber
linenumber,
        Filename
"column" Filename -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= (Linenumber
1 :: Int),
        Filename
"level" Filename -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= Severity -> String
severityText (Metadata -> Severity
severity Metadata
metadata),
        Filename
"code" Filename -> Filename -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= Metadata -> Filename
code Metadata
metadata,
        Filename
"message" Filename -> Filename -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= Metadata -> Filename
message Metadata
metadata
      ]
  toJSON (JsonParseError ParseErrorBundle s e
err) =
    [Pair] -> Value
object
      [ Filename
"file" Filename -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= SourcePos -> String
sourceName SourcePos
pos,
        Filename
"line" Filename -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= Pos -> Linenumber
unPos (SourcePos -> Pos
sourceLine SourcePos
pos),
        Filename
"column" Filename -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= Pos -> Linenumber
unPos (SourcePos -> Pos
sourceColumn SourcePos
pos),
        Filename
"level" Filename -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= Severity -> String
severityText Severity
ErrorC,
        Filename
"code" Filename -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= (String
"DL1000" :: String),
        Filename
"message" Filename -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Filename -> v -> kv
.= ParseErrorBundle s e -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
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

formatResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Value
formatResult :: Result s e -> Value
formatResult (Result Seq (ParseErrorBundle s e)
errors Seq RuleCheck
checks) = Seq (JsonFormat s e) -> Value
forall a. ToJSON a => a -> Value
toJSON 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 = (RuleCheck -> JsonFormat s e)
-> Seq RuleCheck -> Seq (JsonFormat s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RuleCheck -> JsonFormat s e
forall s e. RuleCheck -> JsonFormat s e
JsonCheck Seq RuleCheck
checks

printResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> IO ()
printResult :: Result s e -> IO ()
printResult Result s e
result = ByteString -> IO ()
B.putStrLn (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Result s e -> Value
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> Value
formatResult Result s e
result))