{-# 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 (Stream)
import Text.Megaparsec.Error
import Text.Megaparsec.Pos (sourceColumn, sourceLine, sourceName, unPos)

data JsonFormat s e
  = JsonCheck RuleCheck
  | JsonParseError (ParseErrorBundle s e)

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

formatResult :: (Stream s, ShowErrorComponent e) => Result s e -> Value
formatResult :: Result s e -> Value
formatResult (Result errors :: Seq (ParseErrorBundle s e)
errors checks :: 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 :: (Stream s, ShowErrorComponent e) => Result s e -> IO ()
printResult :: Result s e -> IO ()
printResult result :: Result s e
result = ByteString -> IO ()
B.putStrLn (Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Result s e -> Value
forall s e. (Stream s, ShowErrorComponent e) => Result s e -> Value
formatResult Result s e
result))