module Hadolint.Formatter.TTY
  ( hWrite,
    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 System.IO (Handle, hPutStrLn)
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 :: forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
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 :: RuleCode
code :: CheckFailure -> RuleCode
code, DLSeverity
severity :: DLSeverity
severity :: CheckFailure -> DLSeverity
severity, Linenumber
line :: Linenumber
line :: CheckFailure -> Linenumber
line, Text
message :: Text
message :: CheckFailure -> 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
" "

hWrite ::
  (VisualStream s, TraversableStream s, ShowErrorComponent e, Foldl.Foldable f) =>
  Handle ->
  f (Result s e) ->
  Bool ->
  IO ()
hWrite :: forall s e (f :: * -> *).
(VisualStream s, TraversableStream s, ShowErrorComponent e,
 Foldable f) =>
Handle -> f (Result s e) -> Bool -> IO ()
hWrite Handle
handle 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 ()
writeResult f (Result s e)
results
  where
    writeResult :: Result s e -> IO ()
writeResult Result {Text
fileName :: Text
fileName :: forall s e. Result s e -> Text
fileName, Seq (ParseErrorBundle s e)
errors :: Seq (ParseErrorBundle s e)
errors :: forall s e. Result s e -> Seq (ParseErrorBundle s e)
errors, Failures
checks :: Failures
checks :: forall s e. Result s e -> Failures
checks} = Seq (ParseErrorBundle s e) -> IO ()
writeErrors Seq (ParseErrorBundle s e)
errors IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Failures -> IO ()
forall {t :: * -> *}. Foldable t => Text -> t CheckFailure -> IO ()
writeChecks Text
fileName Failures
checks
    writeErrors :: Seq (ParseErrorBundle s e) -> IO ()
writeErrors = (ParseErrorBundle s e -> IO ())
-> Seq (ParseErrorBundle s e) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
handle (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)
    writeChecks :: Text -> t CheckFailure -> IO ()
writeChecks Text
fileName = (CheckFailure -> IO ()) -> t CheckFailure -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> String -> IO ()
hPutStrLn Handle
handle (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)

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