{-# OPTIONS_GHC -Wno-orphans #-}

module Data.OpenApi.Compare.References
  ( Step (..),
    dereference,
    Typeable,
  )
where

import Data.HList
import qualified Data.HashMap.Strict.InsOrd as IOHM
import Data.Maybe
import Data.OpenApi
import Data.OpenApi.Compare.Orphans ()
import Data.OpenApi.Compare.Subtree

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

dereference ::
  Typeable a =>
  Traced (Definitions a) ->
  Traced (Referenced a) ->
  Traced a
dereference :: Traced (Definitions a) -> Traced (Referenced a) -> Traced a
dereference Traced (Definitions a)
defs Traced (Referenced a)
x = case Traced (Referenced a) -> Referenced a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced (Referenced a)
x of
  Inline a
a ->
    Trace a -> a -> Traced a
forall a. Trace a -> a -> Traced a
traced (Traced (Referenced a) -> Paths Step TraceRoot (Referenced a)
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced (Referenced a)
x Paths Step TraceRoot (Referenced a)
-> Paths Step (Referenced a) a -> Trace a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step (Referenced a) a -> Paths Step (Referenced a) a
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step Step (Referenced a) a
forall a. Step (Referenced a) a
InlineStep) a
a
  Ref (Reference Text
ref) ->
    Trace a -> a -> Traced a
forall a. Trace a -> a -> Traced a
traced (Traced (Definitions a) -> Paths Step TraceRoot (Definitions a)
forall e (w :: * -> *) a. ComonadEnv e w => w a -> e
ask Traced (Definitions a)
defs Paths Step TraceRoot (Definitions a)
-> Paths Step (Definitions a) a -> Trace a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Step (Definitions a) a -> Paths Step (Definitions a) a
forall k (q :: k -> k -> *) (a :: k) (b :: k).
NiceQuiver q a b =>
q a b -> Paths q a b
step (Text -> Step (Definitions a) a
forall k v. k -> Step (InsOrdHashMap k v) v
InsOrdHashMapKeyStep Text
ref)) (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Text -> Definitions a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
IOHM.lookup Text
ref (Definitions a -> Maybe a) -> Definitions a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Traced (Definitions a) -> Definitions a
forall (w :: * -> *) a. Comonad w => w a -> a
extract Traced (Definitions a)
defs)

instance Subtree a => Subtree (Referenced a) where
  type CheckEnv (Referenced a) = ProdCons (Traced (Definitions a)) ': CheckEnv a
  type SubtreeLevel (Referenced a) = SubtreeLevel a

  checkStructuralCompatibility :: HList (CheckEnv (Referenced a))
-> ProdCons (Traced (Referenced a)) -> StructuralCompatFormula ()
checkStructuralCompatibility (x
defs `HCons` HList xs
env) ProdCons (Traced (Referenced a))
pc' = do
    let pc :: ProdCons (Traced a)
pc = do
          Traced (Referenced a)
x <- ProdCons (Traced (Referenced a))
pc'
          EnvT (Trace (Definitions a)) Identity (Definitions a)
defs' <- x
ProdCons (EnvT (Trace (Definitions a)) Identity (Definitions a))
defs
          pure (EnvT (Trace (Definitions a)) Identity (Definitions a)
-> Traced (Referenced a) -> Traced a
forall a.
Typeable a =>
Traced (Definitions a) -> Traced (Referenced a) -> Traced a
dereference EnvT (Trace (Definitions a)) Identity (Definitions a)
defs' Traced (Referenced a)
x)
    HList xs -> ProdCons (Traced a) -> StructuralCompatFormula ()
forall (xs :: [*]) t.
(ReassembleHList xs (CheckEnv t), Subtree t) =>
HList xs -> ProdCons (Traced t) -> StructuralCompatFormula ()
checkSubstructure HList xs
env ProdCons (Traced a)
pc

  checkSemanticCompatibility :: HList (CheckEnv (Referenced a))
-> Behavior (SubtreeLevel (Referenced a))
-> ProdCons (Traced (Referenced a))
-> SemanticCompatFormula ()
checkSemanticCompatibility (x
defs `HCons` HList xs
env) Behavior (SubtreeLevel (Referenced a))
bhv ProdCons (Traced (Referenced a))
pc' = do
    let pc :: ProdCons (Traced a)
pc = do
          Traced (Referenced a)
x <- ProdCons (Traced (Referenced a))
pc'
          EnvT (Trace (Definitions a)) Identity (Definitions a)
defs' <- x
ProdCons (EnvT (Trace (Definitions a)) Identity (Definitions a))
defs
          pure (EnvT (Trace (Definitions a)) Identity (Definitions a)
-> Traced (Referenced a) -> Traced a
forall a.
Typeable a =>
Traced (Definitions a) -> Traced (Referenced a) -> Traced a
dereference EnvT (Trace (Definitions a)) Identity (Definitions a)
defs' Traced (Referenced a)
x)
    Behavior (SubtreeLevel a)
-> HList xs -> ProdCons (Traced a) -> SemanticCompatFormula ()
forall t (xs :: [*]).
(ReassembleHList xs (CheckEnv t), Subtree t) =>
Behavior (SubtreeLevel t)
-> HList xs -> ProdCons (Traced t) -> SemanticCompatFormula ()
checkCompatibility Behavior (SubtreeLevel a)
Behavior (SubtreeLevel (Referenced a))
bhv HList xs
env ProdCons (Traced a)
pc