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

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

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

data Issue = Issue
  { Issue -> String
checkName :: String,
    Issue -> String
description :: String,
    Issue -> Location
location :: Location,
    Issue -> String
impact :: String
  }

data Location
  = LocLine
      String
      Int
  | LocPos
      String
      Pos

instance ToJSON Location where
  toJSON :: Location -> Value
toJSON (LocLine String
path Int
l) = [Pair] -> Value
object [Text
"path" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
path, Text
"lines" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [Text
"begin" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
l, Text
"end" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
l]]
  toJSON (LocPos String
path Pos
pos) =
    [Pair] -> Value
object [Text
"path" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
path, Text
"positions" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object [Text
"begin" Text -> Pos -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Pos
pos, Text
"end" Text -> Pos -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Pos
pos]]

data Pos = Pos
  { Pos -> Int
line :: Int,
    Pos -> Int
column :: Int
  }
  deriving ((forall x. Pos -> Rep Pos x)
-> (forall x. Rep Pos x -> Pos) -> Generic Pos
forall x. Rep Pos x -> Pos
forall x. Pos -> Rep Pos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pos x -> Pos
$cfrom :: forall x. Pos -> Rep Pos x
Generic)

instance ToJSON Pos

instance ToJSON Issue where
  toJSON :: Issue -> Value
toJSON Issue {String
Location
impact :: String
location :: Location
description :: String
checkName :: String
impact :: Issue -> String
location :: Issue -> Location
description :: Issue -> String
checkName :: Issue -> String
..} =
    [Pair] -> Value
object
      [ Text
"type" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= (String
"issue" :: String),
        Text
"check_name" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
checkName,
        Text
"description" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
description,
        Text
"categories" Text -> [String] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ([String
"Bug Risk"] :: [String]),
        Text
"location" Text -> Location -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Location
location,
        Text
"severity" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
impact
      ]

errorToIssue :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> Issue
errorToIssue :: ParseErrorBundle s e -> Issue
errorToIssue ParseErrorBundle s e
err =
  Issue :: String -> String -> Location -> String -> Issue
Issue
    { checkName :: String
checkName = String
"DL1000",
      description :: String
description = ParseErrorBundle s e -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle s e
err,
      location :: Location
location = String -> Pos -> Location
LocPos (SourcePos -> String
sourceName SourcePos
pos) Pos :: Int -> Int -> Pos
Pos {Int
column :: Int
line :: Int
column :: Int
line :: Int
..},
      impact :: String
impact = Severity -> String
severityText Severity
ErrorC
    }
  where
    pos :: SourcePos
pos = ParseErrorBundle s e -> SourcePos
forall s e.
TraversableStream s =>
ParseErrorBundle s e -> SourcePos
errorPosition ParseErrorBundle s e
err
    line :: Int
line = Pos -> Int
unPos (SourcePos -> Pos
sourceLine SourcePos
pos)
    column :: Int
column = Pos -> Int
unPos (SourcePos -> Pos
sourceColumn 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 -> Location -> String -> Issue
Issue
    { checkName :: String
checkName = Text -> String
Text.unpack (Metadata -> Text
code Metadata
metadata),
      description :: String
description = Text -> String
Text.unpack (Metadata -> Text
message Metadata
metadata),
      location :: Location
location = String -> Int -> Location
LocLine (Text -> String
Text.unpack Text
filename) Int
linenumber,
      impact :: String
impact = Severity -> String
severityText (Metadata -> Severity
severity Metadata
metadata)
    }

severityText :: Severity -> String
severityText :: Severity -> String
severityText Severity
severity =
  case Severity
severity of
    Severity
ErrorC -> String
"blocker"
    Severity
WarningC -> String
"major"
    Severity
InfoC -> String
"info"
    Severity
StyleC -> String
"minor"

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 = do
      ByteString -> IO ()
B.putStr (a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
value)
      ByteString -> IO ()
B.putStr (Word8 -> ByteString
B.singleton Word8
0x00)