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" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
filename, Key
"patternId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
patternId, Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
msg, Key
"line" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> 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 :: Text -> Text -> Text -> Int -> Issue
Issue
    { filename :: Text
filename = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SourcePos -> String
sourceName SourcePos
pos,
      patternId :: Text
patternId = Text
"DL1000",
      msg :: Text
msg = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ 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 :: 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 :: Text -> Text -> Text -> Int -> Issue
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 :: 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 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 = (CheckFailure -> Issue) -> Failures -> Seq Issue
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 :: f (Result s e) -> IO ()
printResults f (Result s e)
results = (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 Seq Issue
flattened
  where
    flattened :: Seq Issue
flattened = Fold (Result s e) (Seq Issue) -> f (Result s e) -> Seq Issue
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Foldl.fold ((Result s e -> Seq Issue)
-> Fold (Seq Issue) (Seq Issue) -> Fold (Result s e) (Seq Issue)
forall a b r. (a -> b) -> Fold b r -> Fold a r
Foldl.premap Result s e -> Seq Issue
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> Seq Issue
formatResult Fold (Seq Issue) (Seq Issue)
forall a. Monoid a => Fold a a
Foldl.mconcat) f (Result s e)
results
    output :: a -> IO ()
output a
value = ByteString -> IO ()
B.putStrLn (a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
value)