{-# OPTIONS_GHC -Wno-orphans #-}

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

import Data.HList
import Data.HashMap.Strict.InsOrd as IOHM
import Data.Map.Strict as M
import Data.Maybe
import Data.OpenApi
import Data.OpenApi.Compare.Behavior
import Data.OpenApi.Compare.Subtree
import Data.OpenApi.Compare.Validate.MediaTypeObject
import Data.OpenApi.Compare.Validate.Sums
import qualified Data.Text as T
import Network.HTTP.Media (MediaType)
import Text.Pandoc.Builder

-- TODO: Use RequestMediaTypeObjectMapping
tracedContent :: Traced RequestBody -> IOHM.InsOrdHashMap MediaType (Traced MediaTypeObject)
tracedContent :: Traced RequestBody
-> InsOrdHashMap MediaType (Traced MediaTypeObject)
tracedContent Traced RequestBody
resp =
  (MediaType -> MediaTypeObject -> Traced MediaTypeObject)
-> InsOrdHashMap MediaType MediaTypeObject
-> InsOrdHashMap MediaType (Traced MediaTypeObject)
forall k v1 v2.
(k -> v1 -> v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
IOHM.mapWithKey (\MediaType
k -> Trace MediaTypeObject -> MediaTypeObject -> Traced MediaTypeObject
forall a. Trace a -> a -> Traced a
traced (Traced RequestBody -> Paths Step TraceRoot RequestBody
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced RequestBody
resp Paths Step TraceRoot RequestBody
-> Paths Step RequestBody MediaTypeObject -> Trace MediaTypeObject
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step RequestBody MediaTypeObject
-> Paths Step RequestBody MediaTypeObject
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (MediaType -> Step RequestBody MediaTypeObject
RequestMediaTypeObject MediaType
k))) (InsOrdHashMap MediaType MediaTypeObject
 -> InsOrdHashMap MediaType (Traced MediaTypeObject))
-> InsOrdHashMap MediaType MediaTypeObject
-> InsOrdHashMap MediaType (Traced MediaTypeObject)
forall a b. (a -> b) -> a -> b
$
    RequestBody -> InsOrdHashMap MediaType MediaTypeObject
_requestBodyContent (RequestBody -> InsOrdHashMap MediaType MediaTypeObject)
-> RequestBody -> InsOrdHashMap MediaType MediaTypeObject
forall a b. (a -> b) -> a -> b
$ Traced RequestBody -> RequestBody
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced RequestBody
resp

instance Issuable 'RequestLevel where
  data Issue 'RequestLevel
    = RequestBodyRequired
    | RequestMediaTypeNotFound MediaType
    deriving stock (Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
(Issue 'RequestLevel -> Issue 'RequestLevel -> Bool)
-> (Issue 'RequestLevel -> Issue 'RequestLevel -> Bool)
-> Eq (Issue 'RequestLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
$c/= :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
== :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
$c== :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
Eq, Eq (Issue 'RequestLevel)
Eq (Issue 'RequestLevel)
-> (Issue 'RequestLevel -> Issue 'RequestLevel -> Ordering)
-> (Issue 'RequestLevel -> Issue 'RequestLevel -> Bool)
-> (Issue 'RequestLevel -> Issue 'RequestLevel -> Bool)
-> (Issue 'RequestLevel -> Issue 'RequestLevel -> Bool)
-> (Issue 'RequestLevel -> Issue 'RequestLevel -> Bool)
-> (Issue 'RequestLevel
    -> Issue 'RequestLevel -> Issue 'RequestLevel)
-> (Issue 'RequestLevel
    -> Issue 'RequestLevel -> Issue 'RequestLevel)
-> Ord (Issue 'RequestLevel)
Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
Issue 'RequestLevel -> Issue 'RequestLevel -> Ordering
Issue 'RequestLevel -> Issue 'RequestLevel -> Issue 'RequestLevel
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 'RequestLevel -> Issue 'RequestLevel -> Issue 'RequestLevel
$cmin :: Issue 'RequestLevel -> Issue 'RequestLevel -> Issue 'RequestLevel
max :: Issue 'RequestLevel -> Issue 'RequestLevel -> Issue 'RequestLevel
$cmax :: Issue 'RequestLevel -> Issue 'RequestLevel -> Issue 'RequestLevel
>= :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
$c>= :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
> :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
$c> :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
<= :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
$c<= :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
< :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
$c< :: Issue 'RequestLevel -> Issue 'RequestLevel -> Bool
compare :: Issue 'RequestLevel -> Issue 'RequestLevel -> Ordering
$ccompare :: Issue 'RequestLevel -> Issue 'RequestLevel -> Ordering
$cp1Ord :: Eq (Issue 'RequestLevel)
Ord, Int -> Issue 'RequestLevel -> ShowS
[Issue 'RequestLevel] -> ShowS
Issue 'RequestLevel -> String
(Int -> Issue 'RequestLevel -> ShowS)
-> (Issue 'RequestLevel -> String)
-> ([Issue 'RequestLevel] -> ShowS)
-> Show (Issue 'RequestLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issue 'RequestLevel] -> ShowS
$cshowList :: [Issue 'RequestLevel] -> ShowS
show :: Issue 'RequestLevel -> String
$cshow :: Issue 'RequestLevel -> String
showsPrec :: Int -> Issue 'RequestLevel -> ShowS
$cshowsPrec :: Int -> Issue 'RequestLevel -> ShowS
Show)
  issueKind :: Issue 'RequestLevel -> IssueKind
issueKind = \case
    Issue 'RequestLevel
_ -> IssueKind
CertainIssue
  describeIssue :: Orientation -> Issue 'RequestLevel -> Blocks
describeIssue Orientation
Forward Issue 'RequestLevel
RequestBodyRequired =
    Inlines -> Blocks
para Inlines
"Request body has become required."
  describeIssue Orientation
Backward Issue 'RequestLevel
RequestBodyRequired =
    Inlines -> Blocks
para Inlines
"Request body is no longer required."
  describeIssue Orientation
Forward (RequestMediaTypeNotFound t) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Media type " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> (Text -> Inlines
code (Text -> Inlines) -> (MediaType -> Text) -> MediaType -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (MediaType -> String) -> MediaType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaType -> String
forall a. Show a => a -> String
show (MediaType -> Inlines) -> MediaType -> Inlines
forall a b. (a -> b) -> a -> b
$ MediaType
t) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" has been removed."
  describeIssue Orientation
Backward (RequestMediaTypeNotFound t) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Media type " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> (Text -> Inlines
code (Text -> Inlines) -> (MediaType -> Text) -> MediaType -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (MediaType -> String) -> MediaType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaType -> String
forall a. Show a => a -> String
show (MediaType -> Inlines) -> MediaType -> Inlines
forall a b. (a -> b) -> a -> b
$ MediaType
t) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" has been added."

instance Behavable 'RequestLevel 'PayloadLevel where
  data Behave 'RequestLevel 'PayloadLevel
    = InPayload
    deriving stock (Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
(Behave 'RequestLevel 'PayloadLevel
 -> Behave 'RequestLevel 'PayloadLevel -> Bool)
-> (Behave 'RequestLevel 'PayloadLevel
    -> Behave 'RequestLevel 'PayloadLevel -> Bool)
-> Eq (Behave 'RequestLevel 'PayloadLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
$c/= :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
== :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
$c== :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
Eq, Eq (Behave 'RequestLevel 'PayloadLevel)
Eq (Behave 'RequestLevel 'PayloadLevel)
-> (Behave 'RequestLevel 'PayloadLevel
    -> Behave 'RequestLevel 'PayloadLevel -> Ordering)
-> (Behave 'RequestLevel 'PayloadLevel
    -> Behave 'RequestLevel 'PayloadLevel -> Bool)
-> (Behave 'RequestLevel 'PayloadLevel
    -> Behave 'RequestLevel 'PayloadLevel -> Bool)
-> (Behave 'RequestLevel 'PayloadLevel
    -> Behave 'RequestLevel 'PayloadLevel -> Bool)
-> (Behave 'RequestLevel 'PayloadLevel
    -> Behave 'RequestLevel 'PayloadLevel -> Bool)
-> (Behave 'RequestLevel 'PayloadLevel
    -> Behave 'RequestLevel 'PayloadLevel
    -> Behave 'RequestLevel 'PayloadLevel)
-> (Behave 'RequestLevel 'PayloadLevel
    -> Behave 'RequestLevel 'PayloadLevel
    -> Behave 'RequestLevel 'PayloadLevel)
-> Ord (Behave 'RequestLevel 'PayloadLevel)
Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Ordering
Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel
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 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel
$cmin :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel
max :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel
$cmax :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel
>= :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
$c>= :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
> :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
$c> :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
<= :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
$c<= :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
< :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
$c< :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Bool
compare :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Ordering
$ccompare :: Behave 'RequestLevel 'PayloadLevel
-> Behave 'RequestLevel 'PayloadLevel -> Ordering
$cp1Ord :: Eq (Behave 'RequestLevel 'PayloadLevel)
Ord, Int -> Behave 'RequestLevel 'PayloadLevel -> ShowS
[Behave 'RequestLevel 'PayloadLevel] -> ShowS
Behave 'RequestLevel 'PayloadLevel -> String
(Int -> Behave 'RequestLevel 'PayloadLevel -> ShowS)
-> (Behave 'RequestLevel 'PayloadLevel -> String)
-> ([Behave 'RequestLevel 'PayloadLevel] -> ShowS)
-> Show (Behave 'RequestLevel 'PayloadLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Behave 'RequestLevel 'PayloadLevel] -> ShowS
$cshowList :: [Behave 'RequestLevel 'PayloadLevel] -> ShowS
show :: Behave 'RequestLevel 'PayloadLevel -> String
$cshow :: Behave 'RequestLevel 'PayloadLevel -> String
showsPrec :: Int -> Behave 'RequestLevel 'PayloadLevel -> ShowS
$cshowsPrec :: Int -> Behave 'RequestLevel 'PayloadLevel -> ShowS
Show)
  describeBehavior :: Behave 'RequestLevel 'PayloadLevel -> Inlines
describeBehavior Behave 'RequestLevel 'PayloadLevel
InPayload = Inlines
"Payload"

instance Subtree RequestBody where
  type SubtreeLevel RequestBody = 'RequestLevel
  type
    CheckEnv RequestBody =
      '[ ProdCons (Traced (Definitions Schema))
       , ProdCons (Traced (Definitions Header))
       ]
  checkStructuralCompatibility :: HList (CheckEnv RequestBody)
-> ProdCons (Traced RequestBody) -> StructuralCompatFormula ()
checkStructuralCompatibility HList (CheckEnv RequestBody)
env ProdCons (Traced RequestBody)
pc = do
    ProdCons
  (EnvT (Paths Step TraceRoot RequestBody) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons
   (EnvT (Paths Step TraceRoot RequestBody) Identity (Maybe Bool))
 -> StructuralCompatFormula ())
-> ProdCons
     (EnvT (Paths Step TraceRoot RequestBody) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (RequestBody -> Maybe Bool)
-> Traced RequestBody
-> EnvT (Paths Step TraceRoot RequestBody) Identity (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RequestBody -> Maybe Bool
_requestBodyRequired (Traced RequestBody
 -> EnvT (Paths Step TraceRoot RequestBody) Identity (Maybe Bool))
-> ProdCons (Traced RequestBody)
-> ProdCons
     (EnvT (Paths Step TraceRoot RequestBody) Identity (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced RequestBody)
pc
    HList
  '[ProdCons (Traced (Definitions Schema)),
    ProdCons (Traced (Definitions Header))]
-> ProdCons (Traced (InsOrdHashMap MediaType MediaTypeObject))
-> StructuralCompatFormula ()
forall k (xs :: [*]) v.
(ReassembleHList (k : xs) (CheckEnv v), Ord k, Subtree v,
 Hashable k, Typeable k, Show k) =>
HList xs
-> ProdCons (Traced (InsOrdHashMap k v))
-> StructuralCompatFormula ()
iohmStructural HList
  '[ProdCons (Traced (Definitions Schema)),
    ProdCons (Traced (Definitions Header))]
HList (CheckEnv RequestBody)
env (ProdCons (Traced (InsOrdHashMap MediaType MediaTypeObject))
 -> StructuralCompatFormula ())
-> ProdCons (Traced (InsOrdHashMap MediaType MediaTypeObject))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$
      Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Traced' RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Traced (InsOrdHashMap MediaType MediaTypeObject)
forall a a' b.
Steppable a a' =>
Step a a' -> Traced' a b -> Traced' a' b
stepTraced Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
RequestMediaTypeObjectMapping (Traced' RequestBody (InsOrdHashMap MediaType MediaTypeObject)
 -> Traced (InsOrdHashMap MediaType MediaTypeObject))
-> (Traced RequestBody
    -> Traced' RequestBody (InsOrdHashMap MediaType MediaTypeObject))
-> Traced RequestBody
-> Traced (InsOrdHashMap MediaType MediaTypeObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RequestBody -> InsOrdHashMap MediaType MediaTypeObject)
-> Traced RequestBody
-> Traced' RequestBody (InsOrdHashMap MediaType MediaTypeObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RequestBody -> InsOrdHashMap MediaType MediaTypeObject
_requestBodyContent (Traced RequestBody
 -> Traced (InsOrdHashMap MediaType MediaTypeObject))
-> ProdCons (Traced RequestBody)
-> ProdCons (Traced (InsOrdHashMap MediaType MediaTypeObject))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced RequestBody)
pc
    pure ()
  checkSemanticCompatibility :: HList (CheckEnv RequestBody)
-> Behavior (SubtreeLevel RequestBody)
-> ProdCons (Traced RequestBody)
-> SemanticCompatFormula ()
checkSemanticCompatibility HList (CheckEnv RequestBody)
env Behavior (SubtreeLevel RequestBody)
beh prodCons :: ProdCons (Traced RequestBody)
prodCons@(ProdCons Traced RequestBody
p Traced RequestBody
c) =
    if Bool -> Bool
not (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (Traced RequestBody -> Maybe Bool) -> Traced RequestBody -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestBody -> Maybe Bool
_requestBodyRequired (RequestBody -> Maybe Bool)
-> (Traced RequestBody -> RequestBody)
-> Traced RequestBody
-> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced RequestBody -> RequestBody
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced RequestBody -> Bool) -> Traced RequestBody -> Bool
forall a b. (a -> b) -> a -> b
$ Traced RequestBody
p)
      Bool -> Bool -> Bool
&& (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (Traced RequestBody -> Maybe Bool) -> Traced RequestBody -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestBody -> Maybe Bool
_requestBodyRequired (RequestBody -> Maybe Bool)
-> (Traced RequestBody -> RequestBody)
-> Traced RequestBody
-> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced RequestBody -> RequestBody
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced RequestBody -> Bool) -> Traced RequestBody -> Bool
forall a b. (a -> b) -> a -> b
$ Traced RequestBody
c)
      then Paths Behave 'APILevel 'RequestLevel
-> Issue 'RequestLevel -> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
       (q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l -> Issue l -> CompatFormula' q AnIssue r a
issueAt Paths Behave 'APILevel 'RequestLevel
Behavior (SubtreeLevel RequestBody)
beh Issue 'RequestLevel
RequestBodyRequired
      else -- Media type object are sums-like entities.

        let check :: MediaType
-> ProdCons (Traced MediaTypeObject) -> SemanticCompatFormula ()
check MediaType
mediaType ProdCons (Traced MediaTypeObject)
pc = Behavior (SubtreeLevel MediaTypeObject)
-> HList
     '[MediaType, ProdCons (Traced (Definitions Schema)),
       ProdCons (Traced (Definitions Header))]
-> ProdCons (Traced MediaTypeObject)
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility @MediaTypeObject (Paths Behave 'APILevel 'RequestLevel
Behavior (SubtreeLevel RequestBody)
beh Paths Behave 'APILevel 'RequestLevel
-> Paths Behave 'RequestLevel 'PayloadLevel
-> Paths Behave 'APILevel 'PayloadLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'RequestLevel 'PayloadLevel
-> Paths Behave 'RequestLevel 'PayloadLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Behave 'RequestLevel 'PayloadLevel
InPayload) (MediaType
-> HList
     '[ProdCons (Traced (Definitions Schema)),
       ProdCons (Traced (Definitions Header))]
-> HList
     '[MediaType, ProdCons (Traced (Definitions Schema)),
       ProdCons (Traced (Definitions Header))]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
HCons MediaType
mediaType HList
  '[ProdCons (Traced (Definitions Schema)),
    ProdCons (Traced (Definitions Header))]
HList (CheckEnv RequestBody)
env) ProdCons (Traced MediaTypeObject)
pc
            sumElts :: ProdCons (Map MediaType (Traced MediaTypeObject))
sumElts = Traced RequestBody -> Map MediaType (Traced MediaTypeObject)
getSum (Traced RequestBody -> Map MediaType (Traced MediaTypeObject))
-> ProdCons (Traced RequestBody)
-> ProdCons (Map MediaType (Traced MediaTypeObject))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced RequestBody)
prodCons
            getSum :: Traced RequestBody -> Map MediaType (Traced MediaTypeObject)
getSum Traced RequestBody
rb = [(MediaType, Traced MediaTypeObject)]
-> Map MediaType (Traced MediaTypeObject)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(MediaType, Traced MediaTypeObject)]
 -> Map MediaType (Traced MediaTypeObject))
-> (InsOrdHashMap MediaType (Traced MediaTypeObject)
    -> [(MediaType, Traced MediaTypeObject)])
-> InsOrdHashMap MediaType (Traced MediaTypeObject)
-> Map MediaType (Traced MediaTypeObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap MediaType (Traced MediaTypeObject)
-> [(MediaType, Traced MediaTypeObject)]
forall k v. InsOrdHashMap k v -> [(k, v)]
IOHM.toList (InsOrdHashMap MediaType (Traced MediaTypeObject)
 -> Map MediaType (Traced MediaTypeObject))
-> InsOrdHashMap MediaType (Traced MediaTypeObject)
-> Map MediaType (Traced MediaTypeObject)
forall a b. (a -> b) -> a -> b
$ Traced RequestBody
-> InsOrdHashMap MediaType (Traced MediaTypeObject)
tracedContent Traced RequestBody
rb
         in Paths Behave 'APILevel 'RequestLevel
-> (MediaType -> Issue 'RequestLevel)
-> (MediaType
    -> ProdCons (Traced MediaTypeObject) -> SemanticCompatFormula ())
-> ProdCons (Map MediaType (Traced MediaTypeObject))
-> SemanticCompatFormula ()
forall k (l :: BehaviorLevel)
       (q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) t.
(Ord k, Issuable l) =>
Paths q r l
-> (k -> Issue l)
-> (k -> ProdCons t -> CompatFormula' q AnIssue r ())
-> ProdCons (Map k t)
-> CompatFormula' q AnIssue r ()
checkSums Paths Behave 'APILevel 'RequestLevel
Behavior (SubtreeLevel RequestBody)
beh MediaType -> Issue 'RequestLevel
RequestMediaTypeNotFound MediaType
-> ProdCons (Traced MediaTypeObject) -> SemanticCompatFormula ()
check ProdCons (Map MediaType (Traced MediaTypeObject))
sumElts

instance Steppable RequestBody MediaTypeObject where
  data Step RequestBody MediaTypeObject = RequestMediaTypeObject MediaType
    deriving stock (Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
(Step RequestBody MediaTypeObject
 -> Step RequestBody MediaTypeObject -> Bool)
-> (Step RequestBody MediaTypeObject
    -> Step RequestBody MediaTypeObject -> Bool)
-> Eq (Step RequestBody MediaTypeObject)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
$c/= :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
== :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
$c== :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
Eq, Eq (Step RequestBody MediaTypeObject)
Eq (Step RequestBody MediaTypeObject)
-> (Step RequestBody MediaTypeObject
    -> Step RequestBody MediaTypeObject -> Ordering)
-> (Step RequestBody MediaTypeObject
    -> Step RequestBody MediaTypeObject -> Bool)
-> (Step RequestBody MediaTypeObject
    -> Step RequestBody MediaTypeObject -> Bool)
-> (Step RequestBody MediaTypeObject
    -> Step RequestBody MediaTypeObject -> Bool)
-> (Step RequestBody MediaTypeObject
    -> Step RequestBody MediaTypeObject -> Bool)
-> (Step RequestBody MediaTypeObject
    -> Step RequestBody MediaTypeObject
    -> Step RequestBody MediaTypeObject)
-> (Step RequestBody MediaTypeObject
    -> Step RequestBody MediaTypeObject
    -> Step RequestBody MediaTypeObject)
-> Ord (Step RequestBody MediaTypeObject)
Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Ordering
Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject
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 :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject
$cmin :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject
max :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject
$cmax :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject
>= :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
$c>= :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
> :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
$c> :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
<= :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
$c<= :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
< :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
$c< :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Bool
compare :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Ordering
$ccompare :: Step RequestBody MediaTypeObject
-> Step RequestBody MediaTypeObject -> Ordering
$cp1Ord :: Eq (Step RequestBody MediaTypeObject)
Ord, Int -> Step RequestBody MediaTypeObject -> ShowS
[Step RequestBody MediaTypeObject] -> ShowS
Step RequestBody MediaTypeObject -> String
(Int -> Step RequestBody MediaTypeObject -> ShowS)
-> (Step RequestBody MediaTypeObject -> String)
-> ([Step RequestBody MediaTypeObject] -> ShowS)
-> Show (Step RequestBody MediaTypeObject)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Step RequestBody MediaTypeObject] -> ShowS
$cshowList :: [Step RequestBody MediaTypeObject] -> ShowS
show :: Step RequestBody MediaTypeObject -> String
$cshow :: Step RequestBody MediaTypeObject -> String
showsPrec :: Int -> Step RequestBody MediaTypeObject -> ShowS
$cshowsPrec :: Int -> Step RequestBody MediaTypeObject -> ShowS
Show)

instance Steppable RequestBody (IOHM.InsOrdHashMap MediaType MediaTypeObject) where
  data Step RequestBody (IOHM.InsOrdHashMap MediaType MediaTypeObject) = RequestMediaTypeObjectMapping
    deriving stock (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
(Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
 -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
 -> Bool)
-> (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Bool)
-> Eq (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
$c/= :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
== :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
$c== :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
Eq, Eq (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject))
Eq (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject))
-> (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Ordering)
-> (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Bool)
-> (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Bool)
-> (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Bool)
-> (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Bool)
-> (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject))
-> (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject))
-> Ord (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject))
Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Ordering
Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
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 :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
$cmin :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
max :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
$cmax :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
>= :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
$c>= :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
> :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
$c> :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
<= :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
$c<= :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
< :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
$c< :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Bool
compare :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Ordering
$ccompare :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> Ordering
$cp1Ord :: Eq (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject))
Ord, Int
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> ShowS
[Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)]
-> ShowS
Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> String
(Int
 -> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
 -> ShowS)
-> (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
    -> String)
-> ([Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)]
    -> ShowS)
-> Show
     (Step RequestBody (InsOrdHashMap MediaType MediaTypeObject))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)]
-> ShowS
$cshowList :: [Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)]
-> ShowS
show :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> String
$cshow :: Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> String
showsPrec :: Int
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> ShowS
$cshowsPrec :: Int
-> Step RequestBody (InsOrdHashMap MediaType MediaTypeObject)
-> ShowS
Show)