module Hadolint.Formatter.Codacy
  ( 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)
import Hadolint.Rule (CheckFailure (..), RuleCode (..))
import Text.Megaparsec (TraversableStream)
import Text.Megaparsec.Error
import Text.Megaparsec.Pos (sourceLine, sourceName, unPos)
import Text.Megaparsec.Stream (VisualStream)

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

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

errorToIssue :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue
errorToIssue :: forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> Issue
errorToIssue ParseErrorBundle s e
err =
  Issue
    { filename :: Text
filename = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ SourcePos -> String
sourceName SourcePos
pos,
      patternId :: Text
patternId = Text
"DL1000",
      msg :: Text
msg = String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ 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 = 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 :: Text.Text -> CheckFailure -> Issue
checkToIssue :: Text -> CheckFailure -> Issue
checkToIssue Text
filename CheckFailure {Int
Text
RuleCode
DLSeverity
line :: CheckFailure -> Int
message :: CheckFailure -> Text
severity :: CheckFailure -> DLSeverity
code :: CheckFailure -> RuleCode
line :: Int
message :: Text
severity :: DLSeverity
code :: RuleCode
..} =
  Issue
    { filename :: Text
filename = Text
filename,
      patternId :: Text
patternId = RuleCode -> Text
unRuleCode RuleCode
code,
      msg :: Text
msg = Text
message,
      line :: Int
line = Int
line
    }

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

printResults ::
  (Foldable f, VisualStream s, TraversableStream s, ShowErrorComponent e) =>
  f (Result s e) ->
  IO ()
printResults :: forall (f :: * -> *) s e.
(Foldable f, VisualStream s, TraversableStream s,
 ShowErrorComponent e) =>
f (Result s e) -> IO ()
printResults f (Result s e)
results = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a}. ToJSON a => a -> IO ()
output Seq Issue
flattened
  where
    flattened :: Seq Issue
flattened = forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Foldl.fold (forall a b r. (a -> b) -> Fold b r -> Fold a r
Foldl.premap forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> Seq Issue
formatResult forall a. Monoid a => Fold a a
Foldl.mconcat) f (Result s e)
results
    output :: a -> IO ()
output a
value = ByteString -> IO ()
B.putStrLn (forall a. ToJSON a => a -> ByteString
encode a
value)