module YamlUnscrambler.CompactErrRendering
  ( renderErrAtPath,
  )
where

import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import TextBuilderDev
import qualified YamlUnscrambler.Err as Err
import qualified YamlUnscrambler.Expectations as Ex
import YamlUnscrambler.Model
import YamlUnscrambler.Prelude hiding (intercalate)

renderErrAtPath :: Err.ErrAtPath -> Text
renderErrAtPath :: ErrAtPath -> Text
renderErrAtPath =
  TextBuilder -> Text
buildText forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ErrAtPath -> TextBuilder
errAtPath

path :: [Text] -> TextBuilder
path :: [Text] -> TextBuilder
path [Text]
a =
  TextBuilder
"/" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *).
Foldable f =>
TextBuilder -> f TextBuilder -> TextBuilder
intercalate TextBuilder
"/" (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TextBuilder
text [Text]
a)

errAtPath :: Err.ErrAtPath -> TextBuilder
errAtPath :: ErrAtPath -> TextBuilder
errAtPath (Err.ErrAtPath [Text]
a Err
b) =
  TextBuilder
"Error at path " forall a. Semigroup a => a -> a -> a
<> [Text] -> TextBuilder
path [Text]
a forall a. Semigroup a => a -> a -> a
<> TextBuilder
". " forall a. Semigroup a => a -> a -> a
<> Err -> TextBuilder
reason Err
b

reason :: Err.Err -> TextBuilder
reason :: Err -> TextBuilder
reason =
  \case
    Err.KeyErr String
a Text
b Text
c ->
      Text -> TextBuilder
text Text
c
        forall a. Semigroup a => a -> a -> a
<> TextBuilder
". On input: "
        forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string (forall a. Show a => a -> String
show Text
b)
        forall a. Semigroup a => a -> a -> a
<> TextBuilder
". "
        forall a. Semigroup a => a -> a -> a
<> TextBuilder
"Expecting: "
        forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
stringExpectation String
a
    Err.NoneOfMappingKeysFoundErr ByKey Text
a CaseSensitive
b [Text]
c [Text]
d ->
      TextBuilder
"None of keys found "
        forall a. Semigroup a => a -> a -> a
<> CaseSensitive -> TextBuilder
caseSensitively CaseSensitive
b
        forall a. Semigroup a => a -> a -> a
<> TextBuilder
": "
        forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string (forall a. Show a => a -> String
show [Text]
d)
        forall a. Semigroup a => a -> a -> a
<> TextBuilder
". "
        forall a. Semigroup a => a -> a -> a
<> TextBuilder
"Keys available: "
        forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string (forall a. Show a => a -> String
show [Text]
c)
    Err.NoneOfSequenceKeysFoundErr ByKey Int
a [Int]
b ->
      TextBuilder
"None of indices found: " forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string (forall a. Show a => a -> String
show [Int]
b)
    Err.ScalarErr [Scalar]
a ByteString
b Tag
c Style
d Maybe Text
e ->
      forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
a -> Text -> TextBuilder
text Text
a forall a. Semigroup a => a -> a -> a
<> TextBuilder
". ") (forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Bool
Text.null) Maybe Text
e)
        forall a. Semigroup a => a -> a -> a
<> TextBuilder
"Expecting one of the following formats: "
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *).
Foldable f =>
TextBuilder -> f TextBuilder -> TextBuilder
intercalate TextBuilder
", " (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scalar -> TextBuilder
scalarExpectation [Scalar]
a)
        forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
a -> TextBuilder
". Got input: " forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string (forall a. Show a => a -> String
show Text
a)) (ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
b)
    Err.UnexpectedScalarErr Value
a ->
      TextBuilder
"Unexpected scalar value"
    Err.UnexpectedMappingErr Value
a ->
      TextBuilder
"Unexpected mapping value"
    Err.UnexpectedSequenceErr Value
a ->
      TextBuilder
"Unexpected sequence value"
    Err.UnknownAnchorErr Text
a ->
      TextBuilder
"Unknown anchor: " forall a. Semigroup a => a -> a -> a
<> Text -> TextBuilder
text Text
a
    Err.NotEnoughElementsErr ByOrder
a Int
b ->
      TextBuilder
"Not enough elements: "
        forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => a -> TextBuilder
decimal Int
b
        forall a. Semigroup a => a -> a -> a
<> TextBuilder
". "
        forall a. Semigroup a => a -> a -> a
<> TextBuilder
"Expecting: "
        forall a. Semigroup a => a -> a -> a
<> ByOrder -> TextBuilder
byOrderExpectation ByOrder
a

scalarExpectation :: Ex.Scalar -> TextBuilder
scalarExpectation :: Scalar -> TextBuilder
scalarExpectation =
  \case
    Ex.StringScalar String
a ->
      String -> TextBuilder
stringExpectation String
a
    Scalar
Ex.NullScalar ->
      TextBuilder
"null"
    Scalar
Ex.BoolScalar ->
      TextBuilder
"boolean"
    Scalar
Ex.ScientificScalar ->
      TextBuilder
"scientific"
    Scalar
Ex.DoubleScalar ->
      TextBuilder
"double"
    Ex.RationalScalar MaxInputSize
a ->
      TextBuilder
"rational of maximum length of " forall a. Semigroup a => a -> a -> a
<> MaxInputSize -> TextBuilder
maxInputSize MaxInputSize
a forall a. Semigroup a => a -> a -> a
<> TextBuilder
" chars"
    Ex.BoundedIntegerScalar Signed
a NumeralSystem
b ->
      Signed -> TextBuilder
signed Signed
a forall a. Semigroup a => a -> a -> a
<> TextBuilder
" " forall a. Semigroup a => a -> a -> a
<> NumeralSystem -> TextBuilder
numeralSystem NumeralSystem
b
    Ex.UnboundedIntegerScalar MaxInputSize
a Signed
b NumeralSystem
c ->
      Signed -> TextBuilder
signed Signed
b forall a. Semigroup a => a -> a -> a
<> TextBuilder
" " forall a. Semigroup a => a -> a -> a
<> NumeralSystem -> TextBuilder
numeralSystem NumeralSystem
c forall a. Semigroup a => a -> a -> a
<> TextBuilder
" of maximum length of " forall a. Semigroup a => a -> a -> a
<> MaxInputSize -> TextBuilder
maxInputSize MaxInputSize
a forall a. Semigroup a => a -> a -> a
<> TextBuilder
" chars"
    Scalar
Ex.Iso8601TimestampScalar ->
      TextBuilder
"timestamp in ISO-8601"
    Scalar
Ex.Iso8601DayScalar ->
      TextBuilder
"date in ISO-8601"
    Scalar
Ex.Iso8601TimeScalar ->
      TextBuilder
"time in ISO-8601"
    Scalar
Ex.UuidScalar ->
      TextBuilder
"UUID"
    Scalar
Ex.Base64BinaryScalar ->
      TextBuilder
"binary data in Base-64"

stringExpectation :: Ex.String -> TextBuilder
stringExpectation :: String -> TextBuilder
stringExpectation =
  \case
    String
Ex.AnyString ->
      TextBuilder
"any string"
    Ex.OneOfString CaseSensitive
a [Text]
b ->
      TextBuilder
"one of " forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string (forall a. Show a => a -> String
show [Text]
b) forall a. Semigroup a => a -> a -> a
<> TextBuilder
"(" forall a. Semigroup a => a -> a -> a
<> CaseSensitive -> TextBuilder
caseSensitive CaseSensitive
a forall a. Semigroup a => a -> a -> a
<> TextBuilder
")"
    Ex.FormattedString Text
a ->
      Text -> TextBuilder
text Text
a

byOrderExpectation :: Ex.ByOrder -> TextBuilder
byOrderExpectation :: ByOrder -> TextBuilder
byOrderExpectation =
  forall a. Integral a => a -> TextBuilder
decimal @Integer forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {t}. Enum t => t -> ByOrder -> t
count Integer
0
  where
    count :: t -> ByOrder -> t
count !t
a =
      \case
        ByOrder
Ex.AnyByOrder ->
          t
a
        Ex.BothByOrder ByOrder
b ByOrder
c ->
          t -> ByOrder -> ByOrder -> t
countBoth t
a ByOrder
b ByOrder
c
        Ex.FetchByOrder Value
_ ->
          forall a. Enum a => a -> a
succ t
a
    countBoth :: t -> ByOrder -> ByOrder -> t
countBoth t
a ByOrder
b ByOrder
c =
      case ByOrder
b of
        Ex.BothByOrder ByOrder
d ByOrder
e ->
          t -> ByOrder -> ByOrder -> t
countBoth t
a ByOrder
d (ByOrder -> ByOrder -> ByOrder
Ex.BothByOrder ByOrder
e ByOrder
c)
        ByOrder
Ex.AnyByOrder ->
          t -> ByOrder -> t
count t
a ByOrder
c
        Ex.FetchByOrder Value
_ ->
          t -> ByOrder -> t
count (forall a. Enum a => a -> a
succ t
a) ByOrder
c

caseSensitive :: CaseSensitive -> TextBuilder
caseSensitive :: CaseSensitive -> TextBuilder
caseSensitive (CaseSensitive Bool
a) =
  TextBuilder
"case-" forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool TextBuilder
"insensitive" TextBuilder
"sensitive" Bool
a

caseSensitively :: CaseSensitive -> TextBuilder
caseSensitively :: CaseSensitive -> TextBuilder
caseSensitively (CaseSensitive Bool
a) =
  TextBuilder
"case-" forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool TextBuilder
"insensitively" TextBuilder
"sensitively" Bool
a

signed :: Signed -> TextBuilder
signed :: Signed -> TextBuilder
signed (Signed Bool
a) =
  forall a. a -> a -> Bool -> a
bool TextBuilder
"unsigned" TextBuilder
"signed" Bool
a

numeralSystem :: NumeralSystem -> TextBuilder
numeralSystem :: NumeralSystem -> TextBuilder
numeralSystem =
  \case
    NumeralSystem
DecimalNumeralSystem ->
      TextBuilder
"decimal"
    NumeralSystem
HexadecimalNumeralSystem ->
      TextBuilder
"hexadecimal"

maxInputSize :: MaxInputSize -> TextBuilder
maxInputSize :: MaxInputSize -> TextBuilder
maxInputSize (MaxInputSize Int
a) =
  forall a. Integral a => a -> TextBuilder
decimal Int
a