{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

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

import Control.Monad
import Data.Functor
import Data.Maybe
import Data.OpenApi
import Data.OpenApi.Compare.Behavior
import Data.OpenApi.Compare.Orphans ()
import Data.OpenApi.Compare.Subtree
import Data.OpenApi.Compare.Validate.Schema ()
import Data.Text as T
import Text.Pandoc.Builder

-- | The type is normalized encoding style of the parameter. If two encoding
-- styles are equal then parameters are compatible with their encoding style
data EncodingStyle = EncodingStyle
  { EncodingStyle -> Style
style :: Style
  , EncodingStyle -> Bool
explode :: Bool
  , -- | Nothing when @in@ parameter is not @query@
    EncodingStyle -> Maybe Bool
allowReserved :: Maybe Bool
  }
  deriving stock (EncodingStyle -> EncodingStyle -> Bool
(EncodingStyle -> EncodingStyle -> Bool)
-> (EncodingStyle -> EncodingStyle -> Bool) -> Eq EncodingStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncodingStyle -> EncodingStyle -> Bool
$c/= :: EncodingStyle -> EncodingStyle -> Bool
== :: EncodingStyle -> EncodingStyle -> Bool
$c== :: EncodingStyle -> EncodingStyle -> Bool
Eq, Eq EncodingStyle
Eq EncodingStyle
-> (EncodingStyle -> EncodingStyle -> Ordering)
-> (EncodingStyle -> EncodingStyle -> Bool)
-> (EncodingStyle -> EncodingStyle -> Bool)
-> (EncodingStyle -> EncodingStyle -> Bool)
-> (EncodingStyle -> EncodingStyle -> Bool)
-> (EncodingStyle -> EncodingStyle -> EncodingStyle)
-> (EncodingStyle -> EncodingStyle -> EncodingStyle)
-> Ord EncodingStyle
EncodingStyle -> EncodingStyle -> Bool
EncodingStyle -> EncodingStyle -> Ordering
EncodingStyle -> EncodingStyle -> EncodingStyle
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 :: EncodingStyle -> EncodingStyle -> EncodingStyle
$cmin :: EncodingStyle -> EncodingStyle -> EncodingStyle
max :: EncodingStyle -> EncodingStyle -> EncodingStyle
$cmax :: EncodingStyle -> EncodingStyle -> EncodingStyle
>= :: EncodingStyle -> EncodingStyle -> Bool
$c>= :: EncodingStyle -> EncodingStyle -> Bool
> :: EncodingStyle -> EncodingStyle -> Bool
$c> :: EncodingStyle -> EncodingStyle -> Bool
<= :: EncodingStyle -> EncodingStyle -> Bool
$c<= :: EncodingStyle -> EncodingStyle -> Bool
< :: EncodingStyle -> EncodingStyle -> Bool
$c< :: EncodingStyle -> EncodingStyle -> Bool
compare :: EncodingStyle -> EncodingStyle -> Ordering
$ccompare :: EncodingStyle -> EncodingStyle -> Ordering
$cp1Ord :: Eq EncodingStyle
Ord, Int -> EncodingStyle -> ShowS
[EncodingStyle] -> ShowS
EncodingStyle -> String
(Int -> EncodingStyle -> ShowS)
-> (EncodingStyle -> String)
-> ([EncodingStyle] -> ShowS)
-> Show EncodingStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncodingStyle] -> ShowS
$cshowList :: [EncodingStyle] -> ShowS
show :: EncodingStyle -> String
$cshow :: EncodingStyle -> String
showsPrec :: Int -> EncodingStyle -> ShowS
$cshowsPrec :: Int -> EncodingStyle -> ShowS
Show)

paramEncoding :: Param -> EncodingStyle
paramEncoding :: Param -> EncodingStyle
paramEncoding Param
p =
  EncodingStyle :: Style -> Bool -> Maybe Bool -> EncodingStyle
EncodingStyle
    { Style
style :: Style
$sel:style:EncodingStyle :: Style
style
    , Bool
explode :: Bool
$sel:explode:EncodingStyle :: Bool
explode
    , Maybe Bool
allowReserved :: Maybe Bool
$sel:allowReserved:EncodingStyle :: Maybe Bool
allowReserved
    }
  where
    style :: Style
style = Style -> Maybe Style -> Style
forall a. a -> Maybe a -> a
fromMaybe Style
defaultStyle (Maybe Style -> Style) -> Maybe Style -> Style
forall a b. (a -> b) -> a -> b
$ Param -> Maybe Style
_paramStyle Param
p
    defaultStyle :: Style
defaultStyle = case Param -> ParamLocation
_paramIn Param
p of
      ParamLocation
ParamQuery -> Style
StyleForm
      ParamLocation
ParamPath -> Style
StyleSimple
      ParamLocation
ParamHeader -> Style
StyleSimple
      ParamLocation
ParamCookie -> Style
StyleForm
    explode :: Bool
explode = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
defaultExplode (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Param -> Maybe Bool
_paramExplode Param
p
    defaultExplode :: Bool
defaultExplode = case Style
style of
      Style
StyleForm -> Bool
True
      Style
_ -> Bool
False
    allowReserved :: Maybe Bool
allowReserved = case Param -> ParamLocation
_paramIn Param
p of
      ParamLocation
ParamQuery -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Param -> Maybe Bool
_paramAllowReserved Param
p
      ParamLocation
_ -> Maybe Bool
forall a. Maybe a
Nothing

tracedSchema :: Traced Param -> Maybe (Traced (Referenced Schema))
tracedSchema :: Traced Param -> Maybe (Traced (Referenced Schema))
tracedSchema Traced Param
par = Param -> Maybe (Referenced Schema)
_paramSchema (Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced Param
par) Maybe (Referenced Schema)
-> (Referenced Schema -> Traced (Referenced Schema))
-> Maybe (Traced (Referenced Schema))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Trace (Referenced Schema)
-> Referenced Schema -> Traced (Referenced Schema)
forall a. Trace a -> a -> Traced a
traced (Traced Param -> Paths Step TraceRoot Param
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced Param
par Paths Step TraceRoot Param
-> Paths Step Param (Referenced Schema)
-> Trace (Referenced Schema)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step Param (Referenced Schema)
-> Paths Step Param (Referenced Schema)
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Step Param (Referenced Schema)
ParamSchema)

instance Issuable 'PathFragmentLevel where
  data Issue 'PathFragmentLevel
    = -- | Params have different names
      ParamNameMismatch
    | -- | Consumer requires non-empty param, but producer gives emptyable
      ParamEmptinessIncompatible
    | -- | Consumer requires mandatory parm, but producer optional
      ParamRequired
    | ParamPlaceIncompatible
    | -- | Params encoded in different styles
      ParamStyleMismatch
    | -- | One of schemas not presented
      ParamSchemaMismatch
    | PathFragmentsDontMatch (ProdCons Text)
    deriving stock (Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
(Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool)
-> (Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool)
-> Eq (Issue 'PathFragmentLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
$c/= :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
== :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
$c== :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
Eq, Eq (Issue 'PathFragmentLevel)
Eq (Issue 'PathFragmentLevel)
-> (Issue 'PathFragmentLevel
    -> Issue 'PathFragmentLevel -> Ordering)
-> (Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool)
-> (Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool)
-> (Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool)
-> (Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool)
-> (Issue 'PathFragmentLevel
    -> Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel)
-> (Issue 'PathFragmentLevel
    -> Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel)
-> Ord (Issue 'PathFragmentLevel)
Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Ordering
Issue 'PathFragmentLevel
-> Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel
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 'PathFragmentLevel
-> Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel
$cmin :: Issue 'PathFragmentLevel
-> Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel
max :: Issue 'PathFragmentLevel
-> Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel
$cmax :: Issue 'PathFragmentLevel
-> Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel
>= :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
$c>= :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
> :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
$c> :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
<= :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
$c<= :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
< :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
$c< :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Bool
compare :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Ordering
$ccompare :: Issue 'PathFragmentLevel -> Issue 'PathFragmentLevel -> Ordering
$cp1Ord :: Eq (Issue 'PathFragmentLevel)
Ord, Int -> Issue 'PathFragmentLevel -> ShowS
[Issue 'PathFragmentLevel] -> ShowS
Issue 'PathFragmentLevel -> String
(Int -> Issue 'PathFragmentLevel -> ShowS)
-> (Issue 'PathFragmentLevel -> String)
-> ([Issue 'PathFragmentLevel] -> ShowS)
-> Show (Issue 'PathFragmentLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issue 'PathFragmentLevel] -> ShowS
$cshowList :: [Issue 'PathFragmentLevel] -> ShowS
show :: Issue 'PathFragmentLevel -> String
$cshow :: Issue 'PathFragmentLevel -> String
showsPrec :: Int -> Issue 'PathFragmentLevel -> ShowS
$cshowsPrec :: Int -> Issue 'PathFragmentLevel -> ShowS
Show)
  issueKind :: Issue 'PathFragmentLevel -> IssueKind
issueKind = \case
    Issue 'PathFragmentLevel
ParamSchemaMismatch -> IssueKind
ProbablyIssue -- the schema could be catch-all (?)
    Issue 'PathFragmentLevel
_ -> IssueKind
CertainIssue
  describeIssue :: Orientation -> Issue 'PathFragmentLevel -> Blocks
describeIssue Orientation
_ Issue 'PathFragmentLevel
ParamNameMismatch = Inlines -> Blocks
para Inlines
"The path fragments don't match."
  describeIssue Orientation
Forward Issue 'PathFragmentLevel
ParamEmptinessIncompatible = Inlines -> Blocks
para Inlines
"The parameter can no longer be empty."
  describeIssue Orientation
Backward Issue 'PathFragmentLevel
ParamEmptinessIncompatible = Inlines -> Blocks
para Inlines
"The parameter can now be empty."
  describeIssue Orientation
Forward Issue 'PathFragmentLevel
ParamRequired = Inlines -> Blocks
para Inlines
"Parameter has become required."
  describeIssue Orientation
Backward Issue 'PathFragmentLevel
ParamRequired = Inlines -> Blocks
para Inlines
"Parameter is no longer required."
  describeIssue Orientation
_ Issue 'PathFragmentLevel
ParamPlaceIncompatible = Inlines -> Blocks
para Inlines
"Parameters in incompatible locations."
  describeIssue Orientation
_ Issue 'PathFragmentLevel
ParamStyleMismatch = Inlines -> Blocks
para Inlines
"Different parameter styles (encodings)."
  describeIssue Orientation
_ Issue 'PathFragmentLevel
ParamSchemaMismatch = Inlines -> Blocks
para Inlines
"Expected a schema, but didn't find one."
  describeIssue Orientation
ori (PathFragmentsDontMatch (orientProdCons ori -> ProdCons e a)) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Parameter changed from " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
e Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" to " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
a Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
"."

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

  describeBehavior :: Behave 'PathFragmentLevel 'SchemaLevel -> Inlines
describeBehavior Behave 'PathFragmentLevel 'SchemaLevel
InParamSchema = Inlines
"JSON Schema"

instance Subtree Param where
  type SubtreeLevel Param = 'PathFragmentLevel
  type CheckEnv Param = '[ProdCons (Traced (Definitions Schema))]
  checkStructuralCompatibility :: HList (CheckEnv Param)
-> ProdCons (Traced Param) -> StructuralCompatFormula ()
checkStructuralCompatibility HList (CheckEnv Param)
env ProdCons (Traced Param)
pc = do
    ProdCons (EnvT (Paths Step TraceRoot Param) Identity Text)
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Paths Step TraceRoot Param) Identity Text)
 -> StructuralCompatFormula ())
-> ProdCons (EnvT (Paths Step TraceRoot Param) Identity Text)
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Param -> Text)
-> Traced Param -> EnvT (Paths Step TraceRoot Param) Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Param -> Text
_paramName (Traced Param -> EnvT (Paths Step TraceRoot Param) Identity Text)
-> ProdCons (Traced Param)
-> ProdCons (EnvT (Paths Step TraceRoot Param) Identity Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Param)
pc
    ProdCons (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
 -> StructuralCompatFormula ())
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Param -> Maybe Bool)
-> Traced Param
-> EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Param -> Maybe Bool
_paramRequired (Traced Param
 -> EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> ProdCons (Traced Param)
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Param)
pc
    ProdCons (EnvT (Paths Step TraceRoot Param) Identity ParamLocation)
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons
   (EnvT (Paths Step TraceRoot Param) Identity ParamLocation)
 -> StructuralCompatFormula ())
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity ParamLocation)
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Param -> ParamLocation)
-> Traced Param
-> EnvT (Paths Step TraceRoot Param) Identity ParamLocation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Param -> ParamLocation
_paramIn (Traced Param
 -> EnvT (Paths Step TraceRoot Param) Identity ParamLocation)
-> ProdCons (Traced Param)
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity ParamLocation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Param)
pc
    ProdCons (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
 -> StructuralCompatFormula ())
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Param -> Maybe Bool)
-> Traced Param
-> EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Param -> Maybe Bool
_paramAllowEmptyValue (Traced Param
 -> EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> ProdCons (Traced Param)
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Param)
pc
    ProdCons (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
 -> StructuralCompatFormula ())
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Param -> Maybe Bool)
-> Traced Param
-> EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Param -> Maybe Bool
_paramAllowReserved (Traced Param
 -> EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> ProdCons (Traced Param)
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Param)
pc
    HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons (Maybe (Traced (Referenced Schema)))
-> StructuralCompatFormula ()
forall a (xs :: [*]).
(Subtree a, ReassembleHList xs (CheckEnv a)) =>
HList xs
-> ProdCons (Maybe (Traced a)) -> StructuralCompatFormula ()
structuralMaybe HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Param)
env (ProdCons (Maybe (Traced (Referenced Schema)))
 -> StructuralCompatFormula ())
-> ProdCons (Maybe (Traced (Referenced Schema)))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced Param -> Maybe (Traced (Referenced Schema))
tracedSchema (Traced Param -> Maybe (Traced (Referenced Schema)))
-> ProdCons (Traced Param)
-> ProdCons (Maybe (Traced (Referenced Schema)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Param)
pc
    ProdCons (EnvT (Paths Step TraceRoot Param) Identity (Maybe Style))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons
   (EnvT (Paths Step TraceRoot Param) Identity (Maybe Style))
 -> StructuralCompatFormula ())
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity (Maybe Style))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Param -> Maybe Style)
-> Traced Param
-> EnvT (Paths Step TraceRoot Param) Identity (Maybe Style)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Param -> Maybe Style
_paramStyle (Traced Param
 -> EnvT (Paths Step TraceRoot Param) Identity (Maybe Style))
-> ProdCons (Traced Param)
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity (Maybe Style))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Param)
pc
    ProdCons (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
 -> StructuralCompatFormula ())
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ (Param -> Maybe Bool)
-> Traced Param
-> EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Param -> Maybe Bool
_paramExplode (Traced Param
 -> EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
-> ProdCons (Traced Param)
-> ProdCons
     (EnvT (Paths Step TraceRoot Param) Identity (Maybe Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Param)
pc
    pure ()
  checkSemanticCompatibility :: HList (CheckEnv Param)
-> Behavior (SubtreeLevel Param)
-> ProdCons (Traced Param)
-> SemanticCompatFormula ()
checkSemanticCompatibility HList (CheckEnv Param)
env Behavior (SubtreeLevel Param)
beh pc :: ProdCons (Traced Param)
pc@(ProdCons Traced Param
p Traced Param
c) = do
    Bool -> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Param -> Text
_paramName (Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced Param
p) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Param -> Text
_paramName (Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced Param
c)) (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$
      Paths Behave 'APILevel 'PathFragmentLevel
-> Issue 'PathFragmentLevel -> 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 'PathFragmentLevel
Behavior (SubtreeLevel Param)
beh Issue 'PathFragmentLevel
ParamNameMismatch
    Bool -> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
      ( (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (Traced Param -> Maybe Bool) -> Traced Param -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Param -> Maybe Bool
_paramRequired (Param -> Maybe Bool)
-> (Traced Param -> Param) -> Traced Param -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> Bool) -> Traced Param -> Bool
forall a b. (a -> b) -> a -> b
$ Traced Param
c)
          Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (Traced Param -> Maybe Bool) -> Traced Param -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Param -> Maybe Bool
_paramRequired (Param -> Maybe Bool)
-> (Traced Param -> Param) -> Traced Param -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> Bool) -> Traced Param -> Bool
forall a b. (a -> b) -> a -> b
$ Traced Param
p)
      )
      (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Paths Behave 'APILevel 'PathFragmentLevel
-> Issue 'PathFragmentLevel -> 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 'PathFragmentLevel
Behavior (SubtreeLevel Param)
beh Issue 'PathFragmentLevel
ParamRequired
    case (Param -> ParamLocation
_paramIn (Param -> ParamLocation)
-> (Traced Param -> Param) -> Traced Param -> ParamLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> ParamLocation) -> Traced Param -> ParamLocation
forall a b. (a -> b) -> a -> b
$ Traced Param
p, Param -> ParamLocation
_paramIn (Param -> ParamLocation)
-> (Traced Param -> Param) -> Traced Param -> ParamLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> ParamLocation) -> Traced Param -> ParamLocation
forall a b. (a -> b) -> a -> b
$ Traced Param
c) of
      (ParamLocation
ParamQuery, ParamLocation
ParamQuery) -> do
        -- Emptiness is only for query params
        Bool -> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
          ( (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (Traced Param -> Maybe Bool) -> Traced Param -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Param -> Maybe Bool
_paramAllowEmptyValue (Param -> Maybe Bool)
-> (Traced Param -> Param) -> Traced Param -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> Bool) -> Traced Param -> Bool
forall a b. (a -> b) -> a -> b
$ Traced Param
p)
              Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (Traced Param -> Maybe Bool) -> Traced Param -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Param -> Maybe Bool
_paramAllowEmptyValue (Param -> Maybe Bool)
-> (Traced Param -> Param) -> Traced Param -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> Bool) -> Traced Param -> Bool
forall a b. (a -> b) -> a -> b
$ Traced Param
c)
          )
          (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Paths Behave 'APILevel 'PathFragmentLevel
-> Issue 'PathFragmentLevel -> 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 'PathFragmentLevel
Behavior (SubtreeLevel Param)
beh Issue 'PathFragmentLevel
ParamEmptinessIncompatible
      (ParamLocation
a, ParamLocation
b) | ParamLocation
a ParamLocation -> ParamLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ParamLocation
b -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      (ParamLocation, ParamLocation)
_ -> Paths Behave 'APILevel 'PathFragmentLevel
-> Issue 'PathFragmentLevel -> 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 'PathFragmentLevel
Behavior (SubtreeLevel Param)
beh Issue 'PathFragmentLevel
ParamPlaceIncompatible
    Bool -> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Param -> EncodingStyle
paramEncoding (Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced Param
p) EncodingStyle -> EncodingStyle -> Bool
forall a. Eq a => a -> a -> Bool
== Param -> EncodingStyle
paramEncoding (Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced Param
c)) (SemanticCompatFormula () -> SemanticCompatFormula ())
-> SemanticCompatFormula () -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$
      Paths Behave 'APILevel 'PathFragmentLevel
-> Issue 'PathFragmentLevel -> 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 'PathFragmentLevel
Behavior (SubtreeLevel Param)
beh Issue 'PathFragmentLevel
ParamStyleMismatch
    case Traced Param -> Maybe (Traced (Referenced Schema))
tracedSchema (Traced Param -> Maybe (Traced (Referenced Schema)))
-> ProdCons (Traced Param)
-> ProdCons (Maybe (Traced (Referenced Schema)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Param)
pc of
      ProdCons (Just Traced (Referenced Schema)
prodSchema) (Just Traced (Referenced Schema)
consSchema) -> do
        Behavior (SubtreeLevel (Referenced Schema))
-> HList '[ProdCons (Traced (Definitions Schema))]
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility (Paths Behave 'APILevel 'PathFragmentLevel
Behavior (SubtreeLevel Param)
beh Paths Behave 'APILevel 'PathFragmentLevel
-> Paths Behave 'PathFragmentLevel 'SchemaLevel
-> Paths Behave 'APILevel 'SchemaLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'PathFragmentLevel 'SchemaLevel
-> Paths Behave 'PathFragmentLevel 'SchemaLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Behave 'PathFragmentLevel 'SchemaLevel
InParamSchema) HList '[ProdCons (Traced (Definitions Schema))]
HList (CheckEnv Param)
env (ProdCons (Traced (Referenced Schema)) -> SemanticCompatFormula ())
-> ProdCons (Traced (Referenced Schema))
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced (Referenced Schema)
-> Traced (Referenced Schema)
-> ProdCons (Traced (Referenced Schema))
forall a. a -> a -> ProdCons a
ProdCons Traced (Referenced Schema)
prodSchema Traced (Referenced Schema)
consSchema
      ProdCons Maybe (Traced (Referenced Schema))
Nothing Maybe (Traced (Referenced Schema))
Nothing -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      ProdCons Maybe (Traced (Referenced Schema))
Nothing (Just Traced (Referenced Schema)
_consSchema) -> Paths Behave 'APILevel 'PathFragmentLevel
-> Issue 'PathFragmentLevel -> 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 'PathFragmentLevel
Behavior (SubtreeLevel Param)
beh Issue 'PathFragmentLevel
ParamSchemaMismatch
      ProdCons (Just Traced (Referenced Schema)
_prodSchema) Maybe (Traced (Referenced Schema))
Nothing -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    -- If consumer doesn't care then why we should?
    pure ()

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