{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fconstraint-solver-iterations=0 #-}

module Data.OpenApi.Compare.Validate.Operation
  ( -- * Operation
    MatchedOperation (..),
    OperationMethod (..),
    pathItemMethod,

    -- * ProcessedPathItem
    ProcessedPathItem (..),
    ProcessedPathItems (..),
    processPathItems,
    Step (..),
    Behave (..),
    Issue (..),
  )
where

import Control.Arrow
import Control.Comonad.Env
import Control.Monad
import Data.Foldable as F
import Data.Functor
import Data.HList
import qualified Data.HashMap.Strict.InsOrd as IOHM
import qualified Data.List as L
import Data.Map.Strict as M
import Data.Maybe
import Data.OpenApi
import Data.OpenApi.Compare.Behavior
import Data.OpenApi.Compare.References
import Data.OpenApi.Compare.Subtree
import Data.OpenApi.Compare.Validate.MediaTypeObject
import Data.OpenApi.Compare.Validate.OAuth2Flows
import Data.OpenApi.Compare.Validate.PathFragment
import Data.OpenApi.Compare.Validate.Products
import Data.OpenApi.Compare.Validate.RequestBody
import Data.OpenApi.Compare.Validate.Responses
import Data.OpenApi.Compare.Validate.SecurityRequirement ()
import Data.OpenApi.Compare.Validate.Server ()
import Data.OpenApi.Compare.Validate.Sums
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import Text.Pandoc.Builder

data MatchedOperation = MatchedOperation
  { MatchedOperation -> Operation
operation :: !Operation
  , -- | Params from the PathItem
    MatchedOperation -> [Traced Param]
pathParams :: ![Traced Param]
  , -- | Path fragments traced from PathItem. Takes full list of
    -- operation-specific parameters
    MatchedOperation -> [Traced Param] -> [Traced PathFragmentParam]
getPathFragments :: !([Traced Param] -> [Traced PathFragmentParam])
  }

type ParamKey = (ParamLocation, Text)

paramKey :: Param -> ParamKey
paramKey :: Param -> ParamKey
paramKey Param
param = (Param -> ParamLocation
_paramIn Param
param, Param -> Text
_paramName Param
param)

tracedParameters :: Traced MatchedOperation -> [Traced (Referenced Param)]
tracedParameters :: Traced MatchedOperation -> [Traced (Referenced Param)]
tracedParameters Traced MatchedOperation
oper =
  [ Trace (Referenced Param)
-> Referenced Param -> Traced (Referenced Param)
forall a. Trace a -> a -> Traced a
traced (Traced MatchedOperation -> Paths Step TraceRoot MatchedOperation
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced MatchedOperation
oper Paths Step TraceRoot MatchedOperation
-> Paths Step MatchedOperation (Referenced Param)
-> Trace (Referenced Param)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step MatchedOperation (Referenced Param)
-> Paths Step MatchedOperation (Referenced Param)
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Int -> Step MatchedOperation (Referenced Param)
OperationParamsStep Int
i)) Referenced Param
x
  | (Int
i, Referenced Param
x) <- [Int] -> [Referenced Param] -> [(Int, Referenced Param)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ([Referenced Param] -> [(Int, Referenced Param)])
-> [Referenced Param] -> [(Int, Referenced Param)]
forall a b. (a -> b) -> a -> b
$ Operation -> [Referenced Param]
_operationParameters (Operation -> [Referenced Param])
-> (MatchedOperation -> Operation)
-> MatchedOperation
-> [Referenced Param]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchedOperation -> Operation
operation (MatchedOperation -> [Referenced Param])
-> MatchedOperation -> [Referenced Param]
forall a b. (a -> b) -> a -> b
$ Traced MatchedOperation -> MatchedOperation
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced MatchedOperation
oper
  ]

tracedRequestBody :: Traced MatchedOperation -> Maybe (Traced (Referenced RequestBody))
tracedRequestBody :: Traced MatchedOperation -> Maybe (Traced (Referenced RequestBody))
tracedRequestBody Traced MatchedOperation
oper = Operation -> Maybe (Referenced RequestBody)
_operationRequestBody (MatchedOperation -> Operation
operation (MatchedOperation -> Operation) -> MatchedOperation -> Operation
forall a b. (a -> b) -> a -> b
$ Traced MatchedOperation -> MatchedOperation
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced MatchedOperation
oper) Maybe (Referenced RequestBody)
-> (Referenced RequestBody -> Traced (Referenced RequestBody))
-> Maybe (Traced (Referenced RequestBody))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Trace (Referenced RequestBody)
-> Referenced RequestBody -> Traced (Referenced RequestBody)
forall a. Trace a -> a -> Traced a
traced (Traced MatchedOperation -> Paths Step TraceRoot MatchedOperation
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced MatchedOperation
oper Paths Step TraceRoot MatchedOperation
-> Paths Step MatchedOperation (Referenced RequestBody)
-> Trace (Referenced RequestBody)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step MatchedOperation (Referenced RequestBody)
-> Paths Step MatchedOperation (Referenced RequestBody)
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Step MatchedOperation (Referenced RequestBody)
OperationRequestBodyStep)

tracedResponses :: Traced MatchedOperation -> Traced Responses
tracedResponses :: Traced MatchedOperation -> Traced Responses
tracedResponses Traced MatchedOperation
oper =
  Trace Responses -> Responses -> Traced Responses
forall a. Trace a -> a -> Traced a
traced (Traced MatchedOperation -> Paths Step TraceRoot MatchedOperation
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced MatchedOperation
oper Paths Step TraceRoot MatchedOperation
-> Paths Step MatchedOperation Responses -> Trace Responses
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step MatchedOperation Responses
-> Paths Step MatchedOperation Responses
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Step MatchedOperation Responses
OperationResponsesStep) (Responses -> Traced Responses) -> Responses -> Traced Responses
forall a b. (a -> b) -> a -> b
$
    Operation -> Responses
_operationResponses (Operation -> Responses)
-> (MatchedOperation -> Operation) -> MatchedOperation -> Responses
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchedOperation -> Operation
operation (MatchedOperation -> Responses) -> MatchedOperation -> Responses
forall a b. (a -> b) -> a -> b
$ Traced MatchedOperation -> MatchedOperation
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced MatchedOperation
oper

tracedSecurity :: Traced MatchedOperation -> [(Int, Traced SecurityRequirement)]
tracedSecurity :: Traced MatchedOperation -> [(Int, Traced SecurityRequirement)]
tracedSecurity Traced MatchedOperation
oper =
  [ (Int
i, Trace SecurityRequirement
-> SecurityRequirement -> Traced SecurityRequirement
forall a. Trace a -> a -> Traced a
traced (Traced MatchedOperation -> Paths Step TraceRoot MatchedOperation
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced MatchedOperation
oper Paths Step TraceRoot MatchedOperation
-> Paths Step MatchedOperation SecurityRequirement
-> Trace SecurityRequirement
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step MatchedOperation SecurityRequirement
-> Paths Step MatchedOperation SecurityRequirement
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Int -> Step MatchedOperation SecurityRequirement
OperationSecurityRequirementStep Int
i)) SecurityRequirement
x)
  | (Int
i, SecurityRequirement
x) <- [Int] -> [SecurityRequirement] -> [(Int, SecurityRequirement)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ([SecurityRequirement] -> [(Int, SecurityRequirement)])
-> [SecurityRequirement] -> [(Int, SecurityRequirement)]
forall a b. (a -> b) -> a -> b
$ Operation -> [SecurityRequirement]
_operationSecurity (Operation -> [SecurityRequirement])
-> (MatchedOperation -> Operation)
-> MatchedOperation
-> [SecurityRequirement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchedOperation -> Operation
operation (MatchedOperation -> [SecurityRequirement])
-> MatchedOperation -> [SecurityRequirement]
forall a b. (a -> b) -> a -> b
$ Traced MatchedOperation -> MatchedOperation
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced MatchedOperation
oper
  ]

tracedCallbacks :: Traced MatchedOperation -> [(Text, Traced (Referenced Callback))]
tracedCallbacks :: Traced MatchedOperation -> [(Text, Traced (Referenced Callback))]
tracedCallbacks (Traced Paths Step TraceRoot MatchedOperation
t MatchedOperation
oper) =
  [ (Text
k, Trace (Referenced Callback)
-> Referenced Callback -> Traced (Referenced Callback)
forall a b. Trace a -> b -> Traced' a b
Traced (Paths Step TraceRoot MatchedOperation
t Paths Step TraceRoot MatchedOperation
-> Paths Step MatchedOperation (Referenced Callback)
-> Trace (Referenced Callback)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step MatchedOperation (Referenced Callback)
-> Paths Step MatchedOperation (Referenced Callback)
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Text -> Step MatchedOperation (Referenced Callback)
OperationCallbackStep Text
k)) Referenced Callback
v)
  | (Text
k, Referenced Callback
v) <- InsOrdHashMap Text (Referenced Callback)
-> [(Text, Referenced Callback)]
forall k v. InsOrdHashMap k v -> [(k, v)]
IOHM.toList (InsOrdHashMap Text (Referenced Callback)
 -> [(Text, Referenced Callback)])
-> (MatchedOperation -> InsOrdHashMap Text (Referenced Callback))
-> MatchedOperation
-> [(Text, Referenced Callback)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Operation -> InsOrdHashMap Text (Referenced Callback)
_operationCallbacks (Operation -> InsOrdHashMap Text (Referenced Callback))
-> (MatchedOperation -> Operation)
-> MatchedOperation
-> InsOrdHashMap Text (Referenced Callback)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchedOperation -> Operation
operation (MatchedOperation -> [(Text, Referenced Callback)])
-> MatchedOperation -> [(Text, Referenced Callback)]
forall a b. (a -> b) -> a -> b
$ MatchedOperation
oper
  ]

-- FIXME: #28
getServers ::
  -- | Servers from env
  [Server] ->
  MatchedOperation ->
  [Server]
getServers :: [Server] -> MatchedOperation -> [Server]
getServers [Server]
env MatchedOperation
oper =
  case Operation -> [Server]
_operationServers (Operation -> [Server])
-> (MatchedOperation -> Operation) -> MatchedOperation -> [Server]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchedOperation -> Operation
operation (MatchedOperation -> [Server]) -> MatchedOperation -> [Server]
forall a b. (a -> b) -> a -> b
$ MatchedOperation
oper of
    [] -> [Server]
env
    [Server]
ss -> [Server]
ss

instance Behavable 'OperationLevel 'PathFragmentLevel where
  data Behave 'OperationLevel 'PathFragmentLevel
    = InParam Text
    | InFragment (PathFragment Text)
    deriving stock (Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
(Behave 'OperationLevel 'PathFragmentLevel
 -> Behave 'OperationLevel 'PathFragmentLevel -> Bool)
-> (Behave 'OperationLevel 'PathFragmentLevel
    -> Behave 'OperationLevel 'PathFragmentLevel -> Bool)
-> Eq (Behave 'OperationLevel 'PathFragmentLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
$c/= :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
== :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
$c== :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
Eq, Eq (Behave 'OperationLevel 'PathFragmentLevel)
Eq (Behave 'OperationLevel 'PathFragmentLevel)
-> (Behave 'OperationLevel 'PathFragmentLevel
    -> Behave 'OperationLevel 'PathFragmentLevel -> Ordering)
-> (Behave 'OperationLevel 'PathFragmentLevel
    -> Behave 'OperationLevel 'PathFragmentLevel -> Bool)
-> (Behave 'OperationLevel 'PathFragmentLevel
    -> Behave 'OperationLevel 'PathFragmentLevel -> Bool)
-> (Behave 'OperationLevel 'PathFragmentLevel
    -> Behave 'OperationLevel 'PathFragmentLevel -> Bool)
-> (Behave 'OperationLevel 'PathFragmentLevel
    -> Behave 'OperationLevel 'PathFragmentLevel -> Bool)
-> (Behave 'OperationLevel 'PathFragmentLevel
    -> Behave 'OperationLevel 'PathFragmentLevel
    -> Behave 'OperationLevel 'PathFragmentLevel)
-> (Behave 'OperationLevel 'PathFragmentLevel
    -> Behave 'OperationLevel 'PathFragmentLevel
    -> Behave 'OperationLevel 'PathFragmentLevel)
-> Ord (Behave 'OperationLevel 'PathFragmentLevel)
Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Ordering
Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel '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 :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel
$cmin :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel
max :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel
$cmax :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel
>= :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
$c>= :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
> :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
$c> :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
<= :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
$c<= :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
< :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
$c< :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Bool
compare :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Ordering
$ccompare :: Behave 'OperationLevel 'PathFragmentLevel
-> Behave 'OperationLevel 'PathFragmentLevel -> Ordering
$cp1Ord :: Eq (Behave 'OperationLevel 'PathFragmentLevel)
Ord, Int -> Behave 'OperationLevel 'PathFragmentLevel -> ShowS
[Behave 'OperationLevel 'PathFragmentLevel] -> ShowS
Behave 'OperationLevel 'PathFragmentLevel -> String
(Int -> Behave 'OperationLevel 'PathFragmentLevel -> ShowS)
-> (Behave 'OperationLevel 'PathFragmentLevel -> String)
-> ([Behave 'OperationLevel 'PathFragmentLevel] -> ShowS)
-> Show (Behave 'OperationLevel 'PathFragmentLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Behave 'OperationLevel 'PathFragmentLevel] -> ShowS
$cshowList :: [Behave 'OperationLevel 'PathFragmentLevel] -> ShowS
show :: Behave 'OperationLevel 'PathFragmentLevel -> String
$cshow :: Behave 'OperationLevel 'PathFragmentLevel -> String
showsPrec :: Int -> Behave 'OperationLevel 'PathFragmentLevel -> ShowS
$cshowsPrec :: Int -> Behave 'OperationLevel 'PathFragmentLevel -> ShowS
Show)
  describeBehavior :: Behave 'OperationLevel 'PathFragmentLevel -> Inlines
describeBehavior (InParam p) = Inlines
"Parameter " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
text Text
p
  describeBehavior (InFragment (StaticPath p)) = Inlines
"Static fragment " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
p
  describeBehavior (InFragment (DynamicPath p)) = Inlines
"Dynamic fragment " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
p

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

instance Behavable 'OperationLevel 'SecurityRequirementLevel where
  data Behave 'OperationLevel 'SecurityRequirementLevel
    = SecurityRequirementStep Int
    deriving stock (Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
(Behave 'OperationLevel 'SecurityRequirementLevel
 -> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool)
-> (Behave 'OperationLevel 'SecurityRequirementLevel
    -> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool)
-> Eq (Behave 'OperationLevel 'SecurityRequirementLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
$c/= :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
== :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
$c== :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
Eq, Eq (Behave 'OperationLevel 'SecurityRequirementLevel)
Eq (Behave 'OperationLevel 'SecurityRequirementLevel)
-> (Behave 'OperationLevel 'SecurityRequirementLevel
    -> Behave 'OperationLevel 'SecurityRequirementLevel -> Ordering)
-> (Behave 'OperationLevel 'SecurityRequirementLevel
    -> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool)
-> (Behave 'OperationLevel 'SecurityRequirementLevel
    -> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool)
-> (Behave 'OperationLevel 'SecurityRequirementLevel
    -> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool)
-> (Behave 'OperationLevel 'SecurityRequirementLevel
    -> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool)
-> (Behave 'OperationLevel 'SecurityRequirementLevel
    -> Behave 'OperationLevel 'SecurityRequirementLevel
    -> Behave 'OperationLevel 'SecurityRequirementLevel)
-> (Behave 'OperationLevel 'SecurityRequirementLevel
    -> Behave 'OperationLevel 'SecurityRequirementLevel
    -> Behave 'OperationLevel 'SecurityRequirementLevel)
-> Ord (Behave 'OperationLevel 'SecurityRequirementLevel)
Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Ordering
Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel
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 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel
$cmin :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel
max :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel
$cmax :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel
>= :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
$c>= :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
> :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
$c> :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
<= :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
$c<= :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
< :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
$c< :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Bool
compare :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Ordering
$ccompare :: Behave 'OperationLevel 'SecurityRequirementLevel
-> Behave 'OperationLevel 'SecurityRequirementLevel -> Ordering
$cp1Ord :: Eq (Behave 'OperationLevel 'SecurityRequirementLevel)
Ord, Int -> Behave 'OperationLevel 'SecurityRequirementLevel -> ShowS
[Behave 'OperationLevel 'SecurityRequirementLevel] -> ShowS
Behave 'OperationLevel 'SecurityRequirementLevel -> String
(Int -> Behave 'OperationLevel 'SecurityRequirementLevel -> ShowS)
-> (Behave 'OperationLevel 'SecurityRequirementLevel -> String)
-> ([Behave 'OperationLevel 'SecurityRequirementLevel] -> ShowS)
-> Show (Behave 'OperationLevel 'SecurityRequirementLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Behave 'OperationLevel 'SecurityRequirementLevel] -> ShowS
$cshowList :: [Behave 'OperationLevel 'SecurityRequirementLevel] -> ShowS
show :: Behave 'OperationLevel 'SecurityRequirementLevel -> String
$cshow :: Behave 'OperationLevel 'SecurityRequirementLevel -> String
showsPrec :: Int -> Behave 'OperationLevel 'SecurityRequirementLevel -> ShowS
$cshowsPrec :: Int -> Behave 'OperationLevel 'SecurityRequirementLevel -> ShowS
Show)
  describeBehavior :: Behave 'OperationLevel 'SecurityRequirementLevel -> Inlines
describeBehavior (SecurityRequirementStep i) =
    Inlines
"Security requirement " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> (Text -> Inlines
text (Text -> Inlines) -> (Int -> Text) -> Int -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Inlines) -> Int -> Inlines
forall a b. (a -> b) -> a -> b
$ Int
i)

instance Subtree MatchedOperation where
  type SubtreeLevel MatchedOperation = 'OperationLevel
  type
    CheckEnv MatchedOperation =
      '[ ProdCons (Traced (Definitions Param))
       , ProdCons (Traced (Definitions RequestBody))
       , ProdCons (Traced (Definitions SecurityScheme))
       , ProdCons (Traced (Definitions Response))
       , ProdCons (Traced (Definitions Header))
       , ProdCons (Traced (Definitions Schema))
       , ProdCons [Server]
       , ProdCons (Traced (Definitions Link))
       , ProdCons (Traced (Definitions Callback))
       ]
  checkStructuralCompatibility :: HList (CheckEnv MatchedOperation)
-> ProdCons (Traced MatchedOperation) -> StructuralCompatFormula ()
checkStructuralCompatibility HList (CheckEnv MatchedOperation)
env ProdCons (Traced MatchedOperation)
pc = do
    let pParams :: ProdCons [Traced Param]
        pParams :: ProdCons [Traced Param]
pParams = do
          Traced (Definitions Param)
defs <- HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced (Definitions Param))
forall x (xs :: [*]) (t :: Bool). Has' x xs t => HList xs -> x
getH @(ProdCons (Traced (Definitions Param))) HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env
          [Traced (Referenced Param)]
op' <- Traced MatchedOperation -> [Traced (Referenced Param)]
tracedParameters (Traced MatchedOperation -> [Traced (Referenced Param)])
-> ProdCons (Traced MatchedOperation)
-> ProdCons [Traced (Referenced Param)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced MatchedOperation)
pc
          [Traced Param]
pp <- MatchedOperation -> [Traced Param]
pathParams (MatchedOperation -> [Traced Param])
-> (Traced MatchedOperation -> MatchedOperation)
-> Traced MatchedOperation
-> [Traced Param]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced MatchedOperation -> MatchedOperation
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced MatchedOperation -> [Traced Param])
-> ProdCons (Traced MatchedOperation) -> ProdCons [Traced Param]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced MatchedOperation)
pc
          pure $
            let o :: Map ParamKey (Traced Param)
o = [(ParamKey, Traced Param)] -> Map ParamKey (Traced Param)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ParamKey, Traced Param)] -> Map ParamKey (Traced Param))
-> [(ParamKey, Traced Param)] -> Map ParamKey (Traced Param)
forall a b. (a -> b) -> a -> b
$ do
                  Traced Param
param <- Traced (Definitions Param)
-> Traced (Referenced Param) -> Traced Param
forall a.
Typeable a =>
Traced (Definitions a) -> Traced (Referenced a) -> Traced a
dereference Traced (Definitions Param)
defs (Traced (Referenced Param) -> Traced Param)
-> [Traced (Referenced Param)] -> [Traced Param]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Traced (Referenced Param)]
op'
                  let key :: ParamKey
key = Param -> ParamKey
paramKey (Param -> ParamKey)
-> (Traced Param -> Param) -> Traced Param -> ParamKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> ParamKey) -> Traced Param -> ParamKey
forall a b. (a -> b) -> a -> b
$ Traced Param
param
                  (ParamKey, Traced Param) -> [(ParamKey, Traced Param)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParamKey
key, Traced Param
param)
                p :: Map ParamKey (Traced Param)
p = [(ParamKey, Traced Param)] -> Map ParamKey (Traced Param)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ParamKey, Traced Param)] -> Map ParamKey (Traced Param))
-> [(ParamKey, Traced Param)] -> Map ParamKey (Traced Param)
forall a b. (a -> b) -> a -> b
$ do
                  Traced Param
param <- [Traced Param]
pp
                  pure (Param -> ParamKey
paramKey (Param -> ParamKey)
-> (Traced Param -> Param) -> Traced Param -> ParamKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> ParamKey) -> Traced Param -> ParamKey
forall a b. (a -> b) -> a -> b
$ Traced Param
param, Traced Param
param)
             in Map ParamKey (Traced Param) -> [Traced Param]
forall k a. Map k a -> [a]
M.elems (Map ParamKey (Traced Param) -> [Traced Param])
-> Map ParamKey (Traced Param) -> [Traced Param]
forall a b. (a -> b) -> a -> b
$ Map ParamKey (Traced Param)
o Map ParamKey (Traced Param)
-> Map ParamKey (Traced Param) -> Map ParamKey (Traced Param)
forall a. Semigroup a => a -> a -> a
<> Map ParamKey (Traced Param)
p
    HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
-> ProdCons [Traced Param] -> StructuralCompatFormula ()
forall a (xs :: [*]).
(Subtree a, ReassembleHList xs (CheckEnv a)) =>
HList xs -> ProdCons [Traced a] -> StructuralCompatFormula ()
structuralList HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env ProdCons [Traced Param]
pParams
    HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
-> ProdCons (Maybe (Traced (Referenced RequestBody)))
-> StructuralCompatFormula ()
forall a (xs :: [*]).
(Subtree a, ReassembleHList xs (CheckEnv a)) =>
HList xs
-> ProdCons (Maybe (Traced a)) -> StructuralCompatFormula ()
structuralMaybe HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env (ProdCons (Maybe (Traced (Referenced RequestBody)))
 -> StructuralCompatFormula ())
-> ProdCons (Maybe (Traced (Referenced RequestBody)))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced MatchedOperation -> Maybe (Traced (Referenced RequestBody))
tracedRequestBody (Traced MatchedOperation
 -> Maybe (Traced (Referenced RequestBody)))
-> ProdCons (Traced MatchedOperation)
-> ProdCons (Maybe (Traced (Referenced RequestBody)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced MatchedOperation)
pc
    HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced Responses) -> StructuralCompatFormula ()
forall (xs :: [*]) t.
(ReassembleHList xs (CheckEnv t), Subtree t) =>
HList xs -> ProdCons (Traced t) -> StructuralCompatFormula ()
checkSubstructure HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env (ProdCons (Traced Responses) -> StructuralCompatFormula ())
-> ProdCons (Traced Responses) -> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced MatchedOperation -> Traced Responses
tracedResponses (Traced MatchedOperation -> Traced Responses)
-> ProdCons (Traced MatchedOperation)
-> ProdCons (Traced Responses)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced MatchedOperation)
pc
    HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced [Server]) -> StructuralCompatFormula ()
forall (xs :: [*]) t.
(ReassembleHList xs (CheckEnv t), Subtree t) =>
HList xs -> ProdCons (Traced t) -> StructuralCompatFormula ()
checkSubstructure HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env (ProdCons (Traced [Server]) -> StructuralCompatFormula ())
-> ProdCons (Traced [Server]) -> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ do
      Traced MatchedOperation
x <- ProdCons (Traced MatchedOperation)
pc
      [Server]
se <- HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
-> ProdCons [Server]
forall x (xs :: [*]) (t :: Bool). Has' x xs t => HList xs -> x
getH @(ProdCons [Server]) HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env
      pure $ Trace [Server] -> [Server] -> Traced [Server]
forall a b. Trace a -> b -> Traced' a b
Traced (Traced MatchedOperation -> Paths Step TraceRoot MatchedOperation
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced MatchedOperation
x Paths Step TraceRoot MatchedOperation
-> Paths Step MatchedOperation [Server] -> Trace [Server]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step MatchedOperation [Server]
-> Paths Step MatchedOperation [Server]
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Step MatchedOperation [Server]
OperationServersStep) ([Server] -> MatchedOperation -> [Server]
getServers [Server]
se (Traced MatchedOperation -> MatchedOperation
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced MatchedOperation
x))
    HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
-> ProdCons [Traced SecurityRequirement]
-> StructuralCompatFormula ()
forall a (xs :: [*]).
(Subtree a, ReassembleHList xs (CheckEnv a)) =>
HList xs -> ProdCons [Traced a] -> StructuralCompatFormula ()
structuralList HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env (ProdCons [Traced SecurityRequirement]
 -> StructuralCompatFormula ())
-> ProdCons [Traced SecurityRequirement]
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ ((Int, Traced SecurityRequirement) -> Traced SecurityRequirement)
-> [(Int, Traced SecurityRequirement)]
-> [Traced SecurityRequirement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Traced SecurityRequirement) -> Traced SecurityRequirement
forall a b. (a, b) -> b
snd ([(Int, Traced SecurityRequirement)]
 -> [Traced SecurityRequirement])
-> (Traced MatchedOperation -> [(Int, Traced SecurityRequirement)])
-> Traced MatchedOperation
-> [Traced SecurityRequirement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced MatchedOperation -> [(Int, Traced SecurityRequirement)]
tracedSecurity (Traced MatchedOperation -> [Traced SecurityRequirement])
-> ProdCons (Traced MatchedOperation)
-> ProdCons [Traced SecurityRequirement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced MatchedOperation)
pc
    -- TODO: Callbacks
    pure ()
  checkSemanticCompatibility :: HList (CheckEnv MatchedOperation)
-> Behavior (SubtreeLevel MatchedOperation)
-> ProdCons (Traced MatchedOperation)
-> SemanticCompatFormula ()
checkSemanticCompatibility HList (CheckEnv MatchedOperation)
env Behavior (SubtreeLevel MatchedOperation)
beh ProdCons (Traced MatchedOperation)
prodCons = do
    SemanticCompatFormula ()
checkParameters
    SemanticCompatFormula ()
checkRequestBodies
    SemanticCompatFormula ()
checkResponses
    SemanticCompatFormula ()
checkCallbacks
    SemanticCompatFormula ()
checkOperationSecurity
    SemanticCompatFormula ()
checkServers
    pure ()
    where
      checkParameters :: SemanticCompatFormula ()
checkParameters = do
        let -- Merged parameters got from Operation and PathItem in one
            -- place. First element is path params, second is non-path params
            tracedParams :: ProdCons ([Traced Param], [Traced Param])
            tracedParams :: ProdCons ([Traced Param], [Traced Param])
tracedParams = Traced (Definitions Param)
-> Traced MatchedOperation -> ([Traced Param], [Traced Param])
getParams (Traced (Definitions Param)
 -> Traced MatchedOperation -> ([Traced Param], [Traced Param]))
-> ProdCons (Traced (Definitions Param))
-> ProdCons
     (Traced MatchedOperation -> ([Traced Param], [Traced Param]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced (Definitions Param))
paramDefs ProdCons
  (Traced MatchedOperation -> ([Traced Param], [Traced Param]))
-> ProdCons (Traced MatchedOperation)
-> ProdCons ([Traced Param], [Traced Param])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProdCons (Traced MatchedOperation)
prodCons
            getParams :: Traced (Definitions Param)
-> Traced MatchedOperation -> ([Traced Param], [Traced Param])
getParams Traced (Definitions Param)
defs Traced MatchedOperation
mp =
              let operationParamsMap :: Map ParamKey (Traced Param)
                  operationParamsMap :: Map ParamKey (Traced Param)
operationParamsMap = [(ParamKey, Traced Param)] -> Map ParamKey (Traced Param)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ParamKey, Traced Param)] -> Map ParamKey (Traced Param))
-> [(ParamKey, Traced Param)] -> Map ParamKey (Traced Param)
forall a b. (a -> b) -> a -> b
$ do
                    Traced (Referenced Param)
paramRef <- Traced MatchedOperation -> [Traced (Referenced Param)]
tracedParameters Traced MatchedOperation
mp
                    let param :: Traced Param
param = Traced (Definitions Param)
-> Traced (Referenced Param) -> Traced Param
forall a.
Typeable a =>
Traced (Definitions a) -> Traced (Referenced a) -> Traced a
dereference Traced (Definitions Param)
defs Traced (Referenced Param)
paramRef
                        key :: ParamKey
key = Param -> ParamKey
paramKey (Param -> ParamKey)
-> (Traced Param -> Param) -> Traced Param -> ParamKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> ParamKey) -> Traced Param -> ParamKey
forall a b. (a -> b) -> a -> b
$ Traced Param
param
                    (ParamKey, Traced Param) -> [(ParamKey, Traced Param)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParamKey
key, Traced Param
param)
                  pathParamsMap :: Map ParamKey (Traced Param)
                  pathParamsMap :: Map ParamKey (Traced Param)
pathParamsMap = [(ParamKey, Traced Param)] -> Map ParamKey (Traced Param)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ParamKey, Traced Param)] -> Map ParamKey (Traced Param))
-> [(ParamKey, Traced Param)] -> Map ParamKey (Traced Param)
forall a b. (a -> b) -> a -> b
$ do
                    Traced Param
param <- MatchedOperation -> [Traced Param]
pathParams (MatchedOperation -> [Traced Param])
-> (Traced MatchedOperation -> MatchedOperation)
-> Traced MatchedOperation
-> [Traced Param]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced MatchedOperation -> MatchedOperation
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced MatchedOperation -> [Traced Param])
-> Traced MatchedOperation -> [Traced Param]
forall a b. (a -> b) -> a -> b
$ Traced MatchedOperation
mp
                    pure (Param -> ParamKey
paramKey (Param -> ParamKey)
-> (Traced Param -> Param) -> Traced Param -> ParamKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> ParamKey) -> Traced Param -> ParamKey
forall a b. (a -> b) -> a -> b
$ Traced Param
param, Traced Param
param)
                  params :: [Traced Param]
params = Map ParamKey (Traced Param) -> [Traced Param]
forall k a. Map k a -> [a]
M.elems (Map ParamKey (Traced Param) -> [Traced Param])
-> Map ParamKey (Traced Param) -> [Traced Param]
forall a b. (a -> b) -> a -> b
$ Map ParamKey (Traced Param)
-> Map ParamKey (Traced Param) -> Map ParamKey (Traced Param)
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map ParamKey (Traced Param)
operationParamsMap Map ParamKey (Traced Param)
pathParamsMap -- We prefer params from Operation
                  splitted :: ([Traced Param], [Traced Param])
splitted =
                    (Traced Param -> Bool)
-> [Traced Param] -> ([Traced Param], [Traced Param])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition
                      (\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
p) ParamLocation -> ParamLocation -> Bool
forall a. Eq a => a -> a -> Bool
== ParamLocation
ParamPath)
                      [Traced Param]
params
               in ([Traced Param], [Traced Param])
splitted
        ProdCons [Traced Param] -> SemanticCompatFormula ()
checkNonPathParams (ProdCons [Traced Param] -> SemanticCompatFormula ())
-> ProdCons [Traced Param] -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ ([Traced Param], [Traced Param]) -> [Traced Param]
forall a b. (a, b) -> b
snd (([Traced Param], [Traced Param]) -> [Traced Param])
-> ProdCons ([Traced Param], [Traced Param])
-> ProdCons [Traced Param]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons ([Traced Param], [Traced Param])
tracedParams
        ProdCons [Traced Param] -> SemanticCompatFormula ()
checkPathParams (ProdCons [Traced Param] -> SemanticCompatFormula ())
-> ProdCons [Traced Param] -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ ([Traced Param], [Traced Param]) -> [Traced Param]
forall a b. (a, b) -> a
fst (([Traced Param], [Traced Param]) -> [Traced Param])
-> ProdCons ([Traced Param], [Traced Param])
-> ProdCons [Traced Param]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons ([Traced Param], [Traced Param])
tracedParams
        pure ()
      checkNonPathParams :: ProdCons [Traced Param] -> SemanticCompatFormula ()
      checkNonPathParams :: ProdCons [Traced Param] -> SemanticCompatFormula ()
checkNonPathParams ProdCons [Traced Param]
params = do
        let elements :: ProdCons (Map ParamKey (ProductLike (Traced Param)))
elements = [Traced Param] -> Map ParamKey (ProductLike (Traced Param))
forall (w :: * -> *).
Comonad w =>
[w Param] -> Map ParamKey (ProductLike (w Param))
getEls ([Traced Param] -> Map ParamKey (ProductLike (Traced Param)))
-> ProdCons [Traced Param]
-> ProdCons (Map ParamKey (ProductLike (Traced Param)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons [Traced Param]
params
            getEls :: [w Param] -> Map ParamKey (ProductLike (w Param))
getEls [w Param]
params = [(ParamKey, ProductLike (w Param))]
-> Map ParamKey (ProductLike (w Param))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ParamKey, ProductLike (w Param))]
 -> Map ParamKey (ProductLike (w Param)))
-> [(ParamKey, ProductLike (w Param))]
-> Map ParamKey (ProductLike (w Param))
forall a b. (a -> b) -> a -> b
$ do
              w Param
p <- [w Param]
params
              let k :: ParamKey
k = (Param -> ParamLocation
_paramIn (Param -> ParamLocation)
-> (w Param -> Param) -> w Param -> ParamLocation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w Param -> ParamLocation) -> w Param -> ParamLocation
forall a b. (a -> b) -> a -> b
$ w Param
p, Param -> Text
_paramName (Param -> Text) -> (w Param -> Param) -> w Param -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w Param -> Text) -> w Param -> Text
forall a b. (a -> b) -> a -> b
$ w Param
p)
                  v :: ProductLike (w Param)
v =
                    ProductLike :: forall a. a -> Bool -> ProductLike a
ProductLike
                      { $sel:productValue:ProductLike :: w Param
productValue = w Param
p
                      , $sel:required:ProductLike :: Bool
required = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> (w Param -> Maybe Bool) -> w Param -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Param -> Maybe Bool
_paramRequired (Param -> Maybe Bool)
-> (w Param -> Param) -> w Param -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (w Param -> Bool) -> w Param -> Bool
forall a b. (a -> b) -> a -> b
$ w Param
p
                      }
              (ParamKey, ProductLike (w Param))
-> [(ParamKey, ProductLike (w Param))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParamKey
k, ProductLike (w Param)
v)
            check :: ParamKey -> ProdCons (Traced Param) -> SemanticCompatFormula ()
check (ParamLocation
_, Text
name) ProdCons (Traced Param)
param =
              Behavior (SubtreeLevel Param)
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced Param)
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility @Param (Paths Behave 'APILevel 'OperationLevel
Behavior (SubtreeLevel MatchedOperation)
beh Paths Behave 'APILevel 'OperationLevel
-> Paths Behave 'OperationLevel 'PathFragmentLevel
-> Paths Behave 'APILevel 'PathFragmentLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'OperationLevel 'PathFragmentLevel
-> Paths Behave 'OperationLevel 'PathFragmentLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Text -> Behave 'OperationLevel 'PathFragmentLevel
InParam Text
name)) HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env ProdCons (Traced Param)
param
        Paths Behave 'APILevel 'OperationLevel
-> (ParamKey -> Issue 'OperationLevel)
-> (ParamKey
    -> ProdCons (Traced Param) -> SemanticCompatFormula ())
-> ProdCons (Map ParamKey (ProductLike (Traced Param)))
-> 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 (ProductLike t))
-> CompatFormula' q AnIssue r ()
checkProducts Paths Behave 'APILevel 'OperationLevel
Behavior (SubtreeLevel MatchedOperation)
beh (Text -> Issue 'OperationLevel
ParamNotMatched (Text -> Issue 'OperationLevel)
-> (ParamKey -> Text) -> ParamKey -> Issue 'OperationLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParamKey -> Text
forall a b. (a, b) -> b
snd) ParamKey -> ProdCons (Traced Param) -> SemanticCompatFormula ()
check ProdCons (Map ParamKey (ProductLike (Traced Param)))
elements
      checkPathParams :: ProdCons [Traced Param] -> SemanticCompatFormula ()
      checkPathParams :: ProdCons [Traced Param] -> SemanticCompatFormula ()
checkPathParams ProdCons [Traced Param]
pathParams = do
        let fragments :: ProdCons [Traced PathFragmentParam]
            fragments :: ProdCons [Traced PathFragmentParam]
fragments = [Traced Param]
-> Traced MatchedOperation -> [Traced PathFragmentParam]
forall (w :: * -> *).
Comonad w =>
[Traced Param] -> w MatchedOperation -> [Traced PathFragmentParam]
getFragments ([Traced Param]
 -> Traced MatchedOperation -> [Traced PathFragmentParam])
-> ProdCons [Traced Param]
-> ProdCons (Traced MatchedOperation -> [Traced PathFragmentParam])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons [Traced Param]
pathParams ProdCons (Traced MatchedOperation -> [Traced PathFragmentParam])
-> ProdCons (Traced MatchedOperation)
-> ProdCons [Traced PathFragmentParam]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProdCons (Traced MatchedOperation)
prodCons
            getFragments :: [Traced Param] -> w MatchedOperation -> [Traced PathFragmentParam]
getFragments [Traced Param]
params w MatchedOperation
mop = MatchedOperation -> [Traced Param] -> [Traced PathFragmentParam]
getPathFragments (w MatchedOperation -> MatchedOperation
forall (w :: * -> *) a. Comonad w => w a -> a
extract w MatchedOperation
mop) [Traced Param]
params
            -- Feed path parameters to the fragments getter
            check :: Int
-> ProdCons (Traced PathFragmentParam) -> SemanticCompatFormula ()
check Int
_ frags :: ProdCons (Traced PathFragmentParam)
frags@(ProdCons (Traced Trace PathFragmentParam
_ PathFragmentParam
p) Traced PathFragmentParam
_) =
              Behavior (SubtreeLevel PathFragmentParam)
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced PathFragmentParam)
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility @PathFragmentParam (Paths Behave 'APILevel 'OperationLevel
Behavior (SubtreeLevel MatchedOperation)
beh Paths Behave 'APILevel 'OperationLevel
-> Paths Behave 'OperationLevel 'PathFragmentLevel
-> Paths Behave 'APILevel 'PathFragmentLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'OperationLevel 'PathFragmentLevel
-> Paths Behave 'OperationLevel 'PathFragmentLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (PathFragment Text -> Behave 'OperationLevel 'PathFragmentLevel
InFragment (PathFragment Text -> Behave 'OperationLevel 'PathFragmentLevel)
-> PathFragment Text -> Behave 'OperationLevel 'PathFragmentLevel
forall a b. (a -> b) -> a -> b
$ Param -> Text
_paramName (Param -> Text) -> (Traced Param -> Param) -> Traced Param -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> Text) -> PathFragmentParam -> PathFragment Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PathFragmentParam
p)) HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env ProdCons (Traced PathFragmentParam)
frags
            elements :: ProdCons (Map Int (ProductLike (Traced PathFragmentParam)))
elements =
              ProdCons [Traced PathFragmentParam]
fragments ProdCons [Traced PathFragmentParam]
-> ([Traced PathFragmentParam]
    -> Map Int (ProductLike (Traced PathFragmentParam)))
-> ProdCons (Map Int (ProductLike (Traced PathFragmentParam)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[Traced PathFragmentParam]
frags -> [(Int, ProductLike (Traced PathFragmentParam))]
-> Map Int (ProductLike (Traced PathFragmentParam))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, ProductLike (Traced PathFragmentParam))]
 -> Map Int (ProductLike (Traced PathFragmentParam)))
-> [(Int, ProductLike (Traced PathFragmentParam))]
-> Map Int (ProductLike (Traced PathFragmentParam))
forall a b. (a -> b) -> a -> b
$
                [Int]
-> [ProductLike (Traced PathFragmentParam)]
-> [(Int, ProductLike (Traced PathFragmentParam))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] ([ProductLike (Traced PathFragmentParam)]
 -> [(Int, ProductLike (Traced PathFragmentParam))])
-> [ProductLike (Traced PathFragmentParam)]
-> [(Int, ProductLike (Traced PathFragmentParam))]
forall a b. (a -> b) -> a -> b
$ do
                  Traced PathFragmentParam
frag <- [Traced PathFragmentParam]
frags
                  pure $
                    ProductLike :: forall a. a -> Bool -> ProductLike a
ProductLike
                      { $sel:productValue:ProductLike :: Traced PathFragmentParam
productValue = Traced PathFragmentParam
frag
                      , $sel:required:ProductLike :: Bool
required = Bool
True
                      }
        Paths Behave 'APILevel 'OperationLevel
-> (Int -> Issue 'OperationLevel)
-> (Int
    -> ProdCons (Traced PathFragmentParam) -> SemanticCompatFormula ())
-> ProdCons (Map Int (ProductLike (Traced PathFragmentParam)))
-> 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 (ProductLike t))
-> CompatFormula' q AnIssue r ()
checkProducts Paths Behave 'APILevel 'OperationLevel
Behavior (SubtreeLevel MatchedOperation)
beh Int -> Issue 'OperationLevel
PathFragmentNotMatched Int
-> ProdCons (Traced PathFragmentParam) -> SemanticCompatFormula ()
check ProdCons (Map Int (ProductLike (Traced PathFragmentParam)))
elements
      checkRequestBodies :: SemanticCompatFormula ()
checkRequestBodies = do
        let check :: ProdCons (Traced RequestBody) -> SemanticCompatFormula ()
check ProdCons (Traced RequestBody)
reqBody = Behavior (SubtreeLevel RequestBody)
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced RequestBody)
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility @RequestBody (Paths Behave 'APILevel 'OperationLevel
Behavior (SubtreeLevel MatchedOperation)
beh Paths Behave 'APILevel 'OperationLevel
-> Paths Behave 'OperationLevel 'RequestLevel
-> Paths Behave 'APILevel 'RequestLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'OperationLevel 'RequestLevel
-> Paths Behave 'OperationLevel 'RequestLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Behave 'OperationLevel 'RequestLevel
InRequest) HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env ProdCons (Traced RequestBody)
reqBody
            elements :: ProdCons (Map () (ProductLike (Traced RequestBody)))
elements = Traced (Definitions RequestBody)
-> Traced MatchedOperation
-> Map () (ProductLike (Traced RequestBody))
getReqBody (Traced (Definitions RequestBody)
 -> Traced MatchedOperation
 -> Map () (ProductLike (Traced RequestBody)))
-> ProdCons (Traced (Definitions RequestBody))
-> ProdCons
     (Traced MatchedOperation
      -> Map () (ProductLike (Traced RequestBody)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced (Definitions RequestBody))
bodyDefs ProdCons
  (Traced MatchedOperation
   -> Map () (ProductLike (Traced RequestBody)))
-> ProdCons (Traced MatchedOperation)
-> ProdCons (Map () (ProductLike (Traced RequestBody)))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProdCons (Traced MatchedOperation)
prodCons
            getReqBody :: Traced (Definitions RequestBody)
-> Traced MatchedOperation
-> Map () (ProductLike (Traced RequestBody))
getReqBody Traced (Definitions RequestBody)
bodyDef Traced MatchedOperation
mop = [((), ProductLike (Traced RequestBody))]
-> Map () (ProductLike (Traced RequestBody))
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([((), ProductLike (Traced RequestBody))]
 -> Map () (ProductLike (Traced RequestBody)))
-> [((), ProductLike (Traced RequestBody))]
-> Map () (ProductLike (Traced RequestBody))
forall a b. (a -> b) -> a -> b
$ do
              Traced (Referenced RequestBody)
bodyRef <- Maybe (Traced (Referenced RequestBody))
-> [Traced (Referenced RequestBody)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Maybe (Traced (Referenced RequestBody))
 -> [Traced (Referenced RequestBody)])
-> (Traced MatchedOperation
    -> Maybe (Traced (Referenced RequestBody)))
-> Traced MatchedOperation
-> [Traced (Referenced RequestBody)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced MatchedOperation -> Maybe (Traced (Referenced RequestBody))
tracedRequestBody (Traced MatchedOperation -> [Traced (Referenced RequestBody)])
-> Traced MatchedOperation -> [Traced (Referenced RequestBody)]
forall a b. (a -> b) -> a -> b
$ Traced MatchedOperation
mop
              let body :: Traced RequestBody
body = Traced (Definitions RequestBody)
-> Traced (Referenced RequestBody) -> Traced RequestBody
forall a.
Typeable a =>
Traced (Definitions a) -> Traced (Referenced a) -> Traced a
dereference Traced (Definitions RequestBody)
bodyDef Traced (Referenced RequestBody)
bodyRef
              -- Single element map
              ((), ProductLike (Traced RequestBody))
-> [((), ProductLike (Traced RequestBody))]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                ( ()
                , ProductLike :: forall a. a -> Bool -> ProductLike a
ProductLike
                    { $sel:productValue:ProductLike :: Traced RequestBody
productValue = Traced RequestBody
body
                    , $sel:required:ProductLike :: Bool
required = 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
body
                    }
                )
        Paths Behave 'APILevel 'OperationLevel
-> (() -> Issue 'OperationLevel)
-> (()
    -> ProdCons (Traced RequestBody) -> SemanticCompatFormula ())
-> ProdCons (Map () (ProductLike (Traced RequestBody)))
-> 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 (ProductLike t))
-> CompatFormula' q AnIssue r ()
checkProducts Paths Behave 'APILevel 'OperationLevel
Behavior (SubtreeLevel MatchedOperation)
beh (Issue 'OperationLevel -> () -> Issue 'OperationLevel
forall a b. a -> b -> a
const Issue 'OperationLevel
NoRequestBody) ((ProdCons (Traced RequestBody) -> SemanticCompatFormula ())
-> () -> ProdCons (Traced RequestBody) -> SemanticCompatFormula ()
forall a b. a -> b -> a
const ProdCons (Traced RequestBody) -> SemanticCompatFormula ()
check) ProdCons (Map () (ProductLike (Traced RequestBody)))
elements
      checkResponses :: SemanticCompatFormula ()
checkResponses =
        (HList
   '[ProdCons (Traced (Definitions Param)),
     ProdCons (Traced (Definitions RequestBody)),
     ProdCons (Traced (Definitions SecurityScheme)),
     ProdCons (Traced (Definitions Response)),
     ProdCons (Traced (Definitions Header)),
     ProdCons (Traced (Definitions Schema)), ProdCons [Server],
     ProdCons (Traced (Definitions Link)),
     ProdCons (Traced (Definitions Callback))]
 -> ProdCons (Traced Responses) -> SemanticCompatFormula ())
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced Responses)
-> SemanticCompatFormula ()
forall (xs :: [*]) x (q :: BehaviorLevel -> BehaviorLevel -> *)
       (r :: BehaviorLevel) a.
SwapEnvRoles xs =>
(HList xs -> ProdCons x -> CompatFormula' q AnIssue r a)
-> HList xs -> ProdCons x -> CompatFormula' q AnIssue r a
swapProdCons (Behavior (SubtreeLevel Responses)
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced Responses)
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility Behavior (SubtreeLevel Responses)
Behavior (SubtreeLevel MatchedOperation)
beh) HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env (ProdCons (Traced Responses) -> SemanticCompatFormula ())
-> ProdCons (Traced Responses) -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced MatchedOperation -> Traced Responses
tracedResponses (Traced MatchedOperation -> Traced Responses)
-> ProdCons (Traced MatchedOperation)
-> ProdCons (Traced Responses)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced MatchedOperation)
prodCons
      -- FIXME: #27
      checkCallbacks :: SemanticCompatFormula ()
checkCallbacks = do
        let ProdCons [(Text, Traced (Referenced Callback))]
pCallbacks [(Text, Traced (Referenced Callback))]
cCallbacks = Traced MatchedOperation -> [(Text, Traced (Referenced Callback))]
tracedCallbacks (Traced MatchedOperation -> [(Text, Traced (Referenced Callback))])
-> ProdCons (Traced MatchedOperation)
-> ProdCons [(Text, Traced (Referenced Callback))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced MatchedOperation)
prodCons
        [(Text, Traced (Referenced Callback))]
-> ((Text, Traced (Referenced Callback))
    -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Text, Traced (Referenced Callback))]
pCallbacks (((Text, Traced (Referenced Callback)) -> SemanticCompatFormula ())
 -> SemanticCompatFormula ())
-> ((Text, Traced (Referenced Callback))
    -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \(Text
k, Traced (Referenced Callback)
pCallback) -> do
          let beh' :: Paths Behave 'APILevel 'CallbackLevel
beh' = Paths Behave 'APILevel 'OperationLevel
Behavior (SubtreeLevel MatchedOperation)
beh Paths Behave 'APILevel 'OperationLevel
-> Paths Behave 'OperationLevel 'CallbackLevel
-> Paths Behave 'APILevel 'CallbackLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'OperationLevel 'CallbackLevel
-> Paths Behave 'OperationLevel 'CallbackLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Text -> Behave 'OperationLevel 'CallbackLevel
OperationCallback Text
k)
          Paths Behave 'APILevel 'CallbackLevel
-> Issue 'CallbackLevel
-> [SemanticCompatFormula ()]
-> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
       (q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l
-> Issue l
-> [CompatFormula' q AnIssue r a]
-> CompatFormula' q AnIssue r a
anyOfAt Paths Behave 'APILevel 'CallbackLevel
beh' Issue 'CallbackLevel
CallbacksUnsupported ([SemanticCompatFormula ()] -> SemanticCompatFormula ())
-> [SemanticCompatFormula ()] -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$
            [(Text, Traced (Referenced Callback))]
cCallbacks [(Text, Traced (Referenced Callback))]
-> ((Text, Traced (Referenced Callback))
    -> SemanticCompatFormula ())
-> [SemanticCompatFormula ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Text
_, Traced (Referenced Callback)
cCallback) -> do
              (HList
   '[ProdCons (Traced (Definitions Param)),
     ProdCons (Traced (Definitions RequestBody)),
     ProdCons (Traced (Definitions SecurityScheme)),
     ProdCons (Traced (Definitions Response)),
     ProdCons (Traced (Definitions Header)),
     ProdCons (Traced (Definitions Schema)), ProdCons [Server],
     ProdCons (Traced (Definitions Link)),
     ProdCons (Traced (Definitions Callback))]
 -> ProdCons (Traced (Referenced Callback))
 -> SemanticCompatFormula ())
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced (Referenced Callback))
-> SemanticCompatFormula ()
forall (xs :: [*]) x (q :: BehaviorLevel -> BehaviorLevel -> *)
       (r :: BehaviorLevel) a.
SwapEnvRoles xs =>
(HList xs -> ProdCons x -> CompatFormula' q AnIssue r a)
-> HList xs -> ProdCons x -> CompatFormula' q AnIssue r a
swapProdCons (Behavior (SubtreeLevel (Referenced Callback))
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced (Referenced Callback))
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility Paths Behave 'APILevel 'CallbackLevel
Behavior (SubtreeLevel (Referenced Callback))
beh') HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env (ProdCons (Traced (Referenced Callback))
 -> SemanticCompatFormula ())
-> ProdCons (Traced (Referenced Callback))
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced (Referenced Callback)
-> Traced (Referenced Callback)
-> ProdCons (Traced (Referenced Callback))
forall a. a -> a -> ProdCons a
ProdCons Traced (Referenced Callback)
pCallback Traced (Referenced Callback)
cCallback
        pure ()
      -- FIXME: #28
      checkOperationSecurity :: SemanticCompatFormula ()
checkOperationSecurity = do
        let ProdCons [(Int, Traced SecurityRequirement)]
pSecs [(Int, Traced SecurityRequirement)]
cSecs = Traced MatchedOperation -> [(Int, Traced SecurityRequirement)]
tracedSecurity (Traced MatchedOperation -> [(Int, Traced SecurityRequirement)])
-> ProdCons (Traced MatchedOperation)
-> ProdCons [(Int, Traced SecurityRequirement)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced MatchedOperation)
prodCons
        [(Int, Traced SecurityRequirement)]
-> ((Int, Traced SecurityRequirement) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Int, Traced SecurityRequirement)]
pSecs (((Int, Traced SecurityRequirement) -> SemanticCompatFormula ())
 -> SemanticCompatFormula ())
-> ((Int, Traced SecurityRequirement) -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, Traced SecurityRequirement
pSec) -> do
          let beh' :: Paths Behave 'APILevel 'SecurityRequirementLevel
beh' = Paths Behave 'APILevel 'OperationLevel
Behavior (SubtreeLevel MatchedOperation)
beh Paths Behave 'APILevel 'OperationLevel
-> Paths Behave 'OperationLevel 'SecurityRequirementLevel
-> Paths Behave 'APILevel 'SecurityRequirementLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'OperationLevel 'SecurityRequirementLevel
-> Paths Behave 'OperationLevel 'SecurityRequirementLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Int -> Behave 'OperationLevel 'SecurityRequirementLevel
SecurityRequirementStep Int
i)
          Paths Behave 'APILevel 'SecurityRequirementLevel
-> Issue 'SecurityRequirementLevel
-> [SemanticCompatFormula ()]
-> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
       (q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l
-> Issue l
-> [CompatFormula' q AnIssue r a]
-> CompatFormula' q AnIssue r a
anyOfAt Paths Behave 'APILevel 'SecurityRequirementLevel
beh' Issue 'SecurityRequirementLevel
SecurityRequirementNotMet ([SemanticCompatFormula ()] -> SemanticCompatFormula ())
-> [SemanticCompatFormula ()] -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$
            [(Int, Traced SecurityRequirement)]
cSecs [(Int, Traced SecurityRequirement)]
-> ((Int, Traced SecurityRequirement) -> SemanticCompatFormula ())
-> [SemanticCompatFormula ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Int
_, Traced SecurityRequirement
cSec) ->
              Behavior (SubtreeLevel SecurityRequirement)
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced SecurityRequirement)
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility Paths Behave 'APILevel 'SecurityRequirementLevel
Behavior (SubtreeLevel SecurityRequirement)
beh' HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env (ProdCons (Traced SecurityRequirement) -> SemanticCompatFormula ())
-> ProdCons (Traced SecurityRequirement)
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced SecurityRequirement
-> Traced SecurityRequirement
-> ProdCons (Traced SecurityRequirement)
forall a. a -> a -> ProdCons a
ProdCons Traced SecurityRequirement
pSec Traced SecurityRequirement
cSec
      checkServers :: SemanticCompatFormula ()
checkServers =
        Behavior (SubtreeLevel [Server])
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced [Server])
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility Behavior (SubtreeLevel [Server])
Behavior (SubtreeLevel MatchedOperation)
beh HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env (ProdCons (Traced [Server]) -> SemanticCompatFormula ())
-> ProdCons (Traced [Server]) -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ do
          Traced MatchedOperation
x <- ProdCons (Traced MatchedOperation)
prodCons
          [Server]
se <- HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
-> ProdCons [Server]
forall x (xs :: [*]) (t :: Bool). Has' x xs t => HList xs -> x
getH @(ProdCons [Server]) HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env
          pure $ Trace [Server] -> [Server] -> Traced [Server]
forall a b. Trace a -> b -> Traced' a b
Traced (Traced MatchedOperation -> Paths Step TraceRoot MatchedOperation
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced MatchedOperation
x Paths Step TraceRoot MatchedOperation
-> Paths Step MatchedOperation [Server] -> Trace [Server]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step MatchedOperation [Server]
-> Paths Step MatchedOperation [Server]
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Step MatchedOperation [Server]
OperationServersStep) ([Server] -> MatchedOperation -> [Server]
getServers [Server]
se (Traced MatchedOperation -> MatchedOperation
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced MatchedOperation
x))
      bodyDefs :: ProdCons (Traced (Definitions RequestBody))
bodyDefs = HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced (Definitions RequestBody))
forall x (xs :: [*]) (t :: Bool). Has' x xs t => HList xs -> x
getH @(ProdCons (Traced (Definitions RequestBody))) HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env
      paramDefs :: ProdCons (Traced (Definitions Param))
paramDefs = HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced (Definitions Param))
forall x (xs :: [*]) (t :: Bool). Has' x xs t => HList xs -> x
getH @(ProdCons (Traced (Definitions Param))) HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedOperation)
env

data OperationMethod
  = GetMethod
  | PutMethod
  | PostMethod
  | DeleteMethod
  | OptionsMethod
  | HeadMethod
  | PatchMethod
  | TraceMethod
  deriving stock (OperationMethod -> OperationMethod -> Bool
(OperationMethod -> OperationMethod -> Bool)
-> (OperationMethod -> OperationMethod -> Bool)
-> Eq OperationMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationMethod -> OperationMethod -> Bool
$c/= :: OperationMethod -> OperationMethod -> Bool
== :: OperationMethod -> OperationMethod -> Bool
$c== :: OperationMethod -> OperationMethod -> Bool
Eq, Eq OperationMethod
Eq OperationMethod
-> (OperationMethod -> OperationMethod -> Ordering)
-> (OperationMethod -> OperationMethod -> Bool)
-> (OperationMethod -> OperationMethod -> Bool)
-> (OperationMethod -> OperationMethod -> Bool)
-> (OperationMethod -> OperationMethod -> Bool)
-> (OperationMethod -> OperationMethod -> OperationMethod)
-> (OperationMethod -> OperationMethod -> OperationMethod)
-> Ord OperationMethod
OperationMethod -> OperationMethod -> Bool
OperationMethod -> OperationMethod -> Ordering
OperationMethod -> OperationMethod -> OperationMethod
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 :: OperationMethod -> OperationMethod -> OperationMethod
$cmin :: OperationMethod -> OperationMethod -> OperationMethod
max :: OperationMethod -> OperationMethod -> OperationMethod
$cmax :: OperationMethod -> OperationMethod -> OperationMethod
>= :: OperationMethod -> OperationMethod -> Bool
$c>= :: OperationMethod -> OperationMethod -> Bool
> :: OperationMethod -> OperationMethod -> Bool
$c> :: OperationMethod -> OperationMethod -> Bool
<= :: OperationMethod -> OperationMethod -> Bool
$c<= :: OperationMethod -> OperationMethod -> Bool
< :: OperationMethod -> OperationMethod -> Bool
$c< :: OperationMethod -> OperationMethod -> Bool
compare :: OperationMethod -> OperationMethod -> Ordering
$ccompare :: OperationMethod -> OperationMethod -> Ordering
$cp1Ord :: Eq OperationMethod
Ord, Int -> OperationMethod -> ShowS
[OperationMethod] -> ShowS
OperationMethod -> String
(Int -> OperationMethod -> ShowS)
-> (OperationMethod -> String)
-> ([OperationMethod] -> ShowS)
-> Show OperationMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperationMethod] -> ShowS
$cshowList :: [OperationMethod] -> ShowS
show :: OperationMethod -> String
$cshow :: OperationMethod -> String
showsPrec :: Int -> OperationMethod -> ShowS
$cshowsPrec :: Int -> OperationMethod -> ShowS
Show)

pathItemMethod :: OperationMethod -> PathItem -> Maybe Operation
pathItemMethod :: OperationMethod -> PathItem -> Maybe Operation
pathItemMethod = \case
  OperationMethod
GetMethod -> PathItem -> Maybe Operation
_pathItemGet
  OperationMethod
PutMethod -> PathItem -> Maybe Operation
_pathItemPut
  OperationMethod
PostMethod -> PathItem -> Maybe Operation
_pathItemPost
  OperationMethod
DeleteMethod -> PathItem -> Maybe Operation
_pathItemDelete
  OperationMethod
OptionsMethod -> PathItem -> Maybe Operation
_pathItemOptions
  OperationMethod
HeadMethod -> PathItem -> Maybe Operation
_pathItemHead
  OperationMethod
PatchMethod -> PathItem -> Maybe Operation
_pathItemPatch
  OperationMethod
TraceMethod -> PathItem -> Maybe Operation
_pathItemTrace

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

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

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

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

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

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

-- * ProcessedPathItems

-- FIXME: There's probably a better name for this, but `PathItem` is already taken ;(
data ProcessedPathItem = ProcessedPathItem
  { ProcessedPathItem -> String
path :: FilePath
  , ProcessedPathItem -> PathItem
item :: PathItem
  }
  deriving stock (ProcessedPathItem -> ProcessedPathItem -> Bool
(ProcessedPathItem -> ProcessedPathItem -> Bool)
-> (ProcessedPathItem -> ProcessedPathItem -> Bool)
-> Eq ProcessedPathItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcessedPathItem -> ProcessedPathItem -> Bool
$c/= :: ProcessedPathItem -> ProcessedPathItem -> Bool
== :: ProcessedPathItem -> ProcessedPathItem -> Bool
$c== :: ProcessedPathItem -> ProcessedPathItem -> Bool
Eq, Int -> ProcessedPathItem -> ShowS
[ProcessedPathItem] -> ShowS
ProcessedPathItem -> String
(Int -> ProcessedPathItem -> ShowS)
-> (ProcessedPathItem -> String)
-> ([ProcessedPathItem] -> ShowS)
-> Show ProcessedPathItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcessedPathItem] -> ShowS
$cshowList :: [ProcessedPathItem] -> ShowS
show :: ProcessedPathItem -> String
$cshow :: ProcessedPathItem -> String
showsPrec :: Int -> ProcessedPathItem -> ShowS
$cshowsPrec :: Int -> ProcessedPathItem -> ShowS
Show)

processPathItems :: [(FilePath, PathItem)] -> ProcessedPathItems
processPathItems :: [(String, PathItem)] -> ProcessedPathItems
processPathItems = [ProcessedPathItem] -> ProcessedPathItems
ProcessedPathItems ([ProcessedPathItem] -> ProcessedPathItems)
-> ([(String, PathItem)] -> [ProcessedPathItem])
-> [(String, PathItem)]
-> ProcessedPathItems
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, PathItem) -> ProcessedPathItem)
-> [(String, PathItem)] -> [ProcessedPathItem]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> PathItem -> ProcessedPathItem)
-> (String, PathItem) -> ProcessedPathItem
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> PathItem -> ProcessedPathItem
ProcessedPathItem)

newtype ProcessedPathItems = ProcessedPathItems {ProcessedPathItems -> [ProcessedPathItem]
unProcessedPathItems :: [ProcessedPathItem]}
  deriving newtype (ProcessedPathItems -> ProcessedPathItems -> Bool
(ProcessedPathItems -> ProcessedPathItems -> Bool)
-> (ProcessedPathItems -> ProcessedPathItems -> Bool)
-> Eq ProcessedPathItems
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcessedPathItems -> ProcessedPathItems -> Bool
$c/= :: ProcessedPathItems -> ProcessedPathItems -> Bool
== :: ProcessedPathItems -> ProcessedPathItems -> Bool
$c== :: ProcessedPathItems -> ProcessedPathItems -> Bool
Eq, Int -> ProcessedPathItems -> ShowS
[ProcessedPathItems] -> ShowS
ProcessedPathItems -> String
(Int -> ProcessedPathItems -> ShowS)
-> (ProcessedPathItems -> String)
-> ([ProcessedPathItems] -> ShowS)
-> Show ProcessedPathItems
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcessedPathItems] -> ShowS
$cshowList :: [ProcessedPathItems] -> ShowS
show :: ProcessedPathItems -> String
$cshow :: ProcessedPathItems -> String
showsPrec :: Int -> ProcessedPathItems -> ShowS
$cshowsPrec :: Int -> ProcessedPathItems -> ShowS
Show)

instance Issuable 'APILevel where
  data Issue 'APILevel
    = NoPathsMatched FilePath
    | AllPathsFailed FilePath
    -- When several paths match given but all checks failed
    deriving stock (Issue 'APILevel -> Issue 'APILevel -> Bool
(Issue 'APILevel -> Issue 'APILevel -> Bool)
-> (Issue 'APILevel -> Issue 'APILevel -> Bool)
-> Eq (Issue 'APILevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue 'APILevel -> Issue 'APILevel -> Bool
$c/= :: Issue 'APILevel -> Issue 'APILevel -> Bool
== :: Issue 'APILevel -> Issue 'APILevel -> Bool
$c== :: Issue 'APILevel -> Issue 'APILevel -> Bool
Eq, Eq (Issue 'APILevel)
Eq (Issue 'APILevel)
-> (Issue 'APILevel -> Issue 'APILevel -> Ordering)
-> (Issue 'APILevel -> Issue 'APILevel -> Bool)
-> (Issue 'APILevel -> Issue 'APILevel -> Bool)
-> (Issue 'APILevel -> Issue 'APILevel -> Bool)
-> (Issue 'APILevel -> Issue 'APILevel -> Bool)
-> (Issue 'APILevel -> Issue 'APILevel -> Issue 'APILevel)
-> (Issue 'APILevel -> Issue 'APILevel -> Issue 'APILevel)
-> Ord (Issue 'APILevel)
Issue 'APILevel -> Issue 'APILevel -> Bool
Issue 'APILevel -> Issue 'APILevel -> Ordering
Issue 'APILevel -> Issue 'APILevel -> Issue 'APILevel
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 'APILevel -> Issue 'APILevel -> Issue 'APILevel
$cmin :: Issue 'APILevel -> Issue 'APILevel -> Issue 'APILevel
max :: Issue 'APILevel -> Issue 'APILevel -> Issue 'APILevel
$cmax :: Issue 'APILevel -> Issue 'APILevel -> Issue 'APILevel
>= :: Issue 'APILevel -> Issue 'APILevel -> Bool
$c>= :: Issue 'APILevel -> Issue 'APILevel -> Bool
> :: Issue 'APILevel -> Issue 'APILevel -> Bool
$c> :: Issue 'APILevel -> Issue 'APILevel -> Bool
<= :: Issue 'APILevel -> Issue 'APILevel -> Bool
$c<= :: Issue 'APILevel -> Issue 'APILevel -> Bool
< :: Issue 'APILevel -> Issue 'APILevel -> Bool
$c< :: Issue 'APILevel -> Issue 'APILevel -> Bool
compare :: Issue 'APILevel -> Issue 'APILevel -> Ordering
$ccompare :: Issue 'APILevel -> Issue 'APILevel -> Ordering
$cp1Ord :: Eq (Issue 'APILevel)
Ord, Int -> Issue 'APILevel -> ShowS
[Issue 'APILevel] -> ShowS
Issue 'APILevel -> String
(Int -> Issue 'APILevel -> ShowS)
-> (Issue 'APILevel -> String)
-> ([Issue 'APILevel] -> ShowS)
-> Show (Issue 'APILevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issue 'APILevel] -> ShowS
$cshowList :: [Issue 'APILevel] -> ShowS
show :: Issue 'APILevel -> String
$cshow :: Issue 'APILevel -> String
showsPrec :: Int -> Issue 'APILevel -> ShowS
$cshowsPrec :: Int -> Issue 'APILevel -> ShowS
Show)
  issueKind :: Issue 'APILevel -> IssueKind
issueKind = \case
    Issue 'APILevel
_ -> IssueKind
CertainIssue
  relatedIssues :: Issue 'APILevel -> Issue 'APILevel -> Bool
relatedIssues =
    Issue 'APILevel -> Issue 'APILevel -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Issue 'APILevel -> Issue 'APILevel -> Bool)
-> (Issue 'APILevel -> Maybe String)
-> Issue 'APILevel
-> Issue 'APILevel
-> Bool
forall b a.
Eq b =>
(a -> a -> Bool) -> (a -> Maybe b) -> a -> a -> Bool
`withClass` \case
      NoPathsMatched fp -> String -> Maybe String
forall a. a -> Maybe a
Just String
fp
      AllPathsFailed fp -> String -> Maybe String
forall a. a -> Maybe a
Just String
fp
  describeIssue :: Orientation -> Issue 'APILevel -> Blocks
describeIssue Orientation
Forward (NoPathsMatched p) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The path " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> (Text -> Inlines
code (Text -> Inlines) -> (String -> Text) -> String -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) String
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" has been removed."
  describeIssue Orientation
Backward (NoPathsMatched p) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The path " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> (Text -> Inlines
code (Text -> Inlines) -> (String -> Text) -> String -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) String
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" has been added."
  describeIssue Orientation
Forward (AllPathsFailed p) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The path " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> (Text -> Inlines
code (Text -> Inlines) -> (String -> Text) -> String -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) String
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" has been removed."
  describeIssue Orientation
Backward (AllPathsFailed p) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The path " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> (Text -> Inlines
code (Text -> Inlines) -> (String -> Text) -> String -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) String
p Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" has been added."

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

  describeBehavior :: Behave 'APILevel 'PathLevel -> Inlines
describeBehavior (AtPath p) = Text -> Inlines
str (String -> Text
T.pack String
p)

instance Subtree ProcessedPathItems where
  type SubtreeLevel ProcessedPathItems = 'APILevel
  type
    CheckEnv ProcessedPathItems =
      '[ ProdCons (Traced (Definitions Param))
       , ProdCons (Traced (Definitions RequestBody))
       , ProdCons (Traced (Definitions SecurityScheme))
       , ProdCons (Traced (Definitions Response))
       , ProdCons (Traced (Definitions Header))
       , ProdCons (Traced (Definitions Schema))
       , ProdCons [Server]
       , ProdCons (Traced (Definitions Link))
       , ProdCons (Traced (Definitions Callback))
       ]

  -- No real way to check it at this level
  checkStructuralCompatibility :: HList (CheckEnv ProcessedPathItems)
-> ProdCons (Traced ProcessedPathItems)
-> StructuralCompatFormula ()
checkStructuralCompatibility HList (CheckEnv ProcessedPathItems)
_ ProdCons (Traced ProcessedPathItems)
_ = StructuralCompatFormula ()
forall a. StructuralCompatFormula a
structuralIssue
  checkSemanticCompatibility :: HList (CheckEnv ProcessedPathItems)
-> Behavior (SubtreeLevel ProcessedPathItems)
-> ProdCons (Traced ProcessedPathItems)
-> SemanticCompatFormula ()
checkSemanticCompatibility HList (CheckEnv ProcessedPathItems)
env Behavior (SubtreeLevel ProcessedPathItems)
beh pc :: ProdCons (Traced ProcessedPathItems)
pc@(ProdCons Traced ProcessedPathItems
p Traced ProcessedPathItems
c) = do
    -- Each path generated by producer must be handled by consumer with exactly
    -- one way
    [ProcessedPathItem]
-> (ProcessedPathItem -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (ProcessedPathItems -> [ProcessedPathItem]
unProcessedPathItems (ProcessedPathItems -> [ProcessedPathItem])
-> (Traced ProcessedPathItems -> ProcessedPathItems)
-> Traced ProcessedPathItems
-> [ProcessedPathItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced ProcessedPathItems -> ProcessedPathItems
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced ProcessedPathItems -> [ProcessedPathItem])
-> Traced ProcessedPathItems -> [ProcessedPathItem]
forall a b. (a -> b) -> a -> b
$ Traced ProcessedPathItems
p) ((ProcessedPathItem -> SemanticCompatFormula ())
 -> SemanticCompatFormula ())
-> (ProcessedPathItem -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \ProcessedPathItem
prodItem -> do
      let prodPath :: String
prodPath = ProcessedPathItem -> String
path ProcessedPathItem
prodItem
          beh' :: Paths Behave 'APILevel 'PathLevel
beh' = Paths Behave 'APILevel 'APILevel
Behavior (SubtreeLevel ProcessedPathItems)
beh Paths Behave 'APILevel 'APILevel
-> Paths Behave 'APILevel 'PathLevel
-> Paths Behave 'APILevel 'PathLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'APILevel 'PathLevel -> Paths Behave 'APILevel 'PathLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (String -> Behave 'APILevel 'PathLevel
AtPath String
prodPath)
          matchedItems :: [ProdCons MatchedPathItem]
matchedItems = do
            ProcessedPathItem
consItem <- ProcessedPathItems -> [ProcessedPathItem]
unProcessedPathItems (ProcessedPathItems -> [ProcessedPathItem])
-> (Traced ProcessedPathItems -> ProcessedPathItems)
-> Traced ProcessedPathItems
-> [ProcessedPathItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced ProcessedPathItems -> ProcessedPathItems
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced ProcessedPathItems -> [ProcessedPathItem])
-> Traced ProcessedPathItems -> [ProcessedPathItem]
forall a b. (a -> b) -> a -> b
$ Traced ProcessedPathItems
c
            Maybe (ProdCons MatchedPathItem) -> [ProdCons MatchedPathItem]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Maybe (ProdCons MatchedPathItem) -> [ProdCons MatchedPathItem])
-> Maybe (ProdCons MatchedPathItem) -> [ProdCons MatchedPathItem]
forall a b. (a -> b) -> a -> b
$ ProdCons ProcessedPathItem -> Maybe (ProdCons MatchedPathItem)
matchingPathItems (ProdCons ProcessedPathItem -> Maybe (ProdCons MatchedPathItem))
-> ProdCons ProcessedPathItem -> Maybe (ProdCons MatchedPathItem)
forall a b. (a -> b) -> a -> b
$ ProcessedPathItem
-> ProcessedPathItem -> ProdCons ProcessedPathItem
forall a. a -> a -> ProdCons a
ProdCons ProcessedPathItem
prodItem ProcessedPathItem
consItem
      case [ProdCons MatchedPathItem]
matchedItems of
        [] -> Paths Behave 'APILevel 'APILevel
-> Issue 'APILevel -> 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 'APILevel
Behavior (SubtreeLevel ProcessedPathItems)
beh (Issue 'APILevel -> SemanticCompatFormula ())
-> Issue 'APILevel -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ String -> Issue 'APILevel
NoPathsMatched String
prodPath
        [ProdCons MatchedPathItem
match] -> Behavior (SubtreeLevel MatchedPathItem)
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced MatchedPathItem)
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility Paths Behave 'APILevel 'PathLevel
Behavior (SubtreeLevel MatchedPathItem)
beh' HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv ProcessedPathItems)
env (Traced ProcessedPathItems
-> MatchedPathItem -> Traced MatchedPathItem
forall (w :: * -> *) a.
ComonadEnv (Paths Step TraceRoot ProcessedPathItems) w =>
w a -> MatchedPathItem -> Traced MatchedPathItem
retraced (Traced ProcessedPathItems
 -> MatchedPathItem -> Traced MatchedPathItem)
-> ProdCons (Traced ProcessedPathItems)
-> ProdCons (MatchedPathItem -> Traced MatchedPathItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced ProcessedPathItems)
pc ProdCons (MatchedPathItem -> Traced MatchedPathItem)
-> ProdCons MatchedPathItem -> ProdCons (Traced MatchedPathItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProdCons MatchedPathItem
match)
        [ProdCons MatchedPathItem]
matches -> Paths Behave 'APILevel 'APILevel
-> Issue 'APILevel
-> [SemanticCompatFormula ()]
-> SemanticCompatFormula ()
forall (l :: BehaviorLevel)
       (q :: BehaviorLevel -> BehaviorLevel -> *) (r :: BehaviorLevel) a.
Issuable l =>
Paths q r l
-> Issue l
-> [CompatFormula' q AnIssue r a]
-> CompatFormula' q AnIssue r a
anyOfAt Paths Behave 'APILevel 'APILevel
Behavior (SubtreeLevel ProcessedPathItems)
beh (String -> Issue 'APILevel
AllPathsFailed String
prodPath) ([SemanticCompatFormula ()] -> SemanticCompatFormula ())
-> [SemanticCompatFormula ()] -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ do
          ProdCons MatchedPathItem
match <- [ProdCons MatchedPathItem]
matches
          pure $ Behavior (SubtreeLevel MatchedPathItem)
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced MatchedPathItem)
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility Paths Behave 'APILevel 'PathLevel
Behavior (SubtreeLevel MatchedPathItem)
beh' HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv ProcessedPathItems)
env (Traced ProcessedPathItems
-> MatchedPathItem -> Traced MatchedPathItem
forall (w :: * -> *) a.
ComonadEnv (Paths Step TraceRoot ProcessedPathItems) w =>
w a -> MatchedPathItem -> Traced MatchedPathItem
retraced (Traced ProcessedPathItems
 -> MatchedPathItem -> Traced MatchedPathItem)
-> ProdCons (Traced ProcessedPathItems)
-> ProdCons (MatchedPathItem -> Traced MatchedPathItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced ProcessedPathItems)
pc ProdCons (MatchedPathItem -> Traced MatchedPathItem)
-> ProdCons MatchedPathItem -> ProdCons (Traced MatchedPathItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProdCons MatchedPathItem
match)
    where
      retraced :: w a -> MatchedPathItem -> Traced MatchedPathItem
retraced w a
pc MatchedPathItem
mpi = Trace MatchedPathItem -> MatchedPathItem -> Traced MatchedPathItem
forall a. Trace a -> a -> Traced a
traced (w a -> Paths Step TraceRoot ProcessedPathItems
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask w a
pc Paths Step TraceRoot ProcessedPathItems
-> Paths Step ProcessedPathItems MatchedPathItem
-> Trace MatchedPathItem
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step ProcessedPathItems MatchedPathItem
-> Paths Step ProcessedPathItems MatchedPathItem
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (String -> Step ProcessedPathItems MatchedPathItem
MatchedPathStep (String -> Step ProcessedPathItems MatchedPathItem)
-> String -> Step ProcessedPathItems MatchedPathItem
forall a b. (a -> b) -> a -> b
$ MatchedPathItem -> String
matchedPath MatchedPathItem
mpi)) MatchedPathItem
mpi

-- | Preliminary checks two paths for compatibility.  Returns Nothing if two
-- paths obviously do not match: static parts differ or count of path elements
-- is not equal
matchingPathItems :: ProdCons ProcessedPathItem -> Maybe (ProdCons MatchedPathItem)
matchingPathItems :: ProdCons ProcessedPathItem -> Maybe (ProdCons MatchedPathItem)
matchingPathItems ProdCons ProcessedPathItem
prodCons = do
  let frags :: ProdCons [PathFragment Text]
frags = String -> [PathFragment Text]
parsePath (String -> [PathFragment Text])
-> (ProcessedPathItem -> String)
-> ProcessedPathItem
-> [PathFragment Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessedPathItem -> String
path (ProcessedPathItem -> [PathFragment Text])
-> ProdCons ProcessedPathItem -> ProdCons [PathFragment Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons ProcessedPathItem
prodCons
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ProdCons [PathFragment Text] -> Bool
fragsMatch ProdCons [PathFragment Text]
frags
  let mkMatchedItems :: [PathFragment Text] -> ProcessedPathItem -> MatchedPathItem
mkMatchedItems [PathFragment Text]
frag ProcessedPathItem
ppi =
        MatchedPathItem :: PathItem -> String -> [PathFragment Text] -> MatchedPathItem
MatchedPathItem
          { $sel:pathItem:MatchedPathItem :: PathItem
pathItem = ProcessedPathItem -> PathItem
item ProcessedPathItem
ppi
          , $sel:matchedPath:MatchedPathItem :: String
matchedPath = ProcessedPathItem -> String
path ProcessedPathItem
ppi
          , $sel:pathFragments:MatchedPathItem :: [PathFragment Text]
pathFragments = [PathFragment Text]
frag
          }
  ProdCons MatchedPathItem -> Maybe (ProdCons MatchedPathItem)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProdCons MatchedPathItem -> Maybe (ProdCons MatchedPathItem))
-> ProdCons MatchedPathItem -> Maybe (ProdCons MatchedPathItem)
forall a b. (a -> b) -> a -> b
$ [PathFragment Text] -> ProcessedPathItem -> MatchedPathItem
mkMatchedItems ([PathFragment Text] -> ProcessedPathItem -> MatchedPathItem)
-> ProdCons [PathFragment Text]
-> ProdCons (ProcessedPathItem -> MatchedPathItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons [PathFragment Text]
frags ProdCons (ProcessedPathItem -> MatchedPathItem)
-> ProdCons ProcessedPathItem -> ProdCons MatchedPathItem
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProdCons ProcessedPathItem
prodCons

fragsMatch :: ProdCons [PathFragment Text] -> Bool
fragsMatch :: ProdCons [PathFragment Text] -> Bool
fragsMatch (ProdCons [PathFragment Text]
p [PathFragment Text]
c) = Bool -> ([Bool] -> Bool) -> Maybe [Bool] -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and (Maybe [Bool] -> Bool) -> Maybe [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (PathFragment Text -> PathFragment Text -> Bool)
-> [PathFragment Text] -> [PathFragment Text] -> Maybe [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> Maybe [c]
zipAllWith PathFragment Text -> PathFragment Text -> Bool
forall param param.
PathFragment param -> PathFragment param -> Bool
check [PathFragment Text]
p [PathFragment Text]
c
  where
    check :: PathFragment param -> PathFragment param -> Bool
check (StaticPath Text
s1) (StaticPath Text
s2) = Text
s1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s2
    check PathFragment param
_ PathFragment param
_ = Bool
True

zipAllWith :: (a -> b -> c) -> [a] -> [b] -> Maybe [c]
zipAllWith :: (a -> b -> c) -> [a] -> [b] -> Maybe [c]
zipAllWith a -> b -> c
_ [] [] = [c] -> Maybe [c]
forall a. a -> Maybe a
Just []
zipAllWith a -> b -> c
f (a
x : [a]
xs) (b
y : [b]
ys) = (a -> b -> c
f a
x b
y c -> [c] -> [c]
forall a. a -> [a] -> [a]
:) ([c] -> [c]) -> Maybe [c] -> Maybe [c]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> b -> c) -> [a] -> [b] -> Maybe [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> Maybe [c]
zipAllWith a -> b -> c
f [a]
xs [b]
ys
zipAllWith a -> b -> c
_ (a
_ : [a]
_) [] = Maybe [c]
forall a. Maybe a
Nothing
zipAllWith a -> b -> c
_ [] (b
_ : [b]
_) = Maybe [c]
forall a. Maybe a
Nothing

data MatchedPathItem = MatchedPathItem
  { MatchedPathItem -> PathItem
pathItem :: !PathItem
  , MatchedPathItem -> String
matchedPath :: !FilePath
  , -- | Pre-parsed path from PathItem
    MatchedPathItem -> [PathFragment Text]
pathFragments :: ![PathFragment Text]
  }
  deriving stock (MatchedPathItem -> MatchedPathItem -> Bool
(MatchedPathItem -> MatchedPathItem -> Bool)
-> (MatchedPathItem -> MatchedPathItem -> Bool)
-> Eq MatchedPathItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchedPathItem -> MatchedPathItem -> Bool
$c/= :: MatchedPathItem -> MatchedPathItem -> Bool
== :: MatchedPathItem -> MatchedPathItem -> Bool
$c== :: MatchedPathItem -> MatchedPathItem -> Bool
Eq)

tracedMatchedPathItemParameters :: Traced MatchedPathItem -> [Traced (Referenced Param)]
tracedMatchedPathItemParameters :: Traced MatchedPathItem -> [Traced (Referenced Param)]
tracedMatchedPathItemParameters Traced MatchedPathItem
mpi =
  [ Trace (Referenced Param)
-> Referenced Param -> Traced (Referenced Param)
forall a. Trace a -> a -> Traced a
traced (Traced MatchedPathItem -> Trace MatchedPathItem
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced MatchedPathItem
mpi Trace MatchedPathItem
-> Paths Step MatchedPathItem (Referenced Param)
-> Trace (Referenced Param)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step MatchedPathItem (Referenced Param)
-> Paths Step MatchedPathItem (Referenced Param)
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Int -> Step MatchedPathItem (Referenced Param)
PathItemParam Int
i)) Referenced Param
x
  | (Int
i, Referenced Param
x) <- [Int] -> [Referenced Param] -> [(Int, Referenced Param)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [Int
0 ..] ([Referenced Param] -> [(Int, Referenced Param)])
-> [Referenced Param] -> [(Int, Referenced Param)]
forall a b. (a -> b) -> a -> b
$ PathItem -> [Referenced Param]
_pathItemParameters (PathItem -> [Referenced Param])
-> (MatchedPathItem -> PathItem)
-> MatchedPathItem
-> [Referenced Param]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchedPathItem -> PathItem
pathItem (MatchedPathItem -> [Referenced Param])
-> MatchedPathItem -> [Referenced Param]
forall a b. (a -> b) -> a -> b
$ Traced MatchedPathItem -> MatchedPathItem
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced MatchedPathItem
mpi
  ]

tracedFragments :: Traced MatchedPathItem -> [Env (Trace PathFragmentParam) (PathFragment Text)]
tracedFragments :: Traced MatchedPathItem
-> [Env (Trace PathFragmentParam) (PathFragment Text)]
tracedFragments Traced MatchedPathItem
mpi =
  [ Trace PathFragmentParam
-> PathFragment Text
-> Env (Trace PathFragmentParam) (PathFragment Text)
forall e a. e -> a -> Env e a
env (Traced MatchedPathItem -> Trace MatchedPathItem
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced MatchedPathItem
mpi Trace MatchedPathItem
-> Paths Step MatchedPathItem PathFragmentParam
-> Trace PathFragmentParam
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step MatchedPathItem PathFragmentParam
-> Paths Step MatchedPathItem PathFragmentParam
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Int -> Step MatchedPathItem PathFragmentParam
PathFragmentStep Int
i)) PathFragment Text
x
  | (Int
i, PathFragment Text
x) <- [Int] -> [PathFragment Text] -> [(Int, PathFragment Text)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [Int
0 ..] ([PathFragment Text] -> [(Int, PathFragment Text)])
-> [PathFragment Text] -> [(Int, PathFragment Text)]
forall a b. (a -> b) -> a -> b
$ MatchedPathItem -> [PathFragment Text]
pathFragments (MatchedPathItem -> [PathFragment Text])
-> MatchedPathItem -> [PathFragment Text]
forall a b. (a -> b) -> a -> b
$ Traced MatchedPathItem -> MatchedPathItem
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced MatchedPathItem
mpi
  ]

tracedMethod ::
  OperationMethod ->
  Traced MatchedPathItem ->
  Maybe (Traced' MatchedOperation Operation)
tracedMethod :: OperationMethod
-> Traced MatchedPathItem
-> Maybe (Traced' MatchedOperation Operation)
tracedMethod OperationMethod
s Traced MatchedPathItem
mpi = Paths Step TraceRoot MatchedOperation
-> Operation -> Traced' MatchedOperation Operation
forall e a. e -> a -> Env e a
env (Traced MatchedPathItem -> Trace MatchedPathItem
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced MatchedPathItem
mpi Trace MatchedPathItem
-> Paths Step MatchedPathItem MatchedOperation
-> Paths Step TraceRoot MatchedOperation
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step MatchedPathItem MatchedOperation
-> Paths Step MatchedPathItem MatchedOperation
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (OperationMethod -> Step MatchedPathItem MatchedOperation
OperationMethodStep OperationMethod
s)) (Operation -> Traced' MatchedOperation Operation)
-> Maybe Operation -> Maybe (Traced' MatchedOperation Operation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OperationMethod -> PathItem -> Maybe Operation
pathItemMethod OperationMethod
s (PathItem -> Maybe Operation)
-> (Traced MatchedPathItem -> PathItem)
-> Traced MatchedPathItem
-> Maybe Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchedPathItem -> PathItem
pathItem (MatchedPathItem -> PathItem)
-> (Traced MatchedPathItem -> MatchedPathItem)
-> Traced MatchedPathItem
-> PathItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced MatchedPathItem -> MatchedPathItem
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced MatchedPathItem -> Maybe Operation)
-> Traced MatchedPathItem -> Maybe Operation
forall a b. (a -> b) -> a -> b
$ Traced MatchedPathItem
mpi)

instance Issuable 'PathLevel where
  data Issue 'PathLevel
    = OperationMissing OperationMethod
    deriving stock (Issue 'PathLevel -> Issue 'PathLevel -> Bool
(Issue 'PathLevel -> Issue 'PathLevel -> Bool)
-> (Issue 'PathLevel -> Issue 'PathLevel -> Bool)
-> Eq (Issue 'PathLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
$c/= :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
== :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
$c== :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
Eq, Eq (Issue 'PathLevel)
Eq (Issue 'PathLevel)
-> (Issue 'PathLevel -> Issue 'PathLevel -> Ordering)
-> (Issue 'PathLevel -> Issue 'PathLevel -> Bool)
-> (Issue 'PathLevel -> Issue 'PathLevel -> Bool)
-> (Issue 'PathLevel -> Issue 'PathLevel -> Bool)
-> (Issue 'PathLevel -> Issue 'PathLevel -> Bool)
-> (Issue 'PathLevel -> Issue 'PathLevel -> Issue 'PathLevel)
-> (Issue 'PathLevel -> Issue 'PathLevel -> Issue 'PathLevel)
-> Ord (Issue 'PathLevel)
Issue 'PathLevel -> Issue 'PathLevel -> Bool
Issue 'PathLevel -> Issue 'PathLevel -> Ordering
Issue 'PathLevel -> Issue 'PathLevel -> Issue 'PathLevel
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 'PathLevel -> Issue 'PathLevel -> Issue 'PathLevel
$cmin :: Issue 'PathLevel -> Issue 'PathLevel -> Issue 'PathLevel
max :: Issue 'PathLevel -> Issue 'PathLevel -> Issue 'PathLevel
$cmax :: Issue 'PathLevel -> Issue 'PathLevel -> Issue 'PathLevel
>= :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
$c>= :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
> :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
$c> :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
<= :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
$c<= :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
< :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
$c< :: Issue 'PathLevel -> Issue 'PathLevel -> Bool
compare :: Issue 'PathLevel -> Issue 'PathLevel -> Ordering
$ccompare :: Issue 'PathLevel -> Issue 'PathLevel -> Ordering
$cp1Ord :: Eq (Issue 'PathLevel)
Ord, Int -> Issue 'PathLevel -> ShowS
[Issue 'PathLevel] -> ShowS
Issue 'PathLevel -> String
(Int -> Issue 'PathLevel -> ShowS)
-> (Issue 'PathLevel -> String)
-> ([Issue 'PathLevel] -> ShowS)
-> Show (Issue 'PathLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issue 'PathLevel] -> ShowS
$cshowList :: [Issue 'PathLevel] -> ShowS
show :: Issue 'PathLevel -> String
$cshow :: Issue 'PathLevel -> String
showsPrec :: Int -> Issue 'PathLevel -> ShowS
$cshowsPrec :: Int -> Issue 'PathLevel -> ShowS
Show)
  issueKind :: Issue 'PathLevel -> IssueKind
issueKind = \case
    OperationMissing _ -> IssueKind
CertainIssue
  describeIssue :: Orientation -> Issue 'PathLevel -> Blocks
describeIssue Orientation
Forward (OperationMissing op) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Method " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
strong (OperationMethod -> Inlines
forall s. IsString s => OperationMethod -> s
showMethod OperationMethod
op) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" has been removed."
  describeIssue Orientation
Backward (OperationMissing op) = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Method " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines -> Inlines
strong (OperationMethod -> Inlines
forall s. IsString s => OperationMethod -> s
showMethod OperationMethod
op) Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" has been added."

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

  describeBehavior :: Behave 'PathLevel 'OperationLevel -> Inlines
describeBehavior (InOperation method) = OperationMethod -> Inlines
forall s. IsString s => OperationMethod -> s
showMethod OperationMethod
method

showMethod :: IsString s => OperationMethod -> s
showMethod :: OperationMethod -> s
showMethod = \case
  OperationMethod
GetMethod -> s
"GET"
  OperationMethod
PutMethod -> s
"PUT"
  OperationMethod
PostMethod -> s
"POST"
  OperationMethod
DeleteMethod -> s
"DELETE"
  OperationMethod
OptionsMethod -> s
"OPTIONS"
  OperationMethod
HeadMethod -> s
"HEAD"
  OperationMethod
PatchMethod -> s
"PATCH"
  OperationMethod
TraceMethod -> s
"TRACE"

instance Subtree MatchedPathItem where
  type SubtreeLevel MatchedPathItem = 'PathLevel
  type
    CheckEnv MatchedPathItem =
      '[ ProdCons (Traced (Definitions Param))
       , ProdCons (Traced (Definitions RequestBody))
       , ProdCons (Traced (Definitions SecurityScheme))
       , ProdCons (Traced (Definitions Response))
       , ProdCons (Traced (Definitions Header))
       , ProdCons (Traced (Definitions Schema))
       , ProdCons [Server]
       , ProdCons (Traced (Definitions Link))
       , ProdCons (Traced (Definitions Callback))
       ]
  checkStructuralCompatibility :: HList (CheckEnv MatchedPathItem)
-> ProdCons (Traced MatchedPathItem) -> StructuralCompatFormula ()
checkStructuralCompatibility HList (CheckEnv MatchedPathItem)
_ ProdCons (Traced MatchedPathItem)
_ = StructuralCompatFormula ()
forall a. StructuralCompatFormula a
structuralIssue
  checkSemanticCompatibility :: HList (CheckEnv MatchedPathItem)
-> Behavior (SubtreeLevel MatchedPathItem)
-> ProdCons (Traced MatchedPathItem)
-> SemanticCompatFormula ()
checkSemanticCompatibility HList (CheckEnv MatchedPathItem)
env Behavior (SubtreeLevel MatchedPathItem)
beh ProdCons (Traced MatchedPathItem)
prodCons = do
    let paramDefs :: ProdCons (Traced (Definitions Param))
paramDefs = HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced (Definitions Param))
forall x (xs :: [*]) (t :: Bool). Has' x xs t => HList xs -> x
getH @(ProdCons (Traced (Definitions Param))) HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedPathItem)
env
        pathTracedParams :: ProdCons [Traced Param]
pathTracedParams = Traced (Definitions Param)
-> Traced MatchedPathItem -> [Traced Param]
getPathParams (Traced (Definitions Param)
 -> Traced MatchedPathItem -> [Traced Param])
-> ProdCons (Traced (Definitions Param))
-> ProdCons (Traced MatchedPathItem -> [Traced Param])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced (Definitions Param))
paramDefs ProdCons (Traced MatchedPathItem -> [Traced Param])
-> ProdCons (Traced MatchedPathItem) -> ProdCons [Traced Param]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProdCons (Traced MatchedPathItem)
prodCons
        getPathParams ::
          Traced (Definitions Param) ->
          Traced MatchedPathItem ->
          [Traced Param]
        getPathParams :: Traced (Definitions Param)
-> Traced MatchedPathItem -> [Traced Param]
getPathParams Traced (Definitions Param)
defs Traced MatchedPathItem
mpi = do
          Traced (Referenced Param)
paramRef <- Traced MatchedPathItem -> [Traced (Referenced Param)]
tracedMatchedPathItemParameters Traced MatchedPathItem
mpi
          pure $ Traced (Definitions Param)
-> Traced (Referenced Param) -> Traced Param
forall a.
Typeable a =>
Traced (Definitions a) -> Traced (Referenced a) -> Traced a
dereference Traced (Definitions Param)
defs Traced (Referenced Param)
paramRef
        pathTracedFragments :: ProdCons ([Traced Param] -> [Traced PathFragmentParam])
pathTracedFragments = Traced MatchedPathItem
-> [Traced Param] -> [Traced PathFragmentParam]
mkPathFragments (Traced MatchedPathItem
 -> [Traced Param] -> [Traced PathFragmentParam])
-> ProdCons (Traced MatchedPathItem)
-> ProdCons ([Traced Param] -> [Traced PathFragmentParam])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced MatchedPathItem)
prodCons
        mkPathFragments :: Traced MatchedPathItem
-> [Traced Param] -> [Traced PathFragmentParam]
mkPathFragments Traced MatchedPathItem
mpi [Traced Param]
operationParams =
          --  operationParams will be known on Operation check stage, so we give a
          --  function, returning fragments
          let paramsMap :: Map Text (Traced Param)
              paramsMap :: Map Text (Traced Param)
paramsMap = [(Text, Traced Param)] -> Map Text (Traced Param)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, Traced Param)] -> Map Text (Traced Param))
-> [(Text, Traced Param)] -> Map Text (Traced Param)
forall a b. (a -> b) -> a -> b
$ do
                Traced Param
tracedParam <- [Traced Param]
operationParams
                let pname :: Text
pname = Param -> Text
_paramName (Param -> Text) -> (Traced Param -> Param) -> Traced Param -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced Param -> Param
forall (w :: * -> *) a. Comonad w => w a -> a
extract (Traced Param -> Text) -> Traced Param -> Text
forall a b. (a -> b) -> a -> b
$ Traced Param
tracedParam
                (Text, Traced Param) -> [(Text, Traced Param)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
pname, Traced Param
tracedParam)
              convertFragment :: PathFragment Text -> PathFragmentParam
convertFragment = \case
                StaticPath Text
t -> Text -> PathFragmentParam
forall param. Text -> PathFragment param
StaticPath Text
t
                DynamicPath Text
pname ->
                  Traced Param -> PathFragmentParam
forall param. param -> PathFragment param
DynamicPath (Traced Param -> PathFragmentParam)
-> Traced Param -> PathFragmentParam
forall a b. (a -> b) -> a -> b
$
                    Traced Param -> Maybe (Traced Param) -> Traced Param
forall a. a -> Maybe a -> a
fromMaybe (String -> Traced Param
forall a. HasCallStack => String -> a
error (String -> Traced Param) -> String -> Traced Param
forall a b. (a -> b) -> a -> b
$ String
"Param not found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
pname) (Maybe (Traced Param) -> Traced Param)
-> Maybe (Traced Param) -> Traced Param
forall a b. (a -> b) -> a -> b
$
                      Text -> Map Text (Traced Param) -> Maybe (Traced Param)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
pname Map Text (Traced Param)
paramsMap
           in Traced MatchedPathItem
-> [Env (Trace PathFragmentParam) (PathFragment Text)]
tracedFragments Traced MatchedPathItem
mpi [Env (Trace PathFragmentParam) (PathFragment Text)]
-> (Env (Trace PathFragmentParam) (PathFragment Text)
    -> Traced PathFragmentParam)
-> [Traced PathFragmentParam]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (PathFragment Text -> PathFragmentParam)
-> Env (Trace PathFragmentParam) (PathFragment Text)
-> Traced PathFragmentParam
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PathFragment Text -> PathFragmentParam
convertFragment
        operations :: ProdCons (Map OperationMethod (Traced MatchedOperation))
operations = [Traced Param]
-> ([Traced Param] -> [Traced PathFragmentParam])
-> Traced MatchedPathItem
-> Map OperationMethod (Traced MatchedOperation)
getOperations ([Traced Param]
 -> ([Traced Param] -> [Traced PathFragmentParam])
 -> Traced MatchedPathItem
 -> Map OperationMethod (Traced MatchedOperation))
-> ProdCons [Traced Param]
-> ProdCons
     (([Traced Param] -> [Traced PathFragmentParam])
      -> Traced MatchedPathItem
      -> Map OperationMethod (Traced MatchedOperation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons [Traced Param]
pathTracedParams ProdCons
  (([Traced Param] -> [Traced PathFragmentParam])
   -> Traced MatchedPathItem
   -> Map OperationMethod (Traced MatchedOperation))
-> ProdCons ([Traced Param] -> [Traced PathFragmentParam])
-> ProdCons
     (Traced MatchedPathItem
      -> Map OperationMethod (Traced MatchedOperation))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProdCons ([Traced Param] -> [Traced PathFragmentParam])
pathTracedFragments ProdCons
  (Traced MatchedPathItem
   -> Map OperationMethod (Traced MatchedOperation))
-> ProdCons (Traced MatchedPathItem)
-> ProdCons (Map OperationMethod (Traced MatchedOperation))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProdCons (Traced MatchedPathItem)
prodCons
        getOperations :: [Traced Param]
-> ([Traced Param] -> [Traced PathFragmentParam])
-> Traced MatchedPathItem
-> Map OperationMethod (Traced MatchedOperation)
getOperations [Traced Param]
pathParams [Traced Param] -> [Traced PathFragmentParam]
getPathFragments Traced MatchedPathItem
mpi = [(OperationMethod, Traced MatchedOperation)]
-> Map OperationMethod (Traced MatchedOperation)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(OperationMethod, Traced MatchedOperation)]
 -> Map OperationMethod (Traced MatchedOperation))
-> [(OperationMethod, Traced MatchedOperation)]
-> Map OperationMethod (Traced MatchedOperation)
forall a b. (a -> b) -> a -> b
$ do
          (OperationMethod
name, Traced MatchedPathItem
-> Maybe (Traced' MatchedOperation Operation)
getOp) <-
            (OperationMethod -> OperationMethod
forall a. a -> a
id (OperationMethod -> OperationMethod)
-> (OperationMethod
    -> Traced MatchedPathItem
    -> Maybe (Traced' MatchedOperation Operation))
-> OperationMethod
-> (OperationMethod,
    Traced MatchedPathItem
    -> Maybe (Traced' MatchedOperation Operation))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& OperationMethod
-> Traced MatchedPathItem
-> Maybe (Traced' MatchedOperation Operation)
tracedMethod)
              (OperationMethod
 -> (OperationMethod,
     Traced MatchedPathItem
     -> Maybe (Traced' MatchedOperation Operation)))
-> [OperationMethod]
-> [(OperationMethod,
     Traced MatchedPathItem
     -> Maybe (Traced' MatchedOperation Operation))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OperationMethod
GetMethod, OperationMethod
PutMethod, OperationMethod
PostMethod, OperationMethod
DeleteMethod, OperationMethod
OptionsMethod, OperationMethod
HeadMethod, OperationMethod
PatchMethod, OperationMethod
DeleteMethod]
          Traced' MatchedOperation Operation
operation <- Maybe (Traced' MatchedOperation Operation)
-> [Traced' MatchedOperation Operation]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Maybe (Traced' MatchedOperation Operation)
 -> [Traced' MatchedOperation Operation])
-> Maybe (Traced' MatchedOperation Operation)
-> [Traced' MatchedOperation Operation]
forall a b. (a -> b) -> a -> b
$ Traced MatchedPathItem
-> Maybe (Traced' MatchedOperation Operation)
getOp Traced MatchedPathItem
mpi
          -- Got only Justs here
          let retraced :: Operation -> MatchedOperation
retraced = \Operation
op -> MatchedOperation :: Operation
-> [Traced Param]
-> ([Traced Param] -> [Traced PathFragmentParam])
-> MatchedOperation
MatchedOperation {$sel:operation:MatchedOperation :: Operation
operation = Operation
op, [Traced Param]
pathParams :: [Traced Param]
$sel:pathParams:MatchedOperation :: [Traced Param]
pathParams, [Traced Param] -> [Traced PathFragmentParam]
getPathFragments :: [Traced Param] -> [Traced PathFragmentParam]
$sel:getPathFragments:MatchedOperation :: [Traced Param] -> [Traced PathFragmentParam]
getPathFragments}
          (OperationMethod, Traced MatchedOperation)
-> [(OperationMethod, Traced MatchedOperation)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OperationMethod
name, Operation -> MatchedOperation
retraced (Operation -> MatchedOperation)
-> Traced' MatchedOperation Operation -> Traced MatchedOperation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Traced' MatchedOperation Operation
operation)
        check :: OperationMethod
-> ProdCons (Traced MatchedOperation) -> SemanticCompatFormula ()
check OperationMethod
name ProdCons (Traced MatchedOperation)
pc = Behavior (SubtreeLevel MatchedOperation)
-> HList
     '[ProdCons (Traced (Definitions Param)),
       ProdCons (Traced (Definitions RequestBody)),
       ProdCons (Traced (Definitions SecurityScheme)),
       ProdCons (Traced (Definitions Response)),
       ProdCons (Traced (Definitions Header)),
       ProdCons (Traced (Definitions Schema)), ProdCons [Server],
       ProdCons (Traced (Definitions Link)),
       ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced MatchedOperation)
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility @MatchedOperation (Paths Behave 'APILevel 'PathLevel
Behavior (SubtreeLevel MatchedPathItem)
beh Paths Behave 'APILevel 'PathLevel
-> Paths Behave 'PathLevel 'OperationLevel
-> Paths Behave 'APILevel 'OperationLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'PathLevel 'OperationLevel
-> Paths Behave 'PathLevel 'OperationLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (OperationMethod -> Behave 'PathLevel 'OperationLevel
InOperation OperationMethod
name)) HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)), ProdCons [Server],
    ProdCons (Traced (Definitions Link)),
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv MatchedPathItem)
env ProdCons (Traced MatchedOperation)
pc
    -- Operations are sum-like entities. Use step to operation as key because
    -- why not
    Paths Behave 'APILevel 'PathLevel
-> (OperationMethod -> Issue 'PathLevel)
-> (OperationMethod
    -> ProdCons (Traced MatchedOperation) -> SemanticCompatFormula ())
-> ProdCons (Map OperationMethod (Traced MatchedOperation))
-> 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 'PathLevel
Behavior (SubtreeLevel MatchedPathItem)
beh OperationMethod -> Issue 'PathLevel
OperationMissing OperationMethod
-> ProdCons (Traced MatchedOperation) -> SemanticCompatFormula ()
check ProdCons (Map OperationMethod (Traced MatchedOperation))
operations

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

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

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

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

-- * Callbacks

instance Subtree Callback where
  type SubtreeLevel Callback = 'CallbackLevel
  type
    CheckEnv Callback =
      '[ ProdCons (Traced (Definitions Param))
       , ProdCons (Traced (Definitions RequestBody))
       , ProdCons (Traced (Definitions SecurityScheme))
       , ProdCons (Traced (Definitions Response))
       , ProdCons (Traced (Definitions Header))
       , ProdCons (Traced (Definitions Schema))
       , ProdCons (Traced (Definitions Link))
       , ProdCons [Server]
       , ProdCons (Traced (Definitions Callback))
       ]
  checkStructuralCompatibility :: HList (CheckEnv Callback)
-> ProdCons (Traced Callback) -> StructuralCompatFormula ()
checkStructuralCompatibility HList (CheckEnv Callback)
env ProdCons (Traced Callback)
pc =
    HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)),
    ProdCons (Traced (Definitions Link)), ProdCons [Server],
    ProdCons (Traced (Definitions Callback))]
-> ProdCons (Traced ProcessedPathItems)
-> StructuralCompatFormula ()
forall (xs :: [*]) t.
(ReassembleHList xs (CheckEnv t), Subtree t) =>
HList xs -> ProdCons (Traced t) -> StructuralCompatFormula ()
checkSubstructure HList
  '[ProdCons (Traced (Definitions Param)),
    ProdCons (Traced (Definitions RequestBody)),
    ProdCons (Traced (Definitions SecurityScheme)),
    ProdCons (Traced (Definitions Response)),
    ProdCons (Traced (Definitions Header)),
    ProdCons (Traced (Definitions Schema)),
    ProdCons (Traced (Definitions Link)), ProdCons [Server],
    ProdCons (Traced (Definitions Callback))]
HList (CheckEnv Callback)
env (ProdCons (Traced ProcessedPathItems)
 -> StructuralCompatFormula ())
-> ProdCons (Traced ProcessedPathItems)
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Traced Callback -> Traced ProcessedPathItems
tracedCallbackPathItems (Traced Callback -> Traced ProcessedPathItems)
-> ProdCons (Traced Callback)
-> ProdCons (Traced ProcessedPathItems)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced Callback)
pc
  checkSemanticCompatibility :: HList (CheckEnv Callback)
-> Behavior (SubtreeLevel Callback)
-> ProdCons (Traced Callback)
-> SemanticCompatFormula ()
checkSemanticCompatibility HList (CheckEnv Callback)
_ Behavior (SubtreeLevel Callback)
bhv ProdCons (Traced Callback)
_ = Paths Behave 'APILevel 'CallbackLevel
-> Issue 'CallbackLevel -> 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 'CallbackLevel
Behavior (SubtreeLevel Callback)
bhv Issue 'CallbackLevel
CallbacksUnsupported

instance Issuable 'CallbackLevel where
  data Issue 'CallbackLevel
    = CallbacksUnsupported
    deriving stock (Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
(Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool)
-> (Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool)
-> Eq (Issue 'CallbackLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
$c/= :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
== :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
$c== :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
Eq, Eq (Issue 'CallbackLevel)
Eq (Issue 'CallbackLevel)
-> (Issue 'CallbackLevel -> Issue 'CallbackLevel -> Ordering)
-> (Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool)
-> (Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool)
-> (Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool)
-> (Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool)
-> (Issue 'CallbackLevel
    -> Issue 'CallbackLevel -> Issue 'CallbackLevel)
-> (Issue 'CallbackLevel
    -> Issue 'CallbackLevel -> Issue 'CallbackLevel)
-> Ord (Issue 'CallbackLevel)
Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
Issue 'CallbackLevel -> Issue 'CallbackLevel -> Ordering
Issue 'CallbackLevel
-> Issue 'CallbackLevel -> Issue 'CallbackLevel
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 'CallbackLevel
-> Issue 'CallbackLevel -> Issue 'CallbackLevel
$cmin :: Issue 'CallbackLevel
-> Issue 'CallbackLevel -> Issue 'CallbackLevel
max :: Issue 'CallbackLevel
-> Issue 'CallbackLevel -> Issue 'CallbackLevel
$cmax :: Issue 'CallbackLevel
-> Issue 'CallbackLevel -> Issue 'CallbackLevel
>= :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
$c>= :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
> :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
$c> :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
<= :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
$c<= :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
< :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
$c< :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Bool
compare :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Ordering
$ccompare :: Issue 'CallbackLevel -> Issue 'CallbackLevel -> Ordering
$cp1Ord :: Eq (Issue 'CallbackLevel)
Ord, Int -> Issue 'CallbackLevel -> ShowS
[Issue 'CallbackLevel] -> ShowS
Issue 'CallbackLevel -> String
(Int -> Issue 'CallbackLevel -> ShowS)
-> (Issue 'CallbackLevel -> String)
-> ([Issue 'CallbackLevel] -> ShowS)
-> Show (Issue 'CallbackLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issue 'CallbackLevel] -> ShowS
$cshowList :: [Issue 'CallbackLevel] -> ShowS
show :: Issue 'CallbackLevel -> String
$cshow :: Issue 'CallbackLevel -> String
showsPrec :: Int -> Issue 'CallbackLevel -> ShowS
$cshowsPrec :: Int -> Issue 'CallbackLevel -> ShowS
Show)
  issueKind :: Issue 'CallbackLevel -> IssueKind
issueKind = \case
    Issue 'CallbackLevel
CallbacksUnsupported -> IssueKind
Unsupported
  describeIssue :: Orientation -> Issue 'CallbackLevel -> Blocks
describeIssue Orientation
_ Issue 'CallbackLevel
CallbacksUnsupported = Inlines -> Blocks
para Inlines
"CompaREST does not currently support callbacks."

tracedCallbackPathItems :: Traced Callback -> Traced ProcessedPathItems
tracedCallbackPathItems :: Traced Callback -> Traced ProcessedPathItems
tracedCallbackPathItems (Traced Trace Callback
t (Callback InsOrdHashMap Text PathItem
x)) =
  Paths Step TraceRoot ProcessedPathItems
-> ProcessedPathItems -> Traced ProcessedPathItems
forall a b. Trace a -> b -> Traced' a b
Traced (Trace Callback
t Trace Callback
-> Paths Step Callback ProcessedPathItems
-> Paths Step TraceRoot ProcessedPathItems
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step Callback ProcessedPathItems
-> Paths Step Callback ProcessedPathItems
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Step Callback ProcessedPathItems
CallbackPathsStep) ([(String, PathItem)] -> ProcessedPathItems
processPathItems ([(String, PathItem)] -> ProcessedPathItems)
-> (InsOrdHashMap Text PathItem -> [(String, PathItem)])
-> InsOrdHashMap Text PathItem
-> ProcessedPathItems
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, PathItem) -> (String, PathItem))
-> [(Text, PathItem)] -> [(String, PathItem)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> String) -> (Text, PathItem) -> (String, PathItem)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> String
T.unpack) ([(Text, PathItem)] -> [(String, PathItem)])
-> (InsOrdHashMap Text PathItem -> [(Text, PathItem)])
-> InsOrdHashMap Text PathItem
-> [(String, PathItem)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap Text PathItem -> [(Text, PathItem)]
forall k v. InsOrdHashMap k v -> [(k, v)]
IOHM.toList (InsOrdHashMap Text PathItem -> ProcessedPathItems)
-> InsOrdHashMap Text PathItem -> ProcessedPathItems
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap Text PathItem
x)

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

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

  describeBehavior :: Behave 'OperationLevel 'CallbackLevel -> Inlines
describeBehavior (OperationCallback key) = Inlines
"Operation " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
key