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

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

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 {..} =
        [Pair] -> Value
object ["filename" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
filename, "patternId" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
patternId, "message" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
msg, "line" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
line]

errorToIssue :: (Stream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue
errorToIssue :: ParseErrorBundle s e -> Issue
errorToIssue err :: ParseErrorBundle s e
err =
    Issue :: String -> String -> String -> Int -> Issue
Issue
        { filename :: String
filename = SourcePos -> String
sourceName SourcePos
pos
        , patternId :: String
patternId = "DL1000"
        , msg :: String
msg = ParseErrorBundle s e -> String
forall s e.
(Stream 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. Stream 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 {..} =
    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 :: (Stream s, ShowErrorComponent e) => Result s e -> Seq Issue
formatResult :: Result s e -> Seq Issue
formatResult (Result errors :: Seq (ParseErrorBundle s e)
errors checks :: 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.
(Stream 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 :: (Stream s, ShowErrorComponent e) => Result s e -> IO ()
printResult :: Result s e -> IO ()
printResult result :: 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.
(Stream s, ShowErrorComponent e) =>
Result s e -> Seq Issue
formatResult Result s e
result)
  where
    output :: a -> IO ()
output value :: a
value = ByteString -> IO ()
B.putStrLn (a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
value)