{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module Hadolint.Formatter.TTY
  ( printResults,
    formatCheck,
    formatError,
  )
where

import Colourista
import qualified Control.Foldl as Foldl
import qualified Data.Text as Text
import Hadolint.Formatter.Format
import Hadolint.Rule (CheckFailure (..), DLSeverity (..), RuleCode (..))
import Language.Docker.Syntax
import Text.Megaparsec (TraversableStream)
import Text.Megaparsec.Error
import Text.Megaparsec.Stream (VisualStream)

formatError :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String
formatError :: ParseErrorBundle s e -> String
formatError ParseErrorBundle s e
err = String -> String
stripNewlines (ParseErrorBundle s e -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorMessageLine ParseErrorBundle s e
err)

formatCheck :: Bool -> Text.Text -> CheckFailure -> Text.Text
formatCheck :: Bool -> Text -> CheckFailure -> Text
formatCheck Bool
nocolor Text
source CheckFailure {RuleCode
code :: CheckFailure -> RuleCode
code :: RuleCode
code, DLSeverity
severity :: CheckFailure -> DLSeverity
severity :: DLSeverity
severity, Linenumber
line :: CheckFailure -> Linenumber
line :: Linenumber
line, Text
message :: CheckFailure -> Text
message :: Text
message} =
  Text -> Linenumber -> Text
formatPos Text
source Linenumber
line
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RuleCode -> Text
unRuleCode RuleCode
code
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ( if Bool
nocolor
           then DLSeverity -> Text
severityText DLSeverity
severity
           else DLSeverity -> Text
colorizedSeverity DLSeverity
severity
       )
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
message

formatPos :: Filename -> Linenumber -> Text.Text
formatPos :: Text -> Linenumber -> Text
formatPos Text
source Linenumber
line = Text
source Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Linenumber -> String
forall a. Show a => a -> String
show Linenumber
line) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "

printResults ::
  (VisualStream s, TraversableStream s, ShowErrorComponent e, Foldl.Foldable f) =>
  f (Result s e) ->
  Bool ->
  IO ()
printResults :: f (Result s e) -> Bool -> IO ()
printResults f (Result s e)
results Bool
color = (Result s e -> IO ()) -> f (Result s e) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Result s e -> IO ()
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
Result s e -> IO ()
printResult f (Result s e)
results
  where
    printResult :: Result s e -> IO ()
printResult Result {Text
fileName :: forall s e. Result s e -> Text
fileName :: Text
fileName, Seq (ParseErrorBundle s e)
errors :: forall s e. Result s e -> Seq (ParseErrorBundle s e)
errors :: Seq (ParseErrorBundle s e)
errors, Failures
checks :: forall s e. Result s e -> Failures
checks :: Failures
checks} = Seq (ParseErrorBundle s e) -> IO ()
forall (t :: * -> *) s e.
(Foldable t, VisualStream s, TraversableStream s,
 ShowErrorComponent e) =>
t (ParseErrorBundle s e) -> IO ()
printErrors Seq (ParseErrorBundle s e)
errors IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Failures -> IO ()
forall (t :: * -> *). Foldable t => Text -> t CheckFailure -> IO ()
printChecks Text
fileName Failures
checks
    printErrors :: t (ParseErrorBundle s e) -> IO ()
printErrors t (ParseErrorBundle s e)
errors = (ParseErrorBundle s e -> IO ())
-> t (ParseErrorBundle s e) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ())
-> (ParseErrorBundle s e -> String)
-> ParseErrorBundle s e
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle s e -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
formatError) t (ParseErrorBundle s e)
errors
    printChecks :: Text -> t CheckFailure -> IO ()
printChecks Text
fileName t CheckFailure
checks = (CheckFailure -> IO ()) -> t CheckFailure -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ())
-> (CheckFailure -> String) -> CheckFailure -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> String)
-> (CheckFailure -> Text) -> CheckFailure -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> CheckFailure -> Text
formatCheck Bool
color Text
fileName) t CheckFailure
checks

colorizedSeverity :: DLSeverity -> Text.Text
colorizedSeverity :: DLSeverity -> Text
colorizedSeverity DLSeverity
s =
  case DLSeverity
s of
    DLSeverity
DLErrorC -> [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
bold, Text
forall str. IsString str => str
red] (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ DLSeverity -> Text
severityText DLSeverity
s
    DLSeverity
DLWarningC -> [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
bold, Text
forall str. IsString str => str
yellow] (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ DLSeverity -> Text
severityText DLSeverity
s
    DLSeverity
DLInfoC -> [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
green] (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ DLSeverity -> Text
severityText DLSeverity
s
    DLSeverity
DLStyleC -> [Text] -> Text -> Text
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [Text
forall str. IsString str => str
cyan] (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ DLSeverity -> Text
severityText DLSeverity
s
    DLSeverity
_ -> DLSeverity -> Text
severityText DLSeverity
s