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 (TextBuilder -> Text)
-> (ErrAtPath -> TextBuilder) -> ErrAtPath -> Text
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 :: foldable Text -> TextBuilder
path foldable Text
a =
  TextBuilder
"/" TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder -> foldable TextBuilder -> TextBuilder
forall (foldable :: * -> *).
Foldable foldable =>
TextBuilder -> foldable TextBuilder -> TextBuilder
intercalate TextBuilder
"/" ((Text -> TextBuilder) -> foldable Text -> foldable TextBuilder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TextBuilder
text foldable Text
a)

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

reason :: Err -> TextBuilder
reason =
  \case
    Err.KeyErr String
a Text
b Text
c ->
      Text -> TextBuilder
text Text
c TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
". On input: " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string (Text -> String
forall a. Show a => a -> String
show Text
b) TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
". "
        TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
"Expecting: "
        TextBuilder -> TextBuilder -> TextBuilder
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 " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> CaseSensitive -> TextBuilder
forall a. (Semigroup a, IsString a) => CaseSensitive -> a
caseSensitively CaseSensitive
b TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
": " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string ([Text] -> String
forall a. Show a => a -> String
show [Text]
d) TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
". "
        TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
"Keys available: "
        TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string ([Text] -> String
forall a. Show a => a -> String
show [Text]
c)
    Err.NoneOfSequenceKeysFoundErr ByKey Int
a [Int]
b ->
      TextBuilder
"None of indices found: " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string ([Int] -> String
forall a. Show a => a -> String
show [Int]
b)
    Err.ScalarErr [Scalar]
a ByteString
b Tag
c Style
d Maybe Text
e ->
      (Text -> TextBuilder) -> Maybe Text -> TextBuilder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
a -> Text -> TextBuilder
text Text
a TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
". ") ((Text -> Bool) -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => (a -> Bool) -> m a -> m a
mfilter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
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)
        TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
"Expecting one of the following formats: "
        TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder -> [TextBuilder] -> TextBuilder
forall (foldable :: * -> *).
Foldable foldable =>
TextBuilder -> foldable TextBuilder -> TextBuilder
intercalate TextBuilder
", " ((Scalar -> TextBuilder) -> [Scalar] -> [TextBuilder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scalar -> TextBuilder
scalarExpectation [Scalar]
a)
        TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> (Text -> TextBuilder)
-> Either UnicodeException Text -> TextBuilder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
a -> TextBuilder
". Got input: " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string (Text -> 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: " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> TextBuilder
text Text
a
    Err.NotEnoughElementsErr ByOrder
a Int
b ->
      TextBuilder
"Not enough elements: " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal Int
b TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
". "
        TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
"Expecting: "
        TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> ByOrder -> TextBuilder
byOrderExpectation ByOrder
a

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 " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> MaxInputSize -> TextBuilder
maxInputSize MaxInputSize
a TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
" chars"
    Ex.BoundedIntegerScalar Signed
a NumeralSystem
b ->
      Signed -> TextBuilder
forall a. IsString a => Signed -> a
signed Signed
a TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
" " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> NumeralSystem -> TextBuilder
forall p. IsString p => NumeralSystem -> p
numeralSystem NumeralSystem
b
    Ex.UnboundedIntegerScalar MaxInputSize
a Signed
b NumeralSystem
c ->
      Signed -> TextBuilder
forall a. IsString a => Signed -> a
signed Signed
b TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
" " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> NumeralSystem -> TextBuilder
forall p. IsString p => NumeralSystem -> p
numeralSystem NumeralSystem
c TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
" of maximum length of " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> MaxInputSize -> TextBuilder
maxInputSize MaxInputSize
a TextBuilder -> TextBuilder -> TextBuilder
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 :: String -> TextBuilder
stringExpectation =
  \case
    String
Ex.AnyString ->
      TextBuilder
"any string"
    Ex.OneOfString CaseSensitive
a [Text]
b ->
      TextBuilder
"one of " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
string ([Text] -> String
forall a. Show a => a -> String
show [Text]
b) TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
"(" TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> CaseSensitive -> TextBuilder
forall a. (Semigroup a, IsString a) => CaseSensitive -> a
caseSensitive CaseSensitive
a TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
")"
    Ex.FormattedString Text
a ->
      Text -> TextBuilder
text Text
a

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

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

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

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

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

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