{-# OPTIONS_GHC -Wno-orphans #-}

module Data.OpenApi.Compare.Validate.Server
  ( Issue (..),
  )
where

import Control.Applicative
import Control.Arrow ((&&&))
import Control.Comonad
import Control.Monad
import Data.Attoparsec.Text
import Data.Either
import Data.Foldable
import Data.Function
import Data.Functor
import Data.HashMap.Strict.InsOrd as IOHM
import qualified Data.HashSet.InsOrd as IOHM
import qualified Data.HashSet.InsOrd as IOHS
import Data.Maybe
import Data.OpenApi
import Data.OpenApi.Compare.Behavior
import Data.OpenApi.Compare.Common
import Data.OpenApi.Compare.Paths
import Data.OpenApi.Compare.Subtree
import Data.OpenApi.Compare.Validate.MediaTypeObject
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T
import Data.Traversable
import Text.Pandoc.Builder
import Prelude as P

tracedParsedServerUrlParts ::
  Server ->
  Either (Issue 'ServerLevel) ProcessedServer
tracedParsedServerUrlParts :: Server -> Either (Issue 'ServerLevel) ProcessedServer
tracedParsedServerUrlParts Server
s =
  let parsedUrl :: [ServerUrlPart Text]
parsedUrl = Text -> [ServerUrlPart Text]
parseServerUrl (Text -> [ServerUrlPart Text]) -> Text -> [ServerUrlPart Text]
forall a b. (a -> b) -> a -> b
$ Server -> Text
_serverUrl Server
s
      lookupVar :: Text -> Either (Issue 'ServerLevel) ServerVariable
lookupVar Text
var = case Text -> InsOrdHashMap Text ServerVariable -> Maybe ServerVariable
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
IOHM.lookup Text
var (Server -> InsOrdHashMap Text ServerVariable
_serverVariables Server
s) of
        Maybe ServerVariable
Nothing -> Issue 'ServerLevel -> Either (Issue 'ServerLevel) ServerVariable
forall a b. a -> Either a b
Left (Issue 'ServerLevel -> Either (Issue 'ServerLevel) ServerVariable)
-> Issue 'ServerLevel -> Either (Issue 'ServerLevel) ServerVariable
forall a b. (a -> b) -> a -> b
$ Text -> Issue 'ServerLevel
ServerVariableNotDefined Text
var
        Just ServerVariable
x -> ServerVariable -> Either (Issue 'ServerLevel) ServerVariable
forall a b. b -> Either a b
Right ServerVariable
x
   in (forall (f :: * -> *) a b.
(Traversable [], Applicative f) =>
(a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse @[] ((ServerUrlPart Text
  -> Either (Issue 'ServerLevel) (ServerUrlPart ServerVariable))
 -> [ServerUrlPart Text]
 -> Either (Issue 'ServerLevel) ProcessedServer)
-> ((Text -> Either (Issue 'ServerLevel) ServerVariable)
    -> ServerUrlPart Text
    -> Either (Issue 'ServerLevel) (ServerUrlPart ServerVariable))
-> (Text -> Either (Issue 'ServerLevel) ServerVariable)
-> [ServerUrlPart Text]
-> Either (Issue 'ServerLevel) ProcessedServer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
(Traversable ServerUrlPart, Applicative f) =>
(a -> f b) -> ServerUrlPart a -> f (ServerUrlPart b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse @ServerUrlPart) Text -> Either (Issue 'ServerLevel) ServerVariable
lookupVar [ServerUrlPart Text]
parsedUrl

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

  describeBehavior :: Behave 'OperationLevel 'ServerLevel -> Inlines
describeBehavior (InServer n) = Inlines
"Server " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
n

instance Subtree [Server] where
  type SubtreeLevel [Server] = 'OperationLevel
  type CheckEnv [Server] = '[]
  checkStructuralCompatibility :: HList (CheckEnv [Server])
-> ProdCons (Traced [Server]) -> StructuralCompatFormula ()
checkStructuralCompatibility HList (CheckEnv [Server])
_ ProdCons (Traced [Server])
pc =
    ProdCons
  (EnvT
     (Trace [Server])
     Identity
     (Set (Text, HashMap Text (Maybe (HashSet Text), Text))))
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons
   (EnvT
      (Trace [Server])
      Identity
      (Set (Text, HashMap Text (Maybe (HashSet Text), Text))))
 -> StructuralCompatFormula ())
-> ProdCons
     (EnvT
        (Trace [Server])
        Identity
        (Set (Text, HashMap Text (Maybe (HashSet Text), Text))))
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ ([(Text, HashMap Text (Maybe (HashSet Text), Text))]
 -> Set (Text, HashMap Text (Maybe (HashSet Text), Text)))
-> EnvT
     (Trace [Server])
     Identity
     [(Text, HashMap Text (Maybe (HashSet Text), Text))]
-> EnvT
     (Trace [Server])
     Identity
     (Set (Text, HashMap Text (Maybe (HashSet Text), Text)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, HashMap Text (Maybe (HashSet Text), Text))]
-> Set (Text, HashMap Text (Maybe (HashSet Text), Text))
forall a. Ord a => [a] -> Set a
S.fromList (EnvT
   (Trace [Server])
   Identity
   [(Text, HashMap Text (Maybe (HashSet Text), Text))]
 -> EnvT
      (Trace [Server])
      Identity
      (Set (Text, HashMap Text (Maybe (HashSet Text), Text))))
-> (Traced [Server]
    -> EnvT
         (Trace [Server])
         Identity
         [(Text, HashMap Text (Maybe (HashSet Text), Text))])
-> Traced [Server]
-> EnvT
     (Trace [Server])
     Identity
     (Set (Text, HashMap Text (Maybe (HashSet Text), Text)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Server] -> [(Text, HashMap Text (Maybe (HashSet Text), Text))])
-> Traced [Server]
-> EnvT
     (Trace [Server])
     Identity
     [(Text, HashMap Text (Maybe (HashSet Text), Text))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Server] -> [(Text, HashMap Text (Maybe (HashSet Text), Text))])
 -> Traced [Server]
 -> EnvT
      (Trace [Server])
      Identity
      [(Text, HashMap Text (Maybe (HashSet Text), Text))])
-> ((Server -> (Text, HashMap Text (Maybe (HashSet Text), Text)))
    -> [Server] -> [(Text, HashMap Text (Maybe (HashSet Text), Text))])
-> (Server -> (Text, HashMap Text (Maybe (HashSet Text), Text)))
-> Traced [Server]
-> EnvT
     (Trace [Server])
     Identity
     [(Text, HashMap Text (Maybe (HashSet Text), Text))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Server -> (Text, HashMap Text (Maybe (HashSet Text), Text)))
-> [Server] -> [(Text, HashMap Text (Maybe (HashSet Text), Text))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Server -> (Text, HashMap Text (Maybe (HashSet Text), Text))
reduceServer (Traced [Server]
 -> EnvT
      (Trace [Server])
      Identity
      (Set (Text, HashMap Text (Maybe (HashSet Text), Text))))
-> ProdCons (Traced [Server])
-> ProdCons
     (EnvT
        (Trace [Server])
        Identity
        (Set (Text, HashMap Text (Maybe (HashSet Text), Text))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProdCons (Traced [Server])
pc
    where
      reducerServerVariable :: ServerVariable -> (Maybe (HashSet Text), Text)
reducerServerVariable =
        (InsOrdHashSet Text -> HashSet Text)
-> Maybe (InsOrdHashSet Text) -> Maybe (HashSet Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InsOrdHashSet Text -> HashSet Text
forall k. InsOrdHashSet k -> HashSet k
IOHM.toHashSet (Maybe (InsOrdHashSet Text) -> Maybe (HashSet Text))
-> (ServerVariable -> Maybe (InsOrdHashSet Text))
-> ServerVariable
-> Maybe (HashSet Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerVariable -> Maybe (InsOrdHashSet Text)
_serverVariableEnum (ServerVariable -> Maybe (HashSet Text))
-> (ServerVariable -> Text)
-> ServerVariable
-> (Maybe (HashSet Text), Text)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ServerVariable -> Text
_serverVariableDefault
      reduceServer :: Server -> (Text, HashMap Text (Maybe (HashSet Text), Text))
reduceServer =
        Server -> Text
_serverUrl (Server -> Text)
-> (Server -> HashMap Text (Maybe (HashSet Text), Text))
-> Server
-> (Text, HashMap Text (Maybe (HashSet Text), Text))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (ServerVariable -> (Maybe (HashSet Text), Text))
-> HashMap Text ServerVariable
-> HashMap Text (Maybe (HashSet Text), Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ServerVariable -> (Maybe (HashSet Text), Text)
reducerServerVariable (HashMap Text ServerVariable
 -> HashMap Text (Maybe (HashSet Text), Text))
-> (Server -> HashMap Text ServerVariable)
-> Server
-> HashMap Text (Maybe (HashSet Text), Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap Text ServerVariable -> HashMap Text ServerVariable
forall k v. InsOrdHashMap k v -> HashMap k v
IOHM.toHashMap (InsOrdHashMap Text ServerVariable -> HashMap Text ServerVariable)
-> (Server -> InsOrdHashMap Text ServerVariable)
-> Server
-> HashMap Text ServerVariable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Server -> InsOrdHashMap Text ServerVariable
_serverVariables
  checkSemanticCompatibility :: HList (CheckEnv [Server])
-> Behavior (SubtreeLevel [Server])
-> ProdCons (Traced [Server])
-> SemanticCompatFormula ()
checkSemanticCompatibility HList (CheckEnv [Server])
env Behavior (SubtreeLevel [Server])
beh ProdCons (Traced [Server])
pcServer = do
    let (ProdCons ([CompatFormula' Behave AnIssue 'APILevel Any]
pErrs, [(Paths Behave 'APILevel 'ServerLevel,
  Traced' ProcessedServer ProcessedServer)]
pUrls) ([CompatFormula' Behave AnIssue 'APILevel Any]
cErrs, [(Paths Behave 'APILevel 'ServerLevel,
  Traced' ProcessedServer ProcessedServer)]
cUrls)) =
          ProdCons (Traced [Server])
pcServer
            ProdCons (Traced [Server])
-> (Traced [Server]
    -> ([CompatFormula' Behave AnIssue 'APILevel Any],
        [(Paths Behave 'APILevel 'ServerLevel,
          Traced' ProcessedServer ProcessedServer)]))
-> ProdCons
     ([CompatFormula' Behave AnIssue 'APILevel Any],
      [(Paths Behave 'APILevel 'ServerLevel,
        Traced' ProcessedServer ProcessedServer)])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Either
   (CompatFormula' Behave AnIssue 'APILevel Any)
   (Paths Behave 'APILevel 'ServerLevel,
    Traced' ProcessedServer ProcessedServer)]
-> ([CompatFormula' Behave AnIssue 'APILevel Any],
    [(Paths Behave 'APILevel 'ServerLevel,
      Traced' ProcessedServer ProcessedServer)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
              ([Either
    (CompatFormula' Behave AnIssue 'APILevel Any)
    (Paths Behave 'APILevel 'ServerLevel,
     Traced' ProcessedServer ProcessedServer)]
 -> ([CompatFormula' Behave AnIssue 'APILevel Any],
     [(Paths Behave 'APILevel 'ServerLevel,
       Traced' ProcessedServer ProcessedServer)]))
-> (Traced [Server]
    -> [Either
          (CompatFormula' Behave AnIssue 'APILevel Any)
          (Paths Behave 'APILevel 'ServerLevel,
           Traced' ProcessedServer ProcessedServer)])
-> Traced [Server]
-> ([CompatFormula' Behave AnIssue 'APILevel Any],
    [(Paths Behave 'APILevel 'ServerLevel,
      Traced' ProcessedServer ProcessedServer)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Traced' [Server] Server
 -> Either
      (CompatFormula' Behave AnIssue 'APILevel Any)
      (Paths Behave 'APILevel 'ServerLevel,
       Traced' ProcessedServer ProcessedServer))
-> [Traced' [Server] Server]
-> [Either
      (CompatFormula' Behave AnIssue 'APILevel Any)
      (Paths Behave 'APILevel 'ServerLevel,
       Traced' ProcessedServer ProcessedServer)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                ( \(Traced Trace [Server]
t Server
s) ->
                    let bhv :: Paths Behave 'APILevel 'ServerLevel
bhv = Paths Behave 'APILevel 'OperationLevel
Behavior (SubtreeLevel [Server])
beh Paths Behave 'APILevel 'OperationLevel
-> Paths Behave 'OperationLevel 'ServerLevel
-> Paths Behave 'APILevel 'ServerLevel
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Behave 'OperationLevel 'ServerLevel
-> Paths Behave 'OperationLevel 'ServerLevel
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Text -> Behave 'OperationLevel 'ServerLevel
InServer (Text -> Behave 'OperationLevel 'ServerLevel)
-> Text -> Behave 'OperationLevel 'ServerLevel
forall a b. (a -> b) -> a -> b
$ Server -> Text
_serverUrl Server
s)
                     in case Server -> Either (Issue 'ServerLevel) ProcessedServer
tracedParsedServerUrlParts Server
s of
                          Left Issue 'ServerLevel
e -> CompatFormula' Behave AnIssue 'APILevel Any
-> Either
     (CompatFormula' Behave AnIssue 'APILevel Any)
     (Paths Behave 'APILevel 'ServerLevel,
      Traced' ProcessedServer ProcessedServer)
forall a b. a -> Either a b
Left (CompatFormula' Behave AnIssue 'APILevel Any
 -> Either
      (CompatFormula' Behave AnIssue 'APILevel Any)
      (Paths Behave 'APILevel 'ServerLevel,
       Traced' ProcessedServer ProcessedServer))
-> CompatFormula' Behave AnIssue 'APILevel Any
-> Either
     (CompatFormula' Behave AnIssue 'APILevel Any)
     (Paths Behave 'APILevel 'ServerLevel,
      Traced' ProcessedServer ProcessedServer)
forall a b. (a -> b) -> a -> b
$ Paths Behave 'APILevel 'ServerLevel
-> Issue 'ServerLevel
-> CompatFormula' Behave AnIssue 'APILevel Any
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 'ServerLevel
bhv Issue 'ServerLevel
e
                          Right ProcessedServer
u -> (Paths Behave 'APILevel 'ServerLevel,
 Traced' ProcessedServer ProcessedServer)
-> Either
     (CompatFormula' Behave AnIssue 'APILevel Any)
     (Paths Behave 'APILevel 'ServerLevel,
      Traced' ProcessedServer ProcessedServer)
forall a b. b -> Either a b
Right (Paths Behave 'APILevel 'ServerLevel
bhv, Trace ProcessedServer
-> ProcessedServer -> Traced' ProcessedServer ProcessedServer
forall a b. Trace a -> b -> Traced' a b
Traced (Trace [Server]
t Trace [Server]
-> Paths Step [Server] ProcessedServer -> Trace ProcessedServer
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step [Server] ProcessedServer
-> Paths Step [Server] ProcessedServer
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Text -> Step [Server] ProcessedServer
ServerStep (Text -> Step [Server] ProcessedServer)
-> Text -> Step [Server] ProcessedServer
forall a b. (a -> b) -> a -> b
$ Server -> Text
_serverUrl Server
s)) ProcessedServer
u)
                )
              ([Traced' [Server] Server]
 -> [Either
       (CompatFormula' Behave AnIssue 'APILevel Any)
       (Paths Behave 'APILevel 'ServerLevel,
        Traced' ProcessedServer ProcessedServer)])
-> (Traced [Server] -> [Traced' [Server] Server])
-> Traced [Server]
-> [Either
      (CompatFormula' Behave AnIssue 'APILevel Any)
      (Paths Behave 'APILevel 'ServerLevel,
       Traced' ProcessedServer ProcessedServer)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced [Server] -> [Traced' [Server] Server]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
    [CompatFormula' Behave AnIssue 'APILevel Any]
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ [CompatFormula' Behave AnIssue 'APILevel Any]
pErrs
    [CompatFormula' Behave AnIssue 'APILevel Any]
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ [CompatFormula' Behave AnIssue 'APILevel Any]
cErrs
    [(Paths Behave 'APILevel 'ServerLevel,
  Traced' ProcessedServer ProcessedServer)]
-> ((Paths Behave 'APILevel 'ServerLevel,
     Traced' ProcessedServer ProcessedServer)
    -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Paths Behave 'APILevel 'ServerLevel,
  Traced' ProcessedServer ProcessedServer)]
pUrls (((Paths Behave 'APILevel 'ServerLevel,
   Traced' ProcessedServer ProcessedServer)
  -> SemanticCompatFormula ())
 -> SemanticCompatFormula ())
-> ((Paths Behave 'APILevel 'ServerLevel,
     Traced' ProcessedServer ProcessedServer)
    -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \(Paths Behave 'APILevel 'ServerLevel
bhv, Traced' ProcessedServer ProcessedServer
pUrl) -> do
      let potentiallyCompatible :: [Traced' ProcessedServer ProcessedServer]
potentiallyCompatible = (Traced' ProcessedServer ProcessedServer -> Bool)
-> [Traced' ProcessedServer ProcessedServer]
-> [Traced' ProcessedServer ProcessedServer]
forall a. (a -> Bool) -> [a] -> [a]
P.filter ((ProcessedServer -> ProcessedServer -> Bool
forall x. [ServerUrlPart x] -> [ServerUrlPart x] -> Bool
staticCompatible (ProcessedServer -> ProcessedServer -> Bool)
-> (Traced' ProcessedServer ProcessedServer -> ProcessedServer)
-> Traced' ProcessedServer ProcessedServer
-> Traced' ProcessedServer ProcessedServer
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Traced' ProcessedServer ProcessedServer -> ProcessedServer
forall (w :: * -> *) a. Comonad w => w a -> a
extract) Traced' ProcessedServer ProcessedServer
pUrl) ([Traced' ProcessedServer ProcessedServer]
 -> [Traced' ProcessedServer ProcessedServer])
-> [Traced' ProcessedServer ProcessedServer]
-> [Traced' ProcessedServer ProcessedServer]
forall a b. (a -> b) -> a -> b
$ ((Paths Behave 'APILevel 'ServerLevel,
  Traced' ProcessedServer ProcessedServer)
 -> Traced' ProcessedServer ProcessedServer)
-> [(Paths Behave 'APILevel 'ServerLevel,
     Traced' ProcessedServer ProcessedServer)]
-> [Traced' ProcessedServer ProcessedServer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Paths Behave 'APILevel 'ServerLevel,
 Traced' ProcessedServer ProcessedServer)
-> Traced' ProcessedServer ProcessedServer
forall a b. (a, b) -> b
snd [(Paths Behave 'APILevel 'ServerLevel,
  Traced' ProcessedServer ProcessedServer)]
cUrls
      Paths Behave 'APILevel 'ServerLevel
-> Issue 'ServerLevel
-> [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 'ServerLevel
bhv
        Issue 'ServerLevel
ServerNotMatched
        [ Behavior (SubtreeLevel ProcessedServer)
-> HList '[]
-> ProdCons (Traced' ProcessedServer ProcessedServer)
-> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility Paths Behave 'APILevel 'ServerLevel
Behavior (SubtreeLevel ProcessedServer)
bhv HList '[]
HList (CheckEnv [Server])
env (Traced' ProcessedServer ProcessedServer
-> Traced' ProcessedServer ProcessedServer
-> ProdCons (Traced' ProcessedServer ProcessedServer)
forall a. a -> a -> ProdCons a
ProdCons Traced' ProcessedServer ProcessedServer
pUrl Traced' ProcessedServer ProcessedServer
cUrl)
        | Traced' ProcessedServer ProcessedServer
cUrl <- [Traced' ProcessedServer ProcessedServer]
potentiallyCompatible
        ]
    pure ()

type ProcessedServer = [ServerUrlPart ServerVariable]

-- | Nothing means "open variable" – can have any value
unifyPart :: ServerUrlPart ServerVariable -> Maybe (IOHS.InsOrdHashSet Text)
unifyPart :: ServerUrlPart ServerVariable -> Maybe (InsOrdHashSet Text)
unifyPart (ServerUrlVariable ServerVariable
v) = ServerVariable -> Maybe (InsOrdHashSet Text)
_serverVariableEnum ServerVariable
v
unifyPart (ServerUrlConstant Text
c) = InsOrdHashSet Text -> Maybe (InsOrdHashSet Text)
forall a. a -> Maybe a
Just (InsOrdHashSet Text -> Maybe (InsOrdHashSet Text))
-> InsOrdHashSet Text -> Maybe (InsOrdHashSet Text)
forall a b. (a -> b) -> a -> b
$ Text -> InsOrdHashSet Text
forall k. Hashable k => k -> InsOrdHashSet k
IOHS.singleton Text
c

staticCompatiblePart :: ServerUrlPart x -> ServerUrlPart x -> Bool
staticCompatiblePart :: ServerUrlPart x -> ServerUrlPart x -> Bool
staticCompatiblePart (ServerUrlConstant Text
x) (ServerUrlConstant Text
y) = Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
y
staticCompatiblePart ServerUrlPart x
_ ServerUrlPart x
_ = Bool
True

staticCompatible :: [ServerUrlPart x] -> [ServerUrlPart x] -> Bool
staticCompatible :: [ServerUrlPart x] -> [ServerUrlPart x] -> Bool
staticCompatible [ServerUrlPart x]
a [ServerUrlPart x]
b = Bool
-> ([(ServerUrlPart x, ServerUrlPart x)] -> Bool)
-> Maybe [(ServerUrlPart x, ServerUrlPart x)]
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (((ServerUrlPart x, ServerUrlPart x) -> Bool)
-> [(ServerUrlPart x, ServerUrlPart x)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (((ServerUrlPart x, ServerUrlPart x) -> Bool)
 -> [(ServerUrlPart x, ServerUrlPart x)] -> Bool)
-> ((ServerUrlPart x, ServerUrlPart x) -> Bool)
-> [(ServerUrlPart x, ServerUrlPart x)]
-> Bool
forall a b. (a -> b) -> a -> b
$ (ServerUrlPart x -> ServerUrlPart x -> Bool)
-> (ServerUrlPart x, ServerUrlPart x) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ServerUrlPart x -> ServerUrlPart x -> Bool
forall x. ServerUrlPart x -> ServerUrlPart x -> Bool
staticCompatiblePart) (Maybe [(ServerUrlPart x, ServerUrlPart x)] -> Bool)
-> Maybe [(ServerUrlPart x, ServerUrlPart x)] -> Bool
forall a b. (a -> b) -> a -> b
$ [ServerUrlPart x]
-> [ServerUrlPart x] -> Maybe [(ServerUrlPart x, ServerUrlPart x)]
forall a b. [a] -> [b] -> Maybe [(a, b)]
zipAll [ServerUrlPart x]
a [ServerUrlPart x]
b

data ServerUrlPart var
  = ServerUrlVariable var
  | ServerUrlConstant Text
  deriving stock (ServerUrlPart var -> ServerUrlPart var -> Bool
(ServerUrlPart var -> ServerUrlPart var -> Bool)
-> (ServerUrlPart var -> ServerUrlPart var -> Bool)
-> Eq (ServerUrlPart var)
forall var.
Eq var =>
ServerUrlPart var -> ServerUrlPart var -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerUrlPart var -> ServerUrlPart var -> Bool
$c/= :: forall var.
Eq var =>
ServerUrlPart var -> ServerUrlPart var -> Bool
== :: ServerUrlPart var -> ServerUrlPart var -> Bool
$c== :: forall var.
Eq var =>
ServerUrlPart var -> ServerUrlPart var -> Bool
Eq, Int -> ServerUrlPart var -> ShowS
[ServerUrlPart var] -> ShowS
ServerUrlPart var -> String
(Int -> ServerUrlPart var -> ShowS)
-> (ServerUrlPart var -> String)
-> ([ServerUrlPart var] -> ShowS)
-> Show (ServerUrlPart var)
forall var. Show var => Int -> ServerUrlPart var -> ShowS
forall var. Show var => [ServerUrlPart var] -> ShowS
forall var. Show var => ServerUrlPart var -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerUrlPart var] -> ShowS
$cshowList :: forall var. Show var => [ServerUrlPart var] -> ShowS
show :: ServerUrlPart var -> String
$cshow :: forall var. Show var => ServerUrlPart var -> String
showsPrec :: Int -> ServerUrlPart var -> ShowS
$cshowsPrec :: forall var. Show var => Int -> ServerUrlPart var -> ShowS
Show, a -> ServerUrlPart b -> ServerUrlPart a
(a -> b) -> ServerUrlPart a -> ServerUrlPart b
(forall a b. (a -> b) -> ServerUrlPart a -> ServerUrlPart b)
-> (forall a b. a -> ServerUrlPart b -> ServerUrlPart a)
-> Functor ServerUrlPart
forall a b. a -> ServerUrlPart b -> ServerUrlPart a
forall a b. (a -> b) -> ServerUrlPart a -> ServerUrlPart b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ServerUrlPart b -> ServerUrlPart a
$c<$ :: forall a b. a -> ServerUrlPart b -> ServerUrlPart a
fmap :: (a -> b) -> ServerUrlPart a -> ServerUrlPart b
$cfmap :: forall a b. (a -> b) -> ServerUrlPart a -> ServerUrlPart b
Functor, ServerUrlPart a -> Bool
(a -> m) -> ServerUrlPart a -> m
(a -> b -> b) -> b -> ServerUrlPart a -> b
(forall m. Monoid m => ServerUrlPart m -> m)
-> (forall m a. Monoid m => (a -> m) -> ServerUrlPart a -> m)
-> (forall m a. Monoid m => (a -> m) -> ServerUrlPart a -> m)
-> (forall a b. (a -> b -> b) -> b -> ServerUrlPart a -> b)
-> (forall a b. (a -> b -> b) -> b -> ServerUrlPart a -> b)
-> (forall b a. (b -> a -> b) -> b -> ServerUrlPart a -> b)
-> (forall b a. (b -> a -> b) -> b -> ServerUrlPart a -> b)
-> (forall a. (a -> a -> a) -> ServerUrlPart a -> a)
-> (forall a. (a -> a -> a) -> ServerUrlPart a -> a)
-> (forall a. ServerUrlPart a -> [a])
-> (forall a. ServerUrlPart a -> Bool)
-> (forall a. ServerUrlPart a -> Int)
-> (forall a. Eq a => a -> ServerUrlPart a -> Bool)
-> (forall a. Ord a => ServerUrlPart a -> a)
-> (forall a. Ord a => ServerUrlPart a -> a)
-> (forall a. Num a => ServerUrlPart a -> a)
-> (forall a. Num a => ServerUrlPart a -> a)
-> Foldable ServerUrlPart
forall a. Eq a => a -> ServerUrlPart a -> Bool
forall a. Num a => ServerUrlPart a -> a
forall a. Ord a => ServerUrlPart a -> a
forall m. Monoid m => ServerUrlPart m -> m
forall a. ServerUrlPart a -> Bool
forall a. ServerUrlPart a -> Int
forall a. ServerUrlPart a -> [a]
forall a. (a -> a -> a) -> ServerUrlPart a -> a
forall m a. Monoid m => (a -> m) -> ServerUrlPart a -> m
forall b a. (b -> a -> b) -> b -> ServerUrlPart a -> b
forall a b. (a -> b -> b) -> b -> ServerUrlPart a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: ServerUrlPart a -> a
$cproduct :: forall a. Num a => ServerUrlPart a -> a
sum :: ServerUrlPart a -> a
$csum :: forall a. Num a => ServerUrlPart a -> a
minimum :: ServerUrlPart a -> a
$cminimum :: forall a. Ord a => ServerUrlPart a -> a
maximum :: ServerUrlPart a -> a
$cmaximum :: forall a. Ord a => ServerUrlPart a -> a
elem :: a -> ServerUrlPart a -> Bool
$celem :: forall a. Eq a => a -> ServerUrlPart a -> Bool
length :: ServerUrlPart a -> Int
$clength :: forall a. ServerUrlPart a -> Int
null :: ServerUrlPart a -> Bool
$cnull :: forall a. ServerUrlPart a -> Bool
toList :: ServerUrlPart a -> [a]
$ctoList :: forall a. ServerUrlPart a -> [a]
foldl1 :: (a -> a -> a) -> ServerUrlPart a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ServerUrlPart a -> a
foldr1 :: (a -> a -> a) -> ServerUrlPart a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> ServerUrlPart a -> a
foldl' :: (b -> a -> b) -> b -> ServerUrlPart a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ServerUrlPart a -> b
foldl :: (b -> a -> b) -> b -> ServerUrlPart a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ServerUrlPart a -> b
foldr' :: (a -> b -> b) -> b -> ServerUrlPart a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ServerUrlPart a -> b
foldr :: (a -> b -> b) -> b -> ServerUrlPart a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> ServerUrlPart a -> b
foldMap' :: (a -> m) -> ServerUrlPart a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ServerUrlPart a -> m
foldMap :: (a -> m) -> ServerUrlPart a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ServerUrlPart a -> m
fold :: ServerUrlPart m -> m
$cfold :: forall m. Monoid m => ServerUrlPart m -> m
Foldable, Functor ServerUrlPart
Foldable ServerUrlPart
Functor ServerUrlPart
-> Foldable ServerUrlPart
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> ServerUrlPart a -> f (ServerUrlPart b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ServerUrlPart (f a) -> f (ServerUrlPart a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ServerUrlPart a -> m (ServerUrlPart b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ServerUrlPart (m a) -> m (ServerUrlPart a))
-> Traversable ServerUrlPart
(a -> f b) -> ServerUrlPart a -> f (ServerUrlPart b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ServerUrlPart (m a) -> m (ServerUrlPart a)
forall (f :: * -> *) a.
Applicative f =>
ServerUrlPart (f a) -> f (ServerUrlPart a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ServerUrlPart a -> m (ServerUrlPart b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ServerUrlPart a -> f (ServerUrlPart b)
sequence :: ServerUrlPart (m a) -> m (ServerUrlPart a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ServerUrlPart (m a) -> m (ServerUrlPart a)
mapM :: (a -> m b) -> ServerUrlPart a -> m (ServerUrlPart b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ServerUrlPart a -> m (ServerUrlPart b)
sequenceA :: ServerUrlPart (f a) -> f (ServerUrlPart a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ServerUrlPart (f a) -> f (ServerUrlPart a)
traverse :: (a -> f b) -> ServerUrlPart a -> f (ServerUrlPart b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ServerUrlPart a -> f (ServerUrlPart b)
$cp2Traversable :: Foldable ServerUrlPart
$cp1Traversable :: Functor ServerUrlPart
Traversable)

-- | This is super rough. Things like @{a|b}c@ will not match @ac@.
-- FIXME: #46
--
-- NOTE: syntax is defined vaguely in the spec.
parseServerUrl :: Text -> [ServerUrlPart Text]
-- There really is no way it can fail
parseServerUrl :: Text -> [ServerUrlPart Text]
parseServerUrl = [ServerUrlPart Text]
-> Either String [ServerUrlPart Text] -> [ServerUrlPart Text]
forall b a. b -> Either a b -> b
fromRight [ServerUrlPart Text]
forall a. HasCallStack => a
undefined (Either String [ServerUrlPart Text] -> [ServerUrlPart Text])
-> (Text -> Either String [ServerUrlPart Text])
-> Text
-> [ServerUrlPart Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser [ServerUrlPart Text]
-> Text -> Either String [ServerUrlPart Text]
forall a. Parser a -> Text -> Either String a
parseOnly (Parser [ServerUrlPart Text]
serverUrlParser Parser [ServerUrlPart Text]
-> Parser Text () -> Parser [ServerUrlPart Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput)
  where
    serverUrlParser :: Parser [ServerUrlPart Text]
    serverUrlParser :: Parser [ServerUrlPart Text]
serverUrlParser = Parser Text (ServerUrlPart Text) -> Parser [ServerUrlPart Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text (ServerUrlPart Text) -> Parser [ServerUrlPart Text])
-> Parser Text (ServerUrlPart Text) -> Parser [ServerUrlPart Text]
forall a b. (a -> b) -> a -> b
$ do
      Parser Text (ServerUrlPart Text)
variableUrlParser Parser Text (ServerUrlPart Text)
-> Parser Text (ServerUrlPart Text)
-> Parser Text (ServerUrlPart Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
        Char
a <- Parser Char
anyChar
        Text
aa <- (Char -> Bool) -> Parser Text
takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{')
        return (Text -> ServerUrlPart Text
forall var. Text -> ServerUrlPart var
ServerUrlConstant (Text -> ServerUrlPart Text) -> Text -> ServerUrlPart Text
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons Char
a Text
aa)

    variableUrlParser :: Parser (ServerUrlPart Text)
    variableUrlParser :: Parser Text (ServerUrlPart Text)
variableUrlParser = do
      Char -> Parser Char
char Char
'{'
      Text
res <- (Char -> Bool) -> Parser Text
takeTill (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'}')
      Char -> Parser Char
char Char
'}'
      return $ Text -> ServerUrlPart Text
forall var. var -> ServerUrlPart var
ServerUrlVariable Text
res

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

instance Issuable 'ServerLevel where
  data Issue 'ServerLevel
    = EnumValueNotConsumed Int Text
    | ConsumerNotOpen Int
    | ServerVariableNotDefined Text
    | ServerNotMatched
    deriving stock (Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
(Issue 'ServerLevel -> Issue 'ServerLevel -> Bool)
-> (Issue 'ServerLevel -> Issue 'ServerLevel -> Bool)
-> Eq (Issue 'ServerLevel)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
$c/= :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
== :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
$c== :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
Eq, Eq (Issue 'ServerLevel)
Eq (Issue 'ServerLevel)
-> (Issue 'ServerLevel -> Issue 'ServerLevel -> Ordering)
-> (Issue 'ServerLevel -> Issue 'ServerLevel -> Bool)
-> (Issue 'ServerLevel -> Issue 'ServerLevel -> Bool)
-> (Issue 'ServerLevel -> Issue 'ServerLevel -> Bool)
-> (Issue 'ServerLevel -> Issue 'ServerLevel -> Bool)
-> (Issue 'ServerLevel -> Issue 'ServerLevel -> Issue 'ServerLevel)
-> (Issue 'ServerLevel -> Issue 'ServerLevel -> Issue 'ServerLevel)
-> Ord (Issue 'ServerLevel)
Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
Issue 'ServerLevel -> Issue 'ServerLevel -> Ordering
Issue 'ServerLevel -> Issue 'ServerLevel -> Issue 'ServerLevel
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 'ServerLevel -> Issue 'ServerLevel -> Issue 'ServerLevel
$cmin :: Issue 'ServerLevel -> Issue 'ServerLevel -> Issue 'ServerLevel
max :: Issue 'ServerLevel -> Issue 'ServerLevel -> Issue 'ServerLevel
$cmax :: Issue 'ServerLevel -> Issue 'ServerLevel -> Issue 'ServerLevel
>= :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
$c>= :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
> :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
$c> :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
<= :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
$c<= :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
< :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
$c< :: Issue 'ServerLevel -> Issue 'ServerLevel -> Bool
compare :: Issue 'ServerLevel -> Issue 'ServerLevel -> Ordering
$ccompare :: Issue 'ServerLevel -> Issue 'ServerLevel -> Ordering
$cp1Ord :: Eq (Issue 'ServerLevel)
Ord, Int -> Issue 'ServerLevel -> ShowS
[Issue 'ServerLevel] -> ShowS
Issue 'ServerLevel -> String
(Int -> Issue 'ServerLevel -> ShowS)
-> (Issue 'ServerLevel -> String)
-> ([Issue 'ServerLevel] -> ShowS)
-> Show (Issue 'ServerLevel)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issue 'ServerLevel] -> ShowS
$cshowList :: [Issue 'ServerLevel] -> ShowS
show :: Issue 'ServerLevel -> String
$cshow :: Issue 'ServerLevel -> String
showsPrec :: Int -> Issue 'ServerLevel -> ShowS
$cshowsPrec :: Int -> Issue 'ServerLevel -> ShowS
Show)
  issueKind :: Issue 'ServerLevel -> IssueKind
issueKind = \case
    ServerVariableNotDefined _ -> IssueKind
SchemaInvalid
    Issue 'ServerLevel
_ -> IssueKind
CertainIssue
  describeIssue :: Orientation -> Issue 'ServerLevel -> Blocks
describeIssue Orientation
Forward (EnumValueNotConsumed _ v) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Enum value " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
v Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" has been removed."
  describeIssue Orientation
Backward (EnumValueNotConsumed _ v) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Enum value " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
v Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" has been added."
  describeIssue Orientation
Forward (ConsumerNotOpen _) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"A variable has been changed from being open to being closed."
  describeIssue Orientation
Backward (ConsumerNotOpen _) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"A variable has been changed from being closed to being open."
  describeIssue Orientation
_ (ServerVariableNotDefined k) =
    Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"Variable " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
code Text
k Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
" is not defined."
  describeIssue Orientation
Forward Issue 'ServerLevel
ServerNotMatched = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The server was removed."
  describeIssue Orientation
Backward Issue 'ServerLevel
ServerNotMatched = Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
"The server was added."

instance Subtree ProcessedServer where
  type SubtreeLevel ProcessedServer = 'ServerLevel
  type CheckEnv ProcessedServer = '[]
  checkStructuralCompatibility :: HList (CheckEnv ProcessedServer)
-> ProdCons (Traced' ProcessedServer ProcessedServer)
-> StructuralCompatFormula ()
checkStructuralCompatibility HList (CheckEnv ProcessedServer)
_ ProdCons (Traced' ProcessedServer ProcessedServer)
pc =
    ProdCons
  (EnvT
     (Trace ProcessedServer)
     Identity
     [ServerUrlPart (Maybe (HashSet Text), Text)])
-> StructuralCompatFormula ()
forall a (w :: * -> *).
(Eq a, Comonad w) =>
ProdCons (w a) -> StructuralCompatFormula ()
structuralEq (ProdCons
   (EnvT
      (Trace ProcessedServer)
      Identity
      [ServerUrlPart (Maybe (HashSet Text), Text)])
 -> StructuralCompatFormula ())
-> ProdCons
     (EnvT
        (Trace ProcessedServer)
        Identity
        [ServerUrlPart (Maybe (HashSet Text), Text)])
-> StructuralCompatFormula ()
forall a b. (a -> b) -> a -> b
$ ((Traced' ProcessedServer ProcessedServer
 -> EnvT
      (Trace ProcessedServer)
      Identity
      [ServerUrlPart (Maybe (HashSet Text), Text)])
-> ProdCons (Traced' ProcessedServer ProcessedServer)
-> ProdCons
     (EnvT
        (Trace ProcessedServer)
        Identity
        [ServerUrlPart (Maybe (HashSet Text), Text)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Traced' ProcessedServer ProcessedServer
  -> EnvT
       (Trace ProcessedServer)
       Identity
       [ServerUrlPart (Maybe (HashSet Text), Text)])
 -> ProdCons (Traced' ProcessedServer ProcessedServer)
 -> ProdCons
      (EnvT
         (Trace ProcessedServer)
         Identity
         [ServerUrlPart (Maybe (HashSet Text), Text)]))
-> ((ServerVariable -> (Maybe (HashSet Text), Text))
    -> Traced' ProcessedServer ProcessedServer
    -> EnvT
         (Trace ProcessedServer)
         Identity
         [ServerUrlPart (Maybe (HashSet Text), Text)])
-> (ServerVariable -> (Maybe (HashSet Text), Text))
-> ProdCons (Traced' ProcessedServer ProcessedServer)
-> ProdCons
     (EnvT
        (Trace ProcessedServer)
        Identity
        [ServerUrlPart (Maybe (HashSet Text), Text)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcessedServer -> [ServerUrlPart (Maybe (HashSet Text), Text)])
-> Traced' ProcessedServer ProcessedServer
-> EnvT
     (Trace ProcessedServer)
     Identity
     [ServerUrlPart (Maybe (HashSet Text), Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ProcessedServer -> [ServerUrlPart (Maybe (HashSet Text), Text)])
 -> Traced' ProcessedServer ProcessedServer
 -> EnvT
      (Trace ProcessedServer)
      Identity
      [ServerUrlPart (Maybe (HashSet Text), Text)])
-> ((ServerVariable -> (Maybe (HashSet Text), Text))
    -> ProcessedServer -> [ServerUrlPart (Maybe (HashSet Text), Text)])
-> (ServerVariable -> (Maybe (HashSet Text), Text))
-> Traced' ProcessedServer ProcessedServer
-> EnvT
     (Trace ProcessedServer)
     Identity
     [ServerUrlPart (Maybe (HashSet Text), Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerUrlPart ServerVariable
 -> ServerUrlPart (Maybe (HashSet Text), Text))
-> ProcessedServer -> [ServerUrlPart (Maybe (HashSet Text), Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ServerUrlPart ServerVariable
  -> ServerUrlPart (Maybe (HashSet Text), Text))
 -> ProcessedServer -> [ServerUrlPart (Maybe (HashSet Text), Text)])
-> ((ServerVariable -> (Maybe (HashSet Text), Text))
    -> ServerUrlPart ServerVariable
    -> ServerUrlPart (Maybe (HashSet Text), Text))
-> (ServerVariable -> (Maybe (HashSet Text), Text))
-> ProcessedServer
-> [ServerUrlPart (Maybe (HashSet Text), Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ServerVariable -> (Maybe (HashSet Text), Text))
-> ServerUrlPart ServerVariable
-> ServerUrlPart (Maybe (HashSet Text), Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ServerVariable -> (Maybe (HashSet Text), Text)
reducerServerVariable ProdCons (Traced' ProcessedServer ProcessedServer)
pc
    where
      reducerServerVariable :: ServerVariable -> (Maybe (HashSet Text), Text)
reducerServerVariable =
        (InsOrdHashSet Text -> HashSet Text)
-> Maybe (InsOrdHashSet Text) -> Maybe (HashSet Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InsOrdHashSet Text -> HashSet Text
forall k. InsOrdHashSet k -> HashSet k
IOHM.toHashSet (Maybe (InsOrdHashSet Text) -> Maybe (HashSet Text))
-> (ServerVariable -> Maybe (InsOrdHashSet Text))
-> ServerVariable
-> Maybe (HashSet Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerVariable -> Maybe (InsOrdHashSet Text)
_serverVariableEnum (ServerVariable -> Maybe (HashSet Text))
-> (ServerVariable -> Text)
-> ServerVariable
-> (Maybe (HashSet Text), Text)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ServerVariable -> Text
_serverVariableDefault
  checkSemanticCompatibility :: HList (CheckEnv ProcessedServer)
-> Behavior (SubtreeLevel ProcessedServer)
-> ProdCons (Traced' ProcessedServer ProcessedServer)
-> SemanticCompatFormula ()
checkSemanticCompatibility HList (CheckEnv ProcessedServer)
_ Behavior (SubtreeLevel ProcessedServer)
beh ProdCons (Traced' ProcessedServer ProcessedServer)
pc =
    -- traversing here is fine because we have already filtered for length
    [(Int, (Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text)))]
-> ((Int, (Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text)))
    -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([Int]
-> [(Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text))]
-> [(Int,
     (Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] ([(Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text))]
 -> [(Int,
      (Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text)))])
-> [(Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text))]
-> [(Int,
     (Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text)))]
forall a b. (a -> b) -> a -> b
$ ProdCons [Maybe (InsOrdHashSet Text)]
-> [(Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text))]
forall a. ProdCons [a] -> [(a, a)]
zipProdCons (ProdCons [Maybe (InsOrdHashSet Text)]
 -> [(Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text))])
-> (ProdCons (Traced' ProcessedServer ProcessedServer)
    -> ProdCons [Maybe (InsOrdHashSet Text)])
-> ProdCons (Traced' ProcessedServer ProcessedServer)
-> [(Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Traced' ProcessedServer ProcessedServer
 -> [Maybe (InsOrdHashSet Text)])
-> ProdCons (Traced' ProcessedServer ProcessedServer)
-> ProdCons [Maybe (InsOrdHashSet Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ServerUrlPart ServerVariable -> Maybe (InsOrdHashSet Text))
-> ProcessedServer -> [Maybe (InsOrdHashSet Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ServerUrlPart ServerVariable -> Maybe (InsOrdHashSet Text)
unifyPart (ProcessedServer -> [Maybe (InsOrdHashSet Text)])
-> (Traced' ProcessedServer ProcessedServer -> ProcessedServer)
-> Traced' ProcessedServer ProcessedServer
-> [Maybe (InsOrdHashSet Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traced' ProcessedServer ProcessedServer -> ProcessedServer
forall (w :: * -> *) a. Comonad w => w a -> a
extract) (ProdCons (Traced' ProcessedServer ProcessedServer)
 -> [(Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text))])
-> ProdCons (Traced' ProcessedServer ProcessedServer)
-> [(Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text))]
forall a b. (a -> b) -> a -> b
$ ProdCons (Traced' ProcessedServer ProcessedServer)
pc) (((Int, (Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text)))
  -> SemanticCompatFormula ())
 -> SemanticCompatFormula ())
-> ((Int, (Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text)))
    -> SemanticCompatFormula ())
-> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, (Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text))
pcPart) -> case (Maybe (InsOrdHashSet Text), Maybe (InsOrdHashSet Text))
pcPart of
      (Just InsOrdHashSet Text
x, Just InsOrdHashSet Text
y) -> InsOrdHashSet Text
-> (Text -> SemanticCompatFormula ()) -> SemanticCompatFormula ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ InsOrdHashSet Text
x ((Text -> SemanticCompatFormula ()) -> SemanticCompatFormula ())
-> (Text -> SemanticCompatFormula ()) -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ \Text
v -> Bool -> SemanticCompatFormula () -> SemanticCompatFormula ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
v Text -> InsOrdHashSet Text -> Bool
forall k. (Eq k, Hashable k) => k -> InsOrdHashSet k -> Bool
`IOHS.member` InsOrdHashSet Text
y) (Paths Behave 'APILevel 'ServerLevel
-> Issue 'ServerLevel -> 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 'ServerLevel
Behavior (SubtreeLevel ProcessedServer)
beh (Issue 'ServerLevel -> SemanticCompatFormula ())
-> Issue 'ServerLevel -> SemanticCompatFormula ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Issue 'ServerLevel
EnumValueNotConsumed Int
i Text
v)
      -- Consumer can consume anything
      (Maybe (InsOrdHashSet Text)
_, Maybe (InsOrdHashSet Text)
Nothing) -> () -> SemanticCompatFormula ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      -- Producer can produce anythings, but consumer has a finite enum ;(
      (Maybe (InsOrdHashSet Text)
Nothing, Just InsOrdHashSet Text
_) -> Paths Behave 'APILevel 'ServerLevel
-> Issue 'ServerLevel -> 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 'ServerLevel
Behavior (SubtreeLevel ProcessedServer)
beh (Int -> Issue 'ServerLevel
ConsumerNotOpen Int
i)
    where
      zipProdCons :: ProdCons [a] -> [(a, a)]
      zipProdCons :: ProdCons [a] -> [(a, a)]
zipProdCons (ProdCons [a]
x [a]
y) = [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
x [a]
y