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

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

import Data.Aeson hiding (Result)
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Monoid ((<>))
import Data.Sequence (Seq)
import qualified Data.Text as Text
import Hadolint.Formatter.Format (Result (..), errorPosition)
import Hadolint.Rules (Metadata (..), RuleCheck (..))
import Text.Megaparsec (TraversableStream)
import Text.Megaparsec.Error
import Text.Megaparsec.Pos (sourceLine, sourceName, unPos)
import Text.Megaparsec.Stream (VisualStream)

data Issue = Issue
  { Issue -> String
filename :: String,
    Issue -> String
msg :: String,
    Issue -> String
patternId :: String,
    Issue -> Int
line :: Int
  }

instance ToJSON Issue where
  toJSON :: Issue -> Value
toJSON Issue {Int
String
line :: Int
patternId :: String
msg :: String
filename :: String
line :: Issue -> Int
patternId :: Issue -> String
msg :: Issue -> String
filename :: Issue -> String
..} =
    [Pair] -> Value
object [Text
"filename" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
filename, Text
"patternId" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
patternId, Text
"message" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
msg, Text
"line" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
line]

errorToIssue :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue
errorToIssue :: ParseErrorBundle s e -> Issue
errorToIssue ParseErrorBundle s e
err =
  Issue :: String -> String -> String -> Int -> Issue
Issue
    { filename :: String
filename = SourcePos -> String
sourceName SourcePos
pos,
      patternId :: String
patternId = String
"DL1000",
      msg :: String
msg = ParseErrorBundle s e -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle s e
err,
      line :: Int
line = Int
linenumber
    }
  where
    pos :: SourcePos
pos = ParseErrorBundle s e -> SourcePos
forall s e.
TraversableStream s =>
ParseErrorBundle s e -> SourcePos
errorPosition ParseErrorBundle s e
err
    linenumber :: Int
linenumber = Pos -> Int
unPos (SourcePos -> Pos
sourceLine SourcePos
pos)

checkToIssue :: RuleCheck -> Issue
checkToIssue :: RuleCheck -> Issue
checkToIssue RuleCheck {Bool
Int
Text
Metadata
success :: RuleCheck -> Bool
linenumber :: RuleCheck -> Int
filename :: RuleCheck -> Text
metadata :: RuleCheck -> Metadata
success :: Bool
linenumber :: Int
filename :: Text
metadata :: Metadata
..} =
  Issue :: String -> String -> String -> Int -> Issue
Issue
    { filename :: String
filename = Text -> String
Text.unpack Text
filename,
      patternId :: String
patternId = Text -> String
Text.unpack (Metadata -> Text
code Metadata
metadata),
      msg :: String
msg = Text -> String
Text.unpack (Metadata -> Text
message Metadata
metadata),
      line :: Int
line = Int
linenumber
    }

formatResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Seq Issue
formatResult :: Result s e -> Seq Issue
formatResult (Result Seq (ParseErrorBundle s e)
errors Seq RuleCheck
checks) = Seq Issue
allIssues
  where
    allIssues :: Seq Issue
allIssues = Seq Issue
errorMessages Seq Issue -> Seq Issue -> Seq Issue
forall a. Semigroup a => a -> a -> a
<> Seq Issue
checkMessages
    errorMessages :: Seq Issue
errorMessages = (ParseErrorBundle s e -> Issue)
-> Seq (ParseErrorBundle s e) -> Seq Issue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseErrorBundle s e -> Issue
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> Issue
errorToIssue Seq (ParseErrorBundle s e)
errors
    checkMessages :: Seq Issue
checkMessages = (RuleCheck -> Issue) -> Seq RuleCheck -> Seq Issue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RuleCheck -> Issue
checkToIssue Seq RuleCheck
checks

printResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> IO ()
printResult :: Result s e -> IO ()
printResult Result s e
result = (Issue -> IO ()) -> Seq Issue -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Issue -> IO ()
forall a. ToJSON a => a -> IO ()
output (Result s e -> Seq Issue
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> Seq Issue
formatResult Result s e
result)
  where
    output :: a -> IO ()
output a
value = ByteString -> IO ()
B.putStrLn (a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
value)