module Hadolint.Formatter.Format
  ( severityText,
    stripNewlines,
    errorMessageLine,
    errorPosition,
    errorPositionPretty,
    Text.Megaparsec.Error.errorBundlePretty,
    Result (..),
    isEmpty,
    toResult,
  )
where

import Data.List (sort)
import qualified Data.List.NonEmpty as NE
import Data.Monoid (Monoid)
import Data.Semigroup
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Hadolint.Rules
import ShellCheck.Interface
import Text.Megaparsec (TraversableStream (..), pstateSourcePos)
import Text.Megaparsec.Error
import Text.Megaparsec.Pos (SourcePos, sourcePosPretty)
import Text.Megaparsec.Stream (VisualStream)

data Result s e = Result
  { Result s e -> Seq (ParseErrorBundle s e)
errors :: !(Seq (ParseErrorBundle s e)),
    Result s e -> Seq RuleCheck
checks :: !(Seq RuleCheck)
  }

instance Semigroup (Result s e) where
  (Result Seq (ParseErrorBundle s e)
e1 Seq RuleCheck
c1) <> :: Result s e -> Result s e -> Result s e
<> (Result Seq (ParseErrorBundle s e)
e2 Seq RuleCheck
c2) = Seq (ParseErrorBundle s e) -> Seq RuleCheck -> Result s e
forall s e.
Seq (ParseErrorBundle s e) -> Seq RuleCheck -> Result s e
Result (Seq (ParseErrorBundle s e)
e1 Seq (ParseErrorBundle s e)
-> Seq (ParseErrorBundle s e) -> Seq (ParseErrorBundle s e)
forall a. Semigroup a => a -> a -> a
<> Seq (ParseErrorBundle s e)
e2) (Seq RuleCheck
c1 Seq RuleCheck -> Seq RuleCheck -> Seq RuleCheck
forall a. Semigroup a => a -> a -> a
<> Seq RuleCheck
c2)

instance Monoid (Result s e) where
  mappend :: Result s e -> Result s e -> Result s e
mappend = Result s e -> Result s e -> Result s e
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Result s e
mempty = Seq (ParseErrorBundle s e) -> Seq RuleCheck -> Result s e
forall s e.
Seq (ParseErrorBundle s e) -> Seq RuleCheck -> Result s e
Result Seq (ParseErrorBundle s e)
forall a. Monoid a => a
mempty Seq RuleCheck
forall a. Monoid a => a
mempty

isEmpty :: Result s e -> Bool
isEmpty :: Result s e -> Bool
isEmpty (Result Seq (ParseErrorBundle s e)
Seq.Empty Seq RuleCheck
Seq.Empty) = Bool
True
isEmpty Result s e
_ = Bool
False

toResult :: Either (ParseErrorBundle s e) [RuleCheck] -> Result s e
toResult :: Either (ParseErrorBundle s e) [RuleCheck] -> Result s e
toResult Either (ParseErrorBundle s e) [RuleCheck]
res =
  case Either (ParseErrorBundle s e) [RuleCheck]
res of
    Left ParseErrorBundle s e
err -> Seq (ParseErrorBundle s e) -> Seq RuleCheck -> Result s e
forall s e.
Seq (ParseErrorBundle s e) -> Seq RuleCheck -> Result s e
Result (ParseErrorBundle s e -> Seq (ParseErrorBundle s e)
forall a. a -> Seq a
Seq.singleton ParseErrorBundle s e
err) Seq RuleCheck
forall a. Monoid a => a
mempty
    Right [RuleCheck]
c -> Seq (ParseErrorBundle s e) -> Seq RuleCheck -> Result s e
forall s e.
Seq (ParseErrorBundle s e) -> Seq RuleCheck -> Result s e
Result Seq (ParseErrorBundle s e)
forall a. Monoid a => a
mempty ([RuleCheck] -> Seq RuleCheck
forall a. [a] -> Seq a
Seq.fromList ([RuleCheck] -> [RuleCheck]
forall a. Ord a => [a] -> [a]
sort [RuleCheck]
c))

severityText :: Severity -> String
severityText :: Severity -> String
severityText Severity
s =
  case Severity
s of
    Severity
ErrorC -> String
"error"
    Severity
WarningC -> String
"warning"
    Severity
InfoC -> String
"info"
    Severity
StyleC -> String
"style"

stripNewlines :: String -> String
stripNewlines :: String -> String
stripNewlines =
  (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map
    ( \Char
c ->
        if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
          then Char
' '
          else Char
c
    )

errorMessageLine :: (VisualStream s, TraversableStream s, ShowErrorComponent e) => ParseErrorBundle s e -> String
errorMessageLine :: ParseErrorBundle s e -> String
errorMessageLine err :: ParseErrorBundle s e
err@(ParseErrorBundle NonEmpty (ParseError s e)
e PosState s
_) =
  ParseErrorBundle s e -> String
forall s e. TraversableStream s => ParseErrorBundle s e -> String
errorPositionPretty ParseErrorBundle s e
err String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError s e -> String
forall s e.
(VisualStream s, ShowErrorComponent e) =>
ParseError s e -> String
parseErrorTextPretty (NonEmpty (ParseError s e) -> ParseError s e
forall a. NonEmpty a -> a
NE.head NonEmpty (ParseError s e)
e)

errorPositionPretty :: TraversableStream s => ParseErrorBundle s e -> String
errorPositionPretty :: ParseErrorBundle s e -> String
errorPositionPretty ParseErrorBundle s e
err = SourcePos -> String
sourcePosPretty (ParseErrorBundle s e -> SourcePos
forall s e.
TraversableStream s =>
ParseErrorBundle s e -> SourcePos
errorPosition ParseErrorBundle s e
err)

errorPosition :: TraversableStream s => ParseErrorBundle s e -> Text.Megaparsec.Pos.SourcePos
errorPosition :: ParseErrorBundle s e -> SourcePos
errorPosition (ParseErrorBundle NonEmpty (ParseError s e)
e PosState s
s) =
  let (Maybe String
_, PosState s
posState) = Int -> PosState s -> (Maybe String, PosState s)
forall s.
TraversableStream s =>
Int -> PosState s -> (Maybe String, PosState s)
reachOffset (ParseError s e -> Int
forall s e. ParseError s e -> Int
errorOffset (NonEmpty (ParseError s e) -> ParseError s e
forall a. NonEmpty a -> a
NE.head NonEmpty (ParseError s e)
e)) PosState s
s
   in PosState s -> SourcePos
forall s. PosState s -> SourcePos
pstateSourcePos PosState s
posState