module Hadolint.Formatter.SonarQube
  ( formatResult,
    printResults
  )
  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,
    errorMessage
  )
import Hadolint.Rule
  ( CheckFailure (..),
    DLSeverity (..),
    unRuleCode
  )
import Text.Megaparsec (TraversableStream)
import Text.Megaparsec.Error
import Text.Megaparsec.Pos
  ( sourceColumn,
    sourceLine,
    sourceName,
    unPos
  )
import Text.Megaparsec.Stream (VisualStream)


data SonarQubeFormat s e
  = SonarQubeCheck Text.Text CheckFailure
  | SonarQubeError (ParseErrorBundle s e)

instance (VisualStream s,
  TraversableStream s,
  ShowErrorComponent e) => ToJSON (SonarQubeFormat s e) where
  toJSON :: SonarQubeFormat s e -> Value
toJSON (SonarQubeCheck Text
filename CheckFailure {Linenumber
Text
RuleCode
DLSeverity
line :: CheckFailure -> Linenumber
message :: CheckFailure -> Text
severity :: CheckFailure -> DLSeverity
code :: CheckFailure -> RuleCode
line :: Linenumber
message :: Text
severity :: DLSeverity
code :: RuleCode
..}) =
    [Pair] -> Value
object
      [ Text
"engineId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
Text.pack String
"Hadolint",
        Text
"ruleId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= RuleCode -> Text
unRuleCode RuleCode
code,
        Text
"severity" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DLSeverity -> Text
toSeverity DLSeverity
severity,
        Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= DLSeverity -> Text
toType DLSeverity
severity,
        Text
"primaryLocation" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
          [ Text
"message" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
message,
            Text
"filePath" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
filename,
            Text
"textRange" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
              [ Text
"startLine" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Linenumber
line,
                Text
"endLine" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Linenumber
line,
                Text
"startColumn" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Linenumber
0 :: Int),
                Text
"endColumn" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (Linenumber
1 :: Int)
              ]
          ]
      ]
  toJSON (SonarQubeError ParseErrorBundle s e
err) =
    [Pair] -> Value
object
      [ Text
"engineId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
Text.pack String
"Hadolint",
        Text
"ruleId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
Text.pack String
"DL1000",
        Text
"severity" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
Text.pack String
"BLOCKER",
        Text
"type" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
Text.pack String
"BUG",
        Text
"primaryLocation" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
          [ Text
"message" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ParseErrorBundle s e -> String
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorMessage ParseErrorBundle s e
err,
            Text
"filePath" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String -> Text
Text.pack (SourcePos -> String
sourceName SourcePos
pos),
            Text
"textRange" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
              [ Text
"startLine" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Linenumber
linenumber,
                Text
"endLine" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Linenumber
linenumber,
                Text
"startColumn" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Linenumber
column,
                Text
"endColumn" Text -> Linenumber -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Linenumber
column
              ]
          ]
      ]
    where
      pos :: SourcePos
pos = ParseErrorBundle s e -> SourcePos
forall s e.
TraversableStream s =>
ParseErrorBundle s e -> SourcePos
errorPosition ParseErrorBundle s e
err
      linenumber :: Linenumber
linenumber = Pos -> Linenumber
unPos (Pos -> Linenumber) -> Pos -> Linenumber
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceLine SourcePos
pos
      column :: Linenumber
column = Pos -> Linenumber
unPos (Pos -> Linenumber) -> Pos -> Linenumber
forall a b. (a -> b) -> a -> b
$ SourcePos -> Pos
sourceColumn SourcePos
pos


formatResult :: Result s e -> Seq (SonarQubeFormat s e)
formatResult :: Result s e -> Seq (SonarQubeFormat s e)
formatResult (Result Text
filename Seq (ParseErrorBundle s e)
errors Failures
checks) = Seq (SonarQubeFormat s e)
allMessages
  where
    allMessages :: Seq (SonarQubeFormat s e)
allMessages = Seq (SonarQubeFormat s e)
errorMessages Seq (SonarQubeFormat s e)
-> Seq (SonarQubeFormat s e) -> Seq (SonarQubeFormat s e)
forall a. Semigroup a => a -> a -> a
<> Seq (SonarQubeFormat s e)
forall s e. Seq (SonarQubeFormat s e)
checkMessages
    errorMessages :: Seq (SonarQubeFormat s e)
errorMessages = (ParseErrorBundle s e -> SonarQubeFormat s e)
-> Seq (ParseErrorBundle s e) -> Seq (SonarQubeFormat s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseErrorBundle s e -> SonarQubeFormat s e
forall s e. ParseErrorBundle s e -> SonarQubeFormat s e
SonarQubeError Seq (ParseErrorBundle s e)
errors
    checkMessages :: Seq (SonarQubeFormat s e)
checkMessages = (CheckFailure -> SonarQubeFormat s e)
-> Failures -> Seq (SonarQubeFormat s e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> CheckFailure -> SonarQubeFormat s e
forall s e. Text -> CheckFailure -> SonarQubeFormat s e
SonarQubeCheck Text
filename) Failures
checks

printResults :: (VisualStream s,
  TraversableStream s,
  ShowErrorComponent e,
  Foldable f) => f (Result s e) -> IO ()
printResults :: f (Result s e) -> IO ()
printResults f (Result s e)
results = ByteString -> IO ()
B.putStr (ByteString -> IO ()) -> (Value -> ByteString) -> Value -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> IO ()) -> Value -> IO ()
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object [ Text
"issues" Text -> Seq (SonarQubeFormat s e) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Seq (SonarQubeFormat s e)
flattened ]
  where
    flattened :: Seq (SonarQubeFormat s e)
flattened = Fold (Result s e) (Seq (SonarQubeFormat s e))
-> f (Result s e) -> Seq (SonarQubeFormat s e)
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
Foldl.fold ((Result s e -> Seq (SonarQubeFormat s e))
-> Fold (Seq (SonarQubeFormat s e)) (Seq (SonarQubeFormat s e))
-> Fold (Result s e) (Seq (SonarQubeFormat s e))
forall a b r. (a -> b) -> Fold b r -> Fold a r
Foldl.premap Result s e -> Seq (SonarQubeFormat s e)
forall s e. Result s e -> Seq (SonarQubeFormat s e)
formatResult Fold (Seq (SonarQubeFormat s e)) (Seq (SonarQubeFormat s e))
forall a. Monoid a => Fold a a
Foldl.mconcat) f (Result s e)
results

toType :: DLSeverity -> Text.Text
toType :: DLSeverity -> Text
toType DLSeverity
DLErrorC = Text
"BUG"
toType DLSeverity
_ = Text
"CODE_SMELL"

toSeverity :: DLSeverity -> Text.Text
toSeverity :: DLSeverity -> Text
toSeverity DLSeverity
DLErrorC = Text
"CRITICAL"
toSeverity DLSeverity
DLWarningC = Text
"MAJOR"
toSeverity DLSeverity
DLInfoC = Text
"MINOR"
toSeverity DLSeverity
_ = Text
"INFO"