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

module Hadolint.Formatter.TTY
  ( printResult,
    formatError,
    formatChecks,
  )
where

import Colourista
import qualified Data.Text as Text
import Hadolint.Formatter.Format
import Hadolint.Rules
import Language.Docker.Syntax
import Text.Megaparsec (TraversableStream)
import Text.Megaparsec.Error
import Text.Megaparsec.Stream (VisualStream)

formatErrors :: (VisualStream s, TraversableStream s, ShowErrorComponent e, Functor f) => f (ParseErrorBundle s e) -> f String
formatErrors :: f (ParseErrorBundle s e) -> f String
formatErrors = (ParseErrorBundle s e -> String)
-> f (ParseErrorBundle s e) -> f String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseErrorBundle s e -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
formatError

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)

formatChecks :: Functor f => f RuleCheck -> Bool -> f Text.Text
formatChecks :: f RuleCheck -> Bool -> f Text
formatChecks f RuleCheck
rc Bool
nocolor = (RuleCheck -> Text) -> f RuleCheck -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RuleCheck -> Text
formatCheck f RuleCheck
rc
  where
    formatCheck :: RuleCheck -> Text
formatCheck (RuleCheck Metadata
meta Text
source Linenumber
line Bool
_) =
      Text -> Linenumber -> Text
formatPos Text
source Linenumber
line
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Metadata -> Text
code Metadata
meta
          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 String -> Text
Text.pack (DLSeverity -> String
severityText (Metadata -> DLSeverity
severity Metadata
meta))
                         else DLSeverity -> Text
colorizedSeverity (Metadata -> DLSeverity
severity Metadata
meta))
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Metadata -> Text
message Metadata
meta

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
" "

printResult :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => Result s e -> Bool -> IO ()
printResult :: Result s e -> Bool -> IO ()
printResult Result {Seq (ParseErrorBundle s e)
errors :: forall s e. Result s e -> Seq (ParseErrorBundle s e)
errors :: Seq (ParseErrorBundle s e)
errors, Seq RuleCheck
checks :: forall s e. Result s e -> Seq RuleCheck
checks :: Seq RuleCheck
checks} Bool
color = IO ()
printErrors IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
printChecks
  where
    printErrors :: IO ()
printErrors = (String -> IO ()) -> Seq String -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn (Seq (ParseErrorBundle s e) -> Seq String
forall s e (f :: * -> *).
(VisualStream s, TraversableStream s, ShowErrorComponent e,
 Functor f) =>
f (ParseErrorBundle s e) -> f String
formatErrors Seq (ParseErrorBundle s e)
errors)
    printChecks :: IO ()
printChecks = (Text -> IO ()) -> Seq Text -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) (Seq RuleCheck -> Bool -> Seq Text
forall (f :: * -> *). Functor f => f RuleCheck -> Bool -> f Text
formatChecks Seq RuleCheck
checks Bool
color)

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