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

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

import Data.Semigroup ((<>))
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 -> f Text.Text
formatChecks :: f RuleCheck -> f Text
formatChecks = (RuleCheck -> Text) -> f RuleCheck -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RuleCheck -> Text
formatCheck
  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
<> String -> Text
Text.pack (Severity -> String
severityText (Metadata -> Severity
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 -> IO ()
printResult :: Result s e -> 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} = 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 -> Seq Text
forall (f :: * -> *). Functor f => f RuleCheck -> f Text
formatChecks Seq RuleCheck
checks)