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

import Data.List (sort)
import qualified Data.List.NonEmpty as NE
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Hadolint.Rules
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

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 :: DLSeverity -> String
severityText :: DLSeverity -> String
severityText DLSeverity
s =
  case DLSeverity
s of
    DLSeverity
DLErrorC -> String
"error"
    DLSeverity
DLWarningC -> String
"warning"
    DLSeverity
DLInfoC -> String
"info"
    DLSeverity
DLStyleC -> String
"style"
    DLSeverity
_ -> String
""

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