{-# OPTIONS_GHC -Wno-orphans #-}

module Data.OpenApi.Compare.Validate.Schema.Issues
  ( Issue (..),
    Behave (..),
  )
where

import qualified Data.Aeson as A
import Data.OpenApi
import Data.OpenApi.Compare.Behavior
import Data.OpenApi.Compare.Subtree
import Data.OpenApi.Compare.Validate.Schema.JsonFormula
import Data.OpenApi.Compare.Validate.Schema.Partition
import Data.OpenApi.Compare.Validate.Schema.TypedJson
import Data.Scientific
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Builder hiding (Format, Null)

instance Issuable 'TypedSchemaLevel where
  data Issue 'TypedSchemaLevel
    = -- | producer produces a specific value ($1), consumer has a condition that is not satisfied by said value
      EnumDoesntSatisfy A.Value
    | -- | consumer only expects a specific value which the producer does not produce.
      NoMatchingEnum A.Value
    | -- | consumer declares a maximum numeric value ($1), producer doesn't
      NoMatchingMaximum (Bound Scientific)
    | -- | consumer declares a maximum numeric value ($1), producer declares a weaker (higher) limit ($2)
      MatchingMaximumWeak (ProdCons (Bound Scientific))
    | -- | consumer declares a minimum numeric value, producer doesn't
      NoMatchingMinimum (Bound Scientific)
    | -- | consumer declares a minimum numeric value ($1), producer declares a weaker (lower) limit ($2)
      MatchingMinimumWeak (ProdCons (Bound Scientific))
    | -- | consumer declares that the numeric value must be a multiple of $1, producer doesn't
      NoMatchingMultipleOf Scientific
    | -- | consumer declares that the numeric value must be a multiple of $1, producer declares a weaker condition (multiple of $2)
      MatchingMultipleOfWeak (ProdCons Scientific)
    | -- | consumer declares a string/number format, producer declares none or a different format (TODO: improve via regex #32)
      NoMatchingFormat Format
    | -- | consumer declares a maximum length of the string ($1), producer doesn't.
      NoMatchingMaxLength Integer
    | -- | consumer declares a maximum length of the string ($1), producer declares a weaker (higher) limit ($2)
      MatchingMaxLengthWeak (ProdCons Integer)
    | -- | consumer declares a minimum length of the string ($1), producer doesn't.
      NoMatchingMinLength Integer
    | -- | consumer declares a minimum length of the string ($1), producer declares a weaker (lower) limit ($2)
      MatchingMinLengthWeak (ProdCons Integer)
    | -- | consumer declares the string value must match a regex ($1), producer doesn't declare or declares different regex (TODO: #32)
      NoMatchingPattern Pattern
    | -- | consumer declares the items of an array must satisfy some condition, producer doesn't
      NoMatchingItems
    | -- | producer and consumer declare that an array must be a tuple of a fixed length, but the lengths don't match
      TupleItemsLengthChanged (ProdCons Integer)
    | -- | consumer declares that the array is a tuple, but the producer doesn't, the length constraints match, but there were issues with the components
      ArrayToTuple
    | -- | producer declares that the array is a tuple, but the consumer doesn't, and there were issues with the components
      TupleToArray
    | -- | consumer declares that the array is a tuple, but the producer doesn't, and there aren't sufficient length constraints
      NoMatchingTupleItems
    | -- | consumer declares a maximum length of the array ($1), producer doesn't.
      NoMatchingMaxItems Integer
    | -- | consumer declares a maximum length of the array ($1), producer declares a weaker (higher) limit ($2)
      MatchingMaxItemsWeak (ProdCons Integer)
    | -- | consumer declares a minimum length of the array ($1), producer doesn't.
      NoMatchingMinItems Integer
    | -- | consumer declares a minimum length of the array ($1), producer declares a weaker (lower) limit ($2)
      MatchingMinItemsWeak (ProdCons Integer)
    | -- | consumer declares that items must be unique, producer doesn't
      NoMatchingUniqueItems
    | -- | consumer declares the properties of an object must satisfy some condition, producer doesn't
      NoMatchingProperties
    | -- | producer allows additional properties, consumer doesn't
      NoAdditionalProperties
    | -- | consumer declares a maximum number of properties in the object ($1), producer doesn't.
      NoMatchingMaxProperties Integer
    | -- | consumer declares a maximum number of properties in the object ($1), producer declares a weaker (higher) limit ($2)
      MatchingMaxPropertiesWeak (ProdCons Integer)
    | -- | consumer declares a minimum number of properties in the object ($1), producer doesn't.
      NoMatchingMinProperties Integer
    | -- | consumer declares a minimum number of properties in the object ($1), producer declares a weaker (lower) limit ($2)
      MatchingMinPropertiesWeak (ProdCons Integer)
    | -- | producer declares that the value must satisfy a disjunction of some conditions, but consumer's requirements couldn't be matched against any single one of them (TODO: split heuristic #71)
      NoMatchingCondition (Maybe Partition) [SomeCondition]
    | -- | consumer indicates that no values of this type are allowed, but we weren't able to conclude that in the producer (currently only immediate contradictions are checked, c.f. #70)
      TypeBecomesEmpty
    | -- | consumer indicates that no values in a particular partition are allowed, but we weren't able to conclude this in the producer
      PartitionBecomesEmpty Partition
    deriving stock (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
(Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> Eq (Issue 'TypedSchemaLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
$c/= :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
== :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
$c== :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
Eq, Eq (Issue 'TypedSchemaLevel)
Eq (Issue 'TypedSchemaLevel)
-> (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Ordering)
-> (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel
    -> Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel)
-> (Issue 'TypedSchemaLevel
    -> Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel)
-> Ord (Issue 'TypedSchemaLevel)
Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Ordering
Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel
$cmin :: Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel
max :: Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel
$cmax :: Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel
>= :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
$c>= :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
> :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
$c> :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
<= :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
$c<= :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
< :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
$c< :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
compare :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Ordering
$ccompare :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Ordering
$cp1Ord :: Eq (Issue 'TypedSchemaLevel)
Ord, Int -> Issue 'TypedSchemaLevel -> ShowS
[Issue 'TypedSchemaLevel] -> ShowS
Issue 'TypedSchemaLevel -> String
(Int -> Issue 'TypedSchemaLevel -> ShowS)
-> (Issue 'TypedSchemaLevel -> String)
-> ([Issue 'TypedSchemaLevel] -> ShowS)
-> Show (Issue 'TypedSchemaLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issue 'TypedSchemaLevel] -> ShowS
$cshowList :: [Issue 'TypedSchemaLevel] -> ShowS
show :: Issue 'TypedSchemaLevel -> String
$cshow :: Issue 'TypedSchemaLevel -> String
showsPrec :: Int -> Issue 'TypedSchemaLevel -> ShowS
$cshowsPrec :: Int -> Issue 'TypedSchemaLevel -> ShowS
Show)
  issueKind :: Issue 'TypedSchemaLevel -> IssueKind
issueKind = \case
    NoMatchingEnum _ -> IssueKind
ProbablyIssue
    MatchingMaximumWeak _ -> IssueKind
ProbablyIssue -- interplay with MultipleOf could make this not an issue
    MatchingMinimumWeak _ -> IssueKind
ProbablyIssue -- ditto
    MatchingMultipleOfWeak _ -> IssueKind
ProbablyIssue -- ditto
    NoMatchingFormat _ -> IssueKind
Unsupported
    NoMatchingPattern _ -> IssueKind
Unsupported
    Issue 'TypedSchemaLevel
ArrayToTuple -> IssueKind
Comment
    Issue 'TypedSchemaLevel
TupleToArray -> IssueKind
Comment
    Issue 'TypedSchemaLevel
NoMatchingProperties -> IssueKind
ProbablyIssue -- TODO: #109
    Issue 'TypedSchemaLevel
TypeBecomesEmpty -> IssueKind
ProbablyIssue -- TODO: #70
    PartitionBecomesEmpty _ -> IssueKind
ProbablyIssue -- ditto
    Issue 'TypedSchemaLevel
_ -> IssueKind
CertainIssue
  relatedIssues :: Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
relatedIssues =
    Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Maybe Value)
-> Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
      EnumDoesntSatisfy v -> Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
      NoMatchingEnum v -> Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
      Issue 'TypedSchemaLevel
_ -> Maybe Value
forall a. Maybe a
Nothing
      (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Maybe ())
-> Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
        NoMatchingMaximum _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        MatchingMaximumWeak _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
      (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Maybe ())
-> Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
        NoMatchingMinimum _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        MatchingMinimumWeak _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
      (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Maybe ())
-> Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
        NoMatchingMultipleOf _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        MatchingMultipleOfWeak _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
      (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Maybe ())
-> Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
        NoMatchingMaxLength _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        MatchingMaxLengthWeak _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
      (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Maybe ())
-> Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
        NoMatchingMinLength _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        MatchingMinLengthWeak _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
      (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Maybe ())
-> Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
        Issue 'TypedSchemaLevel
NoMatchingItems -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
ArrayToTuple -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
TupleToArray -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
NoMatchingTupleItems -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        TupleItemsLengthChanged _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
      (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Maybe ())
-> Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
        NoMatchingMaxItems _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        MatchingMaxItemsWeak _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
      (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Maybe ())
-> Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
        NoMatchingMinItems _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        MatchingMinItemsWeak _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
      (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Maybe ())
-> Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
        NoMatchingMaxProperties _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        MatchingMaxPropertiesWeak _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
      (Issue 'TypedSchemaLevel -> Issue 'TypedSchemaLevel -> Bool)
-> (Issue 'TypedSchemaLevel -> Maybe ())
-> Issue 'TypedSchemaLevel
-> Issue 'TypedSchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
        NoMatchingMinProperties _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        MatchingMinPropertiesWeak _ -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'TypedSchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
  describeIssue :: Orientation -> Issue 'TypedSchemaLevel -> Blocks
describeIssue Orientation
Forward (EnumDoesntSatisfy v) = Inlines -> Blocks
para Inlines
"The following enum value was removed:" Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Value -> Blocks
showJSONValue Value
v
  describeIssue Orientation
Backward (EnumDoesntSatisfy v) = Inlines -> Blocks
para Inlines
"The following enum value was added:" Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Value -> Blocks
showJSONValue Value
v
  describeIssue Orientation
Forward (NoMatchingEnum v) = Inlines -> Blocks
para Inlines
"The following enum value has been added:" Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Value -> Blocks
showJSONValue Value
v
  describeIssue Orientation
Backward (NoMatchingEnum v) = Inlines -> Blocks
para Inlines
"The following enum value has been removed:" Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Value -> Blocks
showJSONValue Value
v
  describeIssue Orientation
Forward (NoMatchingMaximum b) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Upper bound has been added:" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bound Scientific -> Inlines
forall a. Show a => Bound a -> Inlines
showBound Bound Scientific
b Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Backward (NoMatchingMaximum b) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Upper bound has been removed:" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bound Scientific -> Inlines
forall a. Show a => Bound a -> Inlines
showBound Bound Scientific
b Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
ori (MatchingMaximumWeak (orientProdCons ori -> ProdCons p c)) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Upper bound changed from " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bound Scientific -> Inlines
forall a. Show a => Bound a -> Inlines
showBound Bound Scientific
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bound Scientific -> Inlines
forall a. Show a => Bound a -> Inlines
showBound Bound Scientific
c Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Forward (NoMatchingMinimum b) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Lower bound has been added: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bound Scientific -> Inlines
forall a. Show a => Bound a -> Inlines
showBound Bound Scientific
b Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Backward (NoMatchingMinimum b) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Lower bound has been removed: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bound Scientific -> Inlines
forall a. Show a => Bound a -> Inlines
showBound Bound Scientific
b Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
ori (MatchingMinimumWeak (orientProdCons ori -> ProdCons p c)) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Lower bound changed from " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bound Scientific -> Inlines
forall a. Show a => Bound a -> Inlines
showBound Bound Scientific
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Bound Scientific -> Inlines
forall a. Show a => Bound a -> Inlines
showBound Bound Scientific
c Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Forward (NoMatchingMultipleOf n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Value is now a multiple of " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Scientific -> Inlines
forall x. Show x => x -> Inlines
show' Scientific
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Backward (NoMatchingMultipleOf n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Value is no longer a multiple of " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Scientific -> Inlines
forall x. Show x => x -> Inlines
show' Scientific
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
ori (MatchingMultipleOfWeak (orientProdCons ori -> ProdCons p c)) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Value changed from being a multiple of " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Scientific -> Inlines
forall x. Show x => x -> Inlines
show' Scientific
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" to being a multiple of " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Scientific -> Inlines
forall x. Show x => x -> Inlines
show' Scientific
c Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Forward (NoMatchingFormat f) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Format added: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
f Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Backward (NoMatchingFormat f) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Format removed: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
f Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Forward (NoMatchingMaxLength n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Maximum length added: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Backward (NoMatchingMaxLength n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Maximum length removed: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
ori (MatchingMaxLengthWeak (orientProdCons ori -> ProdCons p c)) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Maximum length of the string changed from " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
c Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Forward (NoMatchingMinLength n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Minimum length of the string added: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Backward (NoMatchingMinLength n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Minimum length of the string removed: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
ori (MatchingMinLengthWeak (orientProdCons ori -> ProdCons p c)) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Minimum length of the string changed from " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
c Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Forward (NoMatchingPattern p) = Inlines -> Blocks
para Inlines
"Pattern (regular expression) added: " Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Text -> Blocks
codeBlock Text
p
  describeIssue Orientation
Backward (NoMatchingPattern p) = Inlines -> Blocks
para Inlines
"Pattern (regular expression) removed: " Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Text -> Blocks
codeBlock Text
p
  describeIssue Orientation
Forward Issue 'TypedSchemaLevel
NoMatchingItems = Inlines -> Blocks
para Inlines
"Array item schema has been added."
  describeIssue Orientation
Backward Issue 'TypedSchemaLevel
NoMatchingItems = Inlines -> Blocks
para Inlines
"Array item schema has been removed."
  describeIssue Orientation
ori (TupleItemsLengthChanged (orientProdCons ori -> ProdCons p c)) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Tuple length changed from " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
c Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Forward Issue 'TypedSchemaLevel
ArrayToTuple = Inlines -> Blocks
para Inlines
"The array is now explicitly defined as a tuple."
  describeIssue Orientation
Backward Issue 'TypedSchemaLevel
ArrayToTuple = Inlines -> Blocks
para Inlines
"The array is no longer explicitly defined as a tuple."
  describeIssue Orientation
Forward Issue 'TypedSchemaLevel
TupleToArray = Inlines -> Blocks
para Inlines
"The array is no longer explicitly defined as a tuple."
  describeIssue Orientation
Backward Issue 'TypedSchemaLevel
TupleToArray = Inlines -> Blocks
para Inlines
"The array is now explicitly defined as a tuple."
  describeIssue Orientation
Forward Issue 'TypedSchemaLevel
NoMatchingTupleItems = Inlines -> Blocks
para Inlines
"The array is now explicitly defined as a tuple."
  describeIssue Orientation
Backward Issue 'TypedSchemaLevel
NoMatchingTupleItems = Inlines -> Blocks
para Inlines
"The array is no longer explicitly defined as a tuple."
  describeIssue Orientation
Forward (NoMatchingMaxItems n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Maximum length of the array has been added " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Backward (NoMatchingMaxItems n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Maximum length of the array has been removed " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
ori (MatchingMaxItemsWeak (orientProdCons ori -> ProdCons p c)) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Maximum length of the array changed from " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
c Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Forward (NoMatchingMinItems n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Minimum length of the array added: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Backward (NoMatchingMinItems n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Minimum length of the array removed: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
ori (MatchingMinItemsWeak (orientProdCons ori -> ProdCons p c)) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Minimum length of the array changed from " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
c Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Forward Issue 'TypedSchemaLevel
NoMatchingUniqueItems = Inlines -> Blocks
para Inlines
"Items are now required to be unique."
  describeIssue Orientation
Backward Issue 'TypedSchemaLevel
NoMatchingUniqueItems = Inlines -> Blocks
para Inlines
"Items are no longer required to be unique."
  describeIssue Orientation
Forward Issue 'TypedSchemaLevel
NoMatchingProperties = Inlines -> Blocks
para Inlines
"Property added."
  describeIssue Orientation
Backward Issue 'TypedSchemaLevel
NoMatchingProperties = Inlines -> Blocks
para Inlines
"Property removed."
  describeIssue Orientation
Forward Issue 'TypedSchemaLevel
NoAdditionalProperties = Inlines -> Blocks
para Inlines
"Additional properties have been removed."
  describeIssue Orientation
Backward Issue 'TypedSchemaLevel
NoAdditionalProperties = Inlines -> Blocks
para Inlines
"Additional properties have been added."
  describeIssue Orientation
Forward (NoMatchingMaxProperties n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Maximum number of properties has been added: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Backward (NoMatchingMaxProperties n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Maximum number of properties has been removed: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
ori (MatchingMaxPropertiesWeak (orientProdCons ori -> ProdCons p c)) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Maximum number of properties has changed from " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
c Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Forward (NoMatchingMinProperties n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Minimum number of properties added: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
Backward (NoMatchingMinProperties n) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Minimum number of properties removed: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
n Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
ori (MatchingMinPropertiesWeak (orientProdCons ori -> ProdCons p c)) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Minimum number of properties has changed from " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
c Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."
  describeIssue Orientation
_ (NoMatchingCondition mPart conds) =
    Inlines -> Blocks
para
      ( case Maybe Partition
mPart of
          Maybe Partition
Nothing -> Inlines
"Could not verify that the following conditions hold (please file a bug if you see this):"
          Just Partition
locPart ->
            Inlines
"In cases where " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Partition -> Inlines
showPartition Partition
locPart
              Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" – could not verify that the following conditions hold (please file a bug if you see this):"
      )
      Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> [Blocks] -> Blocks
bulletList ((\(SomeCondition Condition t
c) -> Condition t -> Blocks
forall (a :: JsonType). Condition a -> Blocks
showCondition Condition t
c) (SomeCondition -> Blocks) -> [SomeCondition] -> [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SomeCondition]
conds)
  describeIssue Orientation
Forward Issue 'TypedSchemaLevel
TypeBecomesEmpty = Inlines -> Blocks
para Inlines
"The type has been removed."
  describeIssue Orientation
Backward Issue 'TypedSchemaLevel
TypeBecomesEmpty = Inlines -> Blocks
para Inlines
"The type has been added."
  describeIssue Orientation
Forward (PartitionBecomesEmpty part) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The case where " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Partition -> Inlines
showPartition Partition
part Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" – has been removed."
  describeIssue Orientation
Backward (PartitionBecomesEmpty part) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The case where " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Partition -> Inlines
showPartition Partition
part Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" – has been added."

show' :: Show x => x -> Inlines
show' :: x -> Inlines
show' = Text -> Inlines
str (Text -> Inlines) -> (x -> Text) -> x -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (x -> String) -> x -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> String
forall a. Show a => a -> String
show

instance Issuable 'SchemaLevel where
  data Issue 'SchemaLevel
    = -- | Some (openapi-supported) feature that we do not support was encountered in the schema
      NotSupported Text
    | -- | We couldn't prove that the branches of a oneOf are disjoint, and we will treat it as an anyOf, meaning we don't check whether the overlaps are excluded in a compatible way
      OneOfNotDisjoint
    | -- | The schema is actually invalid
      InvalidSchema Text
    | -- | The schema contains a reference loop along "anyOf"/"allOf"/"oneOf".
      UnguardedRecursion
    | -- | Producer doesn't place any restrictions on the types, but the consumer does. List what types remain available in the consumer.
      TypesRestricted [JsonType]
    | -- | in the producer this field used to be handled as part of "additionalProperties", and the consumer this is a specific "properties" entry. Only thrown when this change actually causes other issues
      AdditionalToProperty
    | -- | in the consumer this field used to be handled as part of "additionalProperties", and the producer this is a specific "properties" entry. Only thrown when this change actually causes other issues
      PropertyToAdditional
    | -- | consumer requires a property that is not required/allowed in the producer
      PropertyNowRequired
    | -- | producer allows a property that is not allowed in the consumer
      UnexpectedProperty
    deriving stock (Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
(Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool)
-> (Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool)
-> Eq (Issue 'SchemaLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
$c/= :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
== :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
$c== :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
Eq, Eq (Issue 'SchemaLevel)
Eq (Issue 'SchemaLevel)
-> (Issue 'SchemaLevel -> Issue 'SchemaLevel -> Ordering)
-> (Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool)
-> (Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool)
-> (Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool)
-> (Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool)
-> (Issue 'SchemaLevel -> Issue 'SchemaLevel -> Issue 'SchemaLevel)
-> (Issue 'SchemaLevel -> Issue 'SchemaLevel -> Issue 'SchemaLevel)
-> Ord (Issue 'SchemaLevel)
Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
Issue 'SchemaLevel -> Issue 'SchemaLevel -> Ordering
Issue 'SchemaLevel -> Issue 'SchemaLevel -> Issue 'SchemaLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Issue 'SchemaLevel
$cmin :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Issue 'SchemaLevel
max :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Issue 'SchemaLevel
$cmax :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Issue 'SchemaLevel
>= :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
$c>= :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
> :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
$c> :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
<= :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
$c<= :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
< :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
$c< :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
compare :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Ordering
$ccompare :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Ordering
$cp1Ord :: Eq (Issue 'SchemaLevel)
Ord, Int -> Issue 'SchemaLevel -> ShowS
[Issue 'SchemaLevel] -> ShowS
Issue 'SchemaLevel -> String
(Int -> Issue 'SchemaLevel -> ShowS)
-> (Issue 'SchemaLevel -> String)
-> ([Issue 'SchemaLevel] -> ShowS)
-> Show (Issue 'SchemaLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issue 'SchemaLevel] -> ShowS
$cshowList :: [Issue 'SchemaLevel] -> ShowS
show :: Issue 'SchemaLevel -> String
$cshow :: Issue 'SchemaLevel -> String
showsPrec :: Int -> Issue 'SchemaLevel -> ShowS
$cshowsPrec :: Int -> Issue 'SchemaLevel -> ShowS
Show)
  issueKind :: Issue 'SchemaLevel -> IssueKind
issueKind = \case
    NotSupported _ -> IssueKind
Unsupported
    Issue 'SchemaLevel
OneOfNotDisjoint -> IssueKind
Unsupported
    InvalidSchema _ -> IssueKind
SchemaInvalid
    Issue 'SchemaLevel
UnguardedRecursion -> IssueKind
Unsupported
    Issue 'SchemaLevel
AdditionalToProperty -> IssueKind
Comment
    Issue 'SchemaLevel
PropertyToAdditional -> IssueKind
Comment
    TypesRestricted _ -> IssueKind
ProbablyIssue -- TODO: #70
    Issue 'SchemaLevel
_ -> IssueKind
CertainIssue
  relatedIssues :: Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
relatedIssues =
    Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool)
-> (Issue 'SchemaLevel -> Maybe ())
-> Issue 'SchemaLevel
-> Issue 'SchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
      Issue 'SchemaLevel
AdditionalToProperty -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
      Issue 'SchemaLevel
PropertyToAdditional -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
      Issue 'SchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
      (Issue 'SchemaLevel -> Issue 'SchemaLevel -> Bool)
-> (Issue 'SchemaLevel -> Maybe ())
-> Issue 'SchemaLevel
-> Issue 'SchemaLevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
        Issue 'SchemaLevel
PropertyNowRequired -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'SchemaLevel
UnexpectedProperty -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
        Issue 'SchemaLevel
_ -> Maybe ()
forall a. Maybe a
Nothing
  describeIssue :: Orientation -> Issue 'SchemaLevel -> Blocks
describeIssue Orientation
_ (NotSupported i) =
    Inlines -> Blocks
para (Inlines -> Inlines
emph Inlines
"Encountered a feature that CompaREST does not support: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
text Text
i Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
".")
  describeIssue Orientation
_ Issue 'SchemaLevel
OneOfNotDisjoint =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$
      Inlines
"Could not deduce that " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
"oneOf"
        Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" cases don't overlap. Treating the "
        Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
"oneOf"
        Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" as an "
        Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
"anyOf"
        Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
". Reported errors might not be accurate."
  describeIssue Orientation
_ (InvalidSchema i) =
    Inlines -> Blocks
para (Inlines -> Inlines
emph Inlines
"The schema is invalid: " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
text Text
i Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
".")
  describeIssue Orientation
_ Issue 'SchemaLevel
UnguardedRecursion =
    Inlines -> Blocks
para Inlines
"Encountered recursion that is too complex for CompaREST to untangle."
  describeIssue Orientation
Forward (TypesRestricted tys) = case [JsonType]
tys of
    [] -> Inlines -> Blocks
para Inlines
"No longer has any valid values." -- weird
    [JsonType]
_ -> Inlines -> Blocks
para Inlines
"Values are now limited to the following types: " Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> [Blocks] -> Blocks
bulletList (Inlines -> Blocks
para (Inlines -> Blocks) -> (JsonType -> Inlines) -> JsonType -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonType -> Inlines
forall s. IsString s => JsonType -> s
describeJSONType (JsonType -> Blocks) -> [JsonType] -> [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JsonType]
tys)
  describeIssue Orientation
Backward (TypesRestricted tys) = case [JsonType]
tys of
    [] -> Inlines -> Blocks
para Inlines
"Any value of any type is now allowed." -- weird
    [JsonType]
_ -> Inlines -> Blocks
para Inlines
"Values are no longer limited to the following types: " Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> [Blocks] -> Blocks
bulletList (Inlines -> Blocks
para (Inlines -> Blocks) -> (JsonType -> Inlines) -> JsonType -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonType -> Inlines
forall s. IsString s => JsonType -> s
describeJSONType (JsonType -> Blocks) -> [JsonType] -> [Blocks]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JsonType]
tys)
  describeIssue Orientation
Forward Issue 'SchemaLevel
AdditionalToProperty = Inlines -> Blocks
para Inlines
"The property was previously implicitly described by the catch-all \"additional properties\" case. It is now explicitly defined."
  describeIssue Orientation
Backward Issue 'SchemaLevel
AdditionalToProperty = Inlines -> Blocks
para Inlines
"The property was previously explicitly defined. It is now implicitly described by the catch-all \"additional properties\" case."
  describeIssue Orientation
Forward Issue 'SchemaLevel
PropertyToAdditional = Inlines -> Blocks
para Inlines
"The property was previously explicitly defined. It is now implicitly described by the catch-all \"additional properties\" case."
  describeIssue Orientation
Backward Issue 'SchemaLevel
PropertyToAdditional = Inlines -> Blocks
para Inlines
"The property was previously implicitly described by the catch-all \"additional properties\" case. It is now explicitly defined."
  describeIssue Orientation
Forward Issue 'SchemaLevel
PropertyNowRequired = Inlines -> Blocks
para Inlines
"The property has become required."
  describeIssue Orientation
Backward Issue 'SchemaLevel
PropertyNowRequired = Inlines -> Blocks
para Inlines
"The property may not be present."
  describeIssue Orientation
Forward Issue 'SchemaLevel
UnexpectedProperty = Inlines -> Blocks
para Inlines
"The property has been removed."
  describeIssue Orientation
Backward Issue 'SchemaLevel
UnexpectedProperty = Inlines -> Blocks
para Inlines
"The property has been added."

instance Behavable 'SchemaLevel 'TypedSchemaLevel where
  data Behave 'SchemaLevel 'TypedSchemaLevel
    = OfType JsonType
    deriving stock (Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
(Behave 'SchemaLevel 'TypedSchemaLevel
 -> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool)
-> (Behave 'SchemaLevel 'TypedSchemaLevel
    -> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool)
-> Eq (Behave 'SchemaLevel 'TypedSchemaLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
$c/= :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
== :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
$c== :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
Eq, Eq (Behave 'SchemaLevel 'TypedSchemaLevel)
Eq (Behave 'SchemaLevel 'TypedSchemaLevel)
-> (Behave 'SchemaLevel 'TypedSchemaLevel
    -> Behave 'SchemaLevel 'TypedSchemaLevel -> Ordering)
-> (Behave 'SchemaLevel 'TypedSchemaLevel
    -> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool)
-> (Behave 'SchemaLevel 'TypedSchemaLevel
    -> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool)
-> (Behave 'SchemaLevel 'TypedSchemaLevel
    -> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool)
-> (Behave 'SchemaLevel 'TypedSchemaLevel
    -> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool)
-> (Behave 'SchemaLevel 'TypedSchemaLevel
    -> Behave 'SchemaLevel 'TypedSchemaLevel
    -> Behave 'SchemaLevel 'TypedSchemaLevel)
-> (Behave 'SchemaLevel 'TypedSchemaLevel
    -> Behave 'SchemaLevel 'TypedSchemaLevel
    -> Behave 'SchemaLevel 'TypedSchemaLevel)
-> Ord (Behave 'SchemaLevel 'TypedSchemaLevel)
Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Ordering
Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel
$cmin :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel
max :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel
$cmax :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel
>= :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
$c>= :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
> :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
$c> :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
<= :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
$c<= :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
< :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
$c< :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Bool
compare :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Ordering
$ccompare :: Behave 'SchemaLevel 'TypedSchemaLevel
-> Behave 'SchemaLevel 'TypedSchemaLevel -> Ordering
$cp1Ord :: Eq (Behave 'SchemaLevel 'TypedSchemaLevel)
Ord, Int -> Behave 'SchemaLevel 'TypedSchemaLevel -> ShowS
[Behave 'SchemaLevel 'TypedSchemaLevel] -> ShowS
Behave 'SchemaLevel 'TypedSchemaLevel -> String
(Int -> Behave 'SchemaLevel 'TypedSchemaLevel -> ShowS)
-> (Behave 'SchemaLevel 'TypedSchemaLevel -> String)
-> ([Behave 'SchemaLevel 'TypedSchemaLevel] -> ShowS)
-> Show (Behave 'SchemaLevel 'TypedSchemaLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Behave 'SchemaLevel 'TypedSchemaLevel] -> ShowS
$cshowList :: [Behave 'SchemaLevel 'TypedSchemaLevel] -> ShowS
show :: Behave 'SchemaLevel 'TypedSchemaLevel -> String
$cshow :: Behave 'SchemaLevel 'TypedSchemaLevel -> String
showsPrec :: Int -> Behave 'SchemaLevel 'TypedSchemaLevel -> ShowS
$cshowsPrec :: Int -> Behave 'SchemaLevel 'TypedSchemaLevel -> ShowS
Show)

  describeBehavior :: Behave 'SchemaLevel 'TypedSchemaLevel -> Inlines
describeBehavior (OfType t) = JsonType -> Inlines
forall s. IsString s => JsonType -> s
describeJSONType JsonType
t

instance Behavable 'TypedSchemaLevel 'TypedSchemaLevel where
  data Behave 'TypedSchemaLevel 'TypedSchemaLevel
    = InPartition Partition
    deriving stock (Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
(Behave 'TypedSchemaLevel 'TypedSchemaLevel
 -> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool)
-> (Behave 'TypedSchemaLevel 'TypedSchemaLevel
    -> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool)
-> Eq (Behave 'TypedSchemaLevel 'TypedSchemaLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
$c/= :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
== :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
$c== :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
Eq, Eq (Behave 'TypedSchemaLevel 'TypedSchemaLevel)
Eq (Behave 'TypedSchemaLevel 'TypedSchemaLevel)
-> (Behave 'TypedSchemaLevel 'TypedSchemaLevel
    -> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Ordering)
-> (Behave 'TypedSchemaLevel 'TypedSchemaLevel
    -> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool)
-> (Behave 'TypedSchemaLevel 'TypedSchemaLevel
    -> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool)
-> (Behave 'TypedSchemaLevel 'TypedSchemaLevel
    -> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool)
-> (Behave 'TypedSchemaLevel 'TypedSchemaLevel
    -> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool)
-> (Behave 'TypedSchemaLevel 'TypedSchemaLevel
    -> Behave 'TypedSchemaLevel 'TypedSchemaLevel
    -> Behave 'TypedSchemaLevel 'TypedSchemaLevel)
-> (Behave 'TypedSchemaLevel 'TypedSchemaLevel
    -> Behave 'TypedSchemaLevel 'TypedSchemaLevel
    -> Behave 'TypedSchemaLevel 'TypedSchemaLevel)
-> Ord (Behave 'TypedSchemaLevel 'TypedSchemaLevel)
Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Ordering
Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel
$cmin :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel
max :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel
$cmax :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel
>= :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
$c>= :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
> :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
$c> :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
<= :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
$c<= :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
< :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
$c< :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Bool
compare :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Ordering
$ccompare :: Behave 'TypedSchemaLevel 'TypedSchemaLevel
-> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Ordering
$cp1Ord :: Eq (Behave 'TypedSchemaLevel 'TypedSchemaLevel)
Ord, Int -> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> ShowS
[Behave 'TypedSchemaLevel 'TypedSchemaLevel] -> ShowS
Behave 'TypedSchemaLevel 'TypedSchemaLevel -> String
(Int -> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> ShowS)
-> (Behave 'TypedSchemaLevel 'TypedSchemaLevel -> String)
-> ([Behave 'TypedSchemaLevel 'TypedSchemaLevel] -> ShowS)
-> Show (Behave 'TypedSchemaLevel 'TypedSchemaLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Behave 'TypedSchemaLevel 'TypedSchemaLevel] -> ShowS
$cshowList :: [Behave 'TypedSchemaLevel 'TypedSchemaLevel] -> ShowS
show :: Behave 'TypedSchemaLevel 'TypedSchemaLevel -> String
$cshow :: Behave 'TypedSchemaLevel 'TypedSchemaLevel -> String
showsPrec :: Int -> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> ShowS
$cshowsPrec :: Int -> Behave 'TypedSchemaLevel 'TypedSchemaLevel -> ShowS
Show)

  describeBehavior :: Behave 'TypedSchemaLevel 'TypedSchemaLevel -> Inlines
describeBehavior (InPartition partition) = Inlines
"In cases where " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Partition -> Inlines
showPartition Partition
partition

instance Behavable 'TypedSchemaLevel 'SchemaLevel where
  data Behave 'TypedSchemaLevel 'SchemaLevel
    = InItems
    | InItem Integer
    | InProperty Text
    | InAdditionalProperty
    deriving stock (Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
(Behave 'TypedSchemaLevel 'SchemaLevel
 -> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool)
-> (Behave 'TypedSchemaLevel 'SchemaLevel
    -> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool)
-> Eq (Behave 'TypedSchemaLevel 'SchemaLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
$c/= :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
== :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
$c== :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
Eq, Eq (Behave 'TypedSchemaLevel 'SchemaLevel)
Eq (Behave 'TypedSchemaLevel 'SchemaLevel)
-> (Behave 'TypedSchemaLevel 'SchemaLevel
    -> Behave 'TypedSchemaLevel 'SchemaLevel -> Ordering)
-> (Behave 'TypedSchemaLevel 'SchemaLevel
    -> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool)
-> (Behave 'TypedSchemaLevel 'SchemaLevel
    -> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool)
-> (Behave 'TypedSchemaLevel 'SchemaLevel
    -> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool)
-> (Behave 'TypedSchemaLevel 'SchemaLevel
    -> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool)
-> (Behave 'TypedSchemaLevel 'SchemaLevel
    -> Behave 'TypedSchemaLevel 'SchemaLevel
    -> Behave 'TypedSchemaLevel 'SchemaLevel)
-> (Behave 'TypedSchemaLevel 'SchemaLevel
    -> Behave 'TypedSchemaLevel 'SchemaLevel
    -> Behave 'TypedSchemaLevel 'SchemaLevel)
-> Ord (Behave 'TypedSchemaLevel 'SchemaLevel)
Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Ordering
Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel
$cmin :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel
max :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel
$cmax :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel
>= :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
$c>= :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
> :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
$c> :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
<= :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
$c<= :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
< :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
$c< :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Bool
compare :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Ordering
$ccompare :: Behave 'TypedSchemaLevel 'SchemaLevel
-> Behave 'TypedSchemaLevel 'SchemaLevel -> Ordering
$cp1Ord :: Eq (Behave 'TypedSchemaLevel 'SchemaLevel)
Ord, Int -> Behave 'TypedSchemaLevel 'SchemaLevel -> ShowS
[Behave 'TypedSchemaLevel 'SchemaLevel] -> ShowS
Behave 'TypedSchemaLevel 'SchemaLevel -> String
(Int -> Behave 'TypedSchemaLevel 'SchemaLevel -> ShowS)
-> (Behave 'TypedSchemaLevel 'SchemaLevel -> String)
-> ([Behave 'TypedSchemaLevel 'SchemaLevel] -> ShowS)
-> Show (Behave 'TypedSchemaLevel 'SchemaLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Behave 'TypedSchemaLevel 'SchemaLevel] -> ShowS
$cshowList :: [Behave 'TypedSchemaLevel 'SchemaLevel] -> ShowS
show :: Behave 'TypedSchemaLevel 'SchemaLevel -> String
$cshow :: Behave 'TypedSchemaLevel 'SchemaLevel -> String
showsPrec :: Int -> Behave 'TypedSchemaLevel 'SchemaLevel -> ShowS
$cshowsPrec :: Int -> Behave 'TypedSchemaLevel 'SchemaLevel -> ShowS
Show)

  describeBehavior :: Behave 'TypedSchemaLevel 'SchemaLevel -> Inlines
describeBehavior Behave 'TypedSchemaLevel 'SchemaLevel
InItems = Inlines
"Items"
  describeBehavior (InItem i) = Inlines
"Item " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Integer -> Inlines
forall x. Show x => x -> Inlines
show' Integer
i
  describeBehavior (InProperty p) = Inlines
"Property " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
p
  describeBehavior Behave 'TypedSchemaLevel 'SchemaLevel
InAdditionalProperty = Inlines
"Additional properties"