module YamlUnscrambler.CompactErrRendering
(
  renderErrAtPath,
)
where

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


renderErrAtPath :: Err.ErrAtPath -> Text
renderErrAtPath :: ErrAtPath -> Text
renderErrAtPath =
  Builder -> Text
run (Builder -> Text) -> (ErrAtPath -> Builder) -> 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 -> Builder
errAtPath

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

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

reason :: Err -> Builder
reason =
  \ case
    Err.KeyErr String
a Text
b Text
c ->
      Text -> Builder
text Text
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
". On input: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string (Text -> String
forall a. Show a => a -> String
show Text
b) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
". " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
"Expecting: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
stringExpectation String
a
    Err.NoneOfMappingKeysFoundErr ByKey Text
a CaseSensitive
b [Text]
c [Text]
d ->
      Builder
"None of keys found " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> CaseSensitive -> Builder
forall a. (Semigroup a, IsString a) => CaseSensitive -> a
caseSensitively CaseSensitive
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string ([Text] -> String
forall a. Show a => a -> String
show [Text]
d) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
". " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
"Keys available: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string ([Text] -> String
forall a. Show a => a -> String
show [Text]
c)
    Err.NoneOfSequenceKeysFoundErr ByKey Int
a [Int]
b ->
      Builder
"None of indices found: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
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 -> Builder) -> Maybe Text -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ Text
a -> Text -> Builder
text Text
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
". ") ((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) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
"Expecting one of the following formats: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder -> [Builder] -> Builder
forall (foldable :: * -> *).
Foldable foldable =>
Builder -> foldable Builder -> Builder
intercalate Builder
", " ((Scalar -> Builder) -> [Scalar] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scalar -> Builder
scalarExpectation [Scalar]
a) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      (Text -> Builder) -> Either UnicodeException Text -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ Text
a -> Builder
". Got input: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string (Text -> String
forall a. Show a => a -> String
show Text
a)) (ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
b)
    Err.UnexpectedScalarErr Value
a ->
      Builder
"Unexpected scalar value"
    Err.UnexpectedMappingErr Value
a ->
      Builder
"Unexpected mapping value"
    Err.UnexpectedSequenceErr Value
a ->
      Builder
"Unexpected sequence value"
    Err.UnknownAnchorErr Text
a ->
      Builder
"Unknown anchor: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
text Text
a
    Err.NotEnoughElementsErr ByOrder
a Int
b ->
      Builder
"Not enough elements: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
decimal Int
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
". " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
"Expecting: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByOrder -> Builder
byOrderExpectation ByOrder
a

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

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

byOrderExpectation :: ByOrder -> Builder
byOrderExpectation =
  Integer -> Builder
forall a. Integral a => a -> Builder
decimal (Integer -> Builder) -> (ByOrder -> Integer) -> ByOrder -> Builder
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 -> Builder
maxInputSize (MaxInputSize Int
a) =
  Int -> Builder
forall a. Integral a => a -> Builder
decimal Int
a