{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

-- |
-- Module      : Servant.Validate.Internal
-- Copyright   : (c) Justin Le 2021
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Internal type-level tools.

module Servant.Validate.Internal (
    ApiTree(..)
  , Compare, Cases, MergeMethods, MergePaths, MergeTree
  , compSym, sMergeMethods, sMergePaths, sMergeTree
  , SApiTree(..) , toSApiTree
  , Prod(..), Tup(..), SSym(..)
  , toProd, reflectProd, toTup, reflectTup, toSSym, reflectSSym
  ) where

import           Data.Kind
import           Unsafe.Coerce
import           Data.Proxy
import           Data.Text       (Text)
import           GHC.TypeLits
import           Type.Reflection
import qualified Data.Text       as T

data ApiTree = Branch [Symbol] [(Symbol, ApiTree)]

type family Compare (a :: k) (b :: k) :: Ordering
type instance Compare (a :: Symbol) (b :: Symbol) = CmpSymbol a b

type family Cases (c :: Ordering) (lt :: k) (eq :: k) (gt :: k) where
    Cases 'LT lt eq gt = lt
    Cases 'EQ lt eq gt = eq
    Cases 'GT lt eq gt = gt

type family MergeMethods err (xs :: [k]) (ys :: [k]) :: [k] where
    MergeMethods err '[]       '[]       = '[]
    MergeMethods err '[]       (y ': ys) = y ': ys
    MergeMethods err (x ': xs) '[]       = x ': xs
    MergeMethods err (x ': xs) (y ': ys) = Cases
      (Compare x y)
      (x ': MergeMethods err xs (y ': ys))
      (TypeError (err ':<>: 'Text ": " ':<>: ShowType x))
      (y ': MergeMethods err (x ': xs) ys)

type family MergePaths (base :: [Symbol]) (xs :: [(Symbol, ApiTree)]) (ys :: [(Symbol, ApiTree)]) :: [(Symbol, ApiTree)] where
    MergePaths base '[]                '[]                = '[]
    MergePaths base '[]                ( '(b, y) ': bys ) = '(b, y) ': bys
    MergePaths base ( '(a, x) ': axs ) '[]                = '(a, x) ': axs
    MergePaths base ( '(a, x) ': axs ) ( '(b, y) ': bys ) = Cases
      (Compare a b)
      ( '(a, x) ': MergePaths base axs ( '(b, y) ': bys ) )
      ( '(a, MergeTree (a ': base) x y) ': MergePaths base axs bys )
      ( '(b, y) ': MergePaths base ( '(a, x) ': axs ) bys )

type family MergeTree (base :: [Symbol]) (a :: ApiTree) (b :: ApiTree) :: ApiTree where
    MergeTree base ('Branch mA pA) ('Branch mB pB) =
        'Branch
            (MergeMethods
                ('Text "Duplicate method in API at path " ':<>: 'Text ("/" `AppendSymbol` ShowPath base))
                mA mB
            )
            (MergePaths base pA pB)

type family ShowPath (path :: [Symbol]) :: Symbol where
    ShowPath '[] = ""
    ShowPath '[x] = x
    ShowPath (x ': y ': xs) = x `AppendSymbol` "/" `AppendSymbol` ShowPath (y ': xs)





-- a bunch of stuff to avoid needing a singletons dep.  this isn't needed
-- for any of the compile-stuff, it's just useful for reflection to
-- a value-level map


data Prod :: (k -> Type) -> [k] -> Type where
    PNil :: Prod f '[]
    (:<) :: f a -> Prod f as -> Prod f (a ': as)
infixr 5 :<
deriving instance (forall a. Show (f a)) => Show (Prod f as)

toProd :: forall k (as :: [k]) f. (forall (a :: k). TypeRep a -> f a) -> TypeRep as -> Prod f as
toProd :: (forall (a :: k). TypeRep a -> f a) -> TypeRep as -> Prod f as
toProd forall (a :: k). TypeRep a -> f a
f = TypeRep as -> Prod f as
forall (bs :: [k]). TypeRep bs -> Prod f bs
go
  where
    go :: forall (bs :: [k]). TypeRep bs -> Prod f bs
    go :: TypeRep bs -> Prod f bs
go = \case
      Con TyCon
_            -> Prod Any '[] -> Prod f bs
forall a b. a -> b
unsafeCoerce Prod Any '[]
forall k (f :: k -> *). Prod f '[]
PNil
      App (App TypeRep a
_ TypeRep b
x) TypeRep b
xs -> Prod f (Any : Any) -> Prod f bs
forall a b. a -> b
unsafeCoerce (Prod f (Any : Any) -> Prod f bs)
-> Prod f (Any : Any) -> Prod f bs
forall a b. (a -> b) -> a -> b
$ TypeRep Any -> f Any
forall (a :: k). TypeRep a -> f a
f (TypeRep b -> TypeRep Any
forall a b. a -> b
unsafeCoerce TypeRep b
x) f Any -> Prod f Any -> Prod f (Any : Any)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< TypeRep Any -> Prod f Any
forall (bs :: [k]). TypeRep bs -> Prod f bs
go (TypeRep b -> TypeRep Any
forall a b. a -> b
unsafeCoerce TypeRep b
xs)

reflectProd :: forall k (as :: [k]) f r. (forall (a :: k). f a -> r) -> Prod f as -> [r]
reflectProd :: (forall (a :: k). f a -> r) -> Prod f as -> [r]
reflectProd forall (a :: k). f a -> r
f = Prod f as -> [r]
forall (bs :: [k]). Prod f bs -> [r]
go
  where
    go :: forall (bs :: [k]). Prod f bs -> [r]
    go :: Prod f bs -> [r]
go = \case
      Prod f bs
PNil    -> []
      f a
x :< Prod f as
xs -> f a -> r
forall (a :: k). f a -> r
f f a
x r -> [r] -> [r]
forall a. a -> [a] -> [a]
: Prod f as -> [r]
forall (bs :: [k]). Prod f bs -> [r]
go Prod f as
xs

data Tup :: (a -> Type) -> (b -> Type) -> (a, b) -> Type where
    Tup :: f x -> g y -> Tup f g '(x, y)
deriving instance (forall a. Show (f a), forall a. Show (g a)) => Show (Tup f g xy)

toTup :: (forall x. TypeRep x -> f x) -> (forall x. TypeRep x -> g x) -> TypeRep xy -> Tup f g xy
toTup :: (forall (x :: a). TypeRep x -> f x)
-> (forall (x :: b). TypeRep x -> g x) -> TypeRep xy -> Tup f g xy
toTup forall (x :: a). TypeRep x -> f x
f forall (x :: b). TypeRep x -> g x
g (App (App TypeRep a
_ TypeRep b
x) TypeRep b
y) = Tup f g '(Any, Any) -> Tup f g xy
forall a b. a -> b
unsafeCoerce (Tup f g '(Any, Any) -> Tup f g xy)
-> Tup f g '(Any, Any) -> Tup f g xy
forall a b. (a -> b) -> a -> b
$ f Any -> g Any -> Tup f g '(Any, Any)
forall k k (f :: k -> *) (x :: k) (g :: k -> *) (y :: k).
f x -> g y -> Tup f g '(x, y)
Tup (TypeRep Any -> f Any
forall (x :: a). TypeRep x -> f x
f (TypeRep b -> TypeRep Any
forall a b. a -> b
unsafeCoerce TypeRep b
x)) (TypeRep Any -> g Any
forall (x :: b). TypeRep x -> g x
g (TypeRep b -> TypeRep Any
forall a b. a -> b
unsafeCoerce TypeRep b
y))

reflectTup :: forall j k (xy :: (j, k)) f g a b. (forall (x :: j). f x -> a) -> (forall (y :: k). g y -> b) -> Tup f g xy -> (a, b)
reflectTup :: (forall (x :: j). f x -> a)
-> (forall (y :: k). g y -> b) -> Tup f g xy -> (a, b)
reflectTup forall (x :: j). f x -> a
f forall (y :: k). g y -> b
g (Tup f x
x g y
y) = (f x -> a
forall (x :: j). f x -> a
f f x
x, g y -> b
forall (y :: k). g y -> b
g g y
y)

data SSym :: Symbol -> Type where
    SSym :: KnownSymbol s => SSym s
deriving instance Show (SSym s)
toSSym :: TypeRep s -> SSym s
toSSym :: TypeRep s -> SSym s
toSSym TypeRep s
tr = case String -> SomeSymbol
someSymbolVal (ShowS
forall a. Read a => String -> a
read (TypeRep s -> String
forall a. Show a => a -> String
show TypeRep s
tr) :: String) of
  SomeSymbol (Proxy n
Proxy :: Proxy b) -> SSym n -> SSym s
forall a b. a -> b
unsafeCoerce (SSym n
forall (s :: Symbol). KnownSymbol s => SSym s
SSym :: SSym b)
reflectSSym :: forall s. SSym s -> Text
reflectSSym :: SSym s -> Text
reflectSSym s :: SSym s
s@SSym s
SSym = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SSym s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal SSym s
s

data SApiTree :: ApiTree -> Type where
    SBranch :: Prod SSym ms -> Prod (Tup SSym SApiTree) ts -> SApiTree ('Branch ms ts)
deriving instance Show (SApiTree api)
toSApiTree :: TypeRep api -> SApiTree api
toSApiTree :: TypeRep api -> SApiTree api
toSApiTree (App (App TypeRep a
_ TypeRep b
ms) TypeRep b
ts) = SApiTree ('Branch Any Any) -> SApiTree api
forall a b. a -> b
unsafeCoerce (SApiTree ('Branch Any Any) -> SApiTree api)
-> SApiTree ('Branch Any Any) -> SApiTree api
forall a b. (a -> b) -> a -> b
$
    Prod SSym Any
-> Prod (Tup SSym SApiTree) Any -> SApiTree ('Branch Any Any)
forall (ms :: [Symbol]) (ts :: [(Symbol, ApiTree)]).
Prod SSym ms
-> Prod (Tup SSym SApiTree) ts -> SApiTree ('Branch ms ts)
SBranch ((forall (a :: Symbol). TypeRep a -> SSym a)
-> TypeRep Any -> Prod SSym Any
forall k (as :: [k]) (f :: k -> *).
(forall (a :: k). TypeRep a -> f a) -> TypeRep as -> Prod f as
toProd forall (a :: Symbol). TypeRep a -> SSym a
toSSym (TypeRep b -> TypeRep Any
forall a b. a -> b
unsafeCoerce TypeRep b
ms))
            ((forall (a :: (Symbol, ApiTree)). TypeRep a -> Tup SSym SApiTree a)
-> TypeRep Any -> Prod (Tup SSym SApiTree) Any
forall k (as :: [k]) (f :: k -> *).
(forall (a :: k). TypeRep a -> f a) -> TypeRep as -> Prod f as
toProd ((forall (a :: Symbol). TypeRep a -> SSym a)
-> (forall (x :: ApiTree). TypeRep x -> SApiTree x)
-> TypeRep a
-> Tup SSym SApiTree a
forall a b (f :: a -> *) (g :: b -> *) (xy :: (a, b)).
(forall (x :: a). TypeRep x -> f x)
-> (forall (x :: b). TypeRep x -> g x) -> TypeRep xy -> Tup f g xy
toTup forall (a :: Symbol). TypeRep a -> SSym a
toSSym forall (x :: ApiTree). TypeRep x -> SApiTree x
toSApiTree) (TypeRep b -> TypeRep Any
forall a b. a -> b
unsafeCoerce TypeRep b
ts))

data SOrdering :: Ordering -> Type where
    SLT :: SOrdering 'LT
    SEQ :: SOrdering 'EQ
    SGT :: SOrdering 'GT

compSym
    :: forall a b. ()
    => SSym a
    -> SSym b
    -> SOrdering (CmpSymbol a b)
compSym :: SSym a -> SSym b -> SOrdering (CmpSymbol a b)
compSym a :: SSym a
a@SSym a
SSym b :: SSym b
b@SSym b
SSym = case String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SSym a -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal SSym a
a) (SSym b -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal SSym b
b) of
    Ordering
LT -> SOrdering 'LT -> SOrdering (CmpSymbol a b)
forall a b. a -> b
unsafeCoerce SOrdering 'LT
SLT
    Ordering
EQ -> SOrdering 'EQ -> SOrdering (CmpSymbol a b)
forall a b. a -> b
unsafeCoerce SOrdering 'EQ
SEQ
    Ordering
GT -> SOrdering 'GT -> SOrdering (CmpSymbol a b)
forall a b. a -> b
unsafeCoerce SOrdering 'GT
SGT

sMergeMethods
    :: forall err xs ys. ()
    => Prod SSym xs
    -> Prod SSym ys
    -> Prod SSym (MergeMethods err xs ys)
sMergeMethods :: Prod SSym xs -> Prod SSym ys -> Prod SSym (MergeMethods err xs ys)
sMergeMethods = \case
    Prod SSym xs
PNil -> \case
      Prod SSym ys
PNil    -> Prod SSym (MergeMethods err xs ys)
forall k (f :: k -> *). Prod f '[]
PNil
      SSym a
y :< Prod SSym as
ys -> SSym a
y SSym a -> Prod SSym as -> Prod SSym (a : as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod SSym as
ys
    SSym a
x :< Prod SSym as
xs -> \case
      Prod SSym ys
PNil    -> SSym a
x SSym a -> Prod SSym as -> Prod SSym (a : as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod SSym as
xs
      SSym a
y :< Prod SSym as
ys -> case SSym a -> SSym a -> SOrdering (CmpSymbol a a)
forall (a :: Symbol) (b :: Symbol).
SSym a -> SSym b -> SOrdering (CmpSymbol a b)
compSym SSym a
x SSym a
y of
        SOrdering (CmpSymbol a a)
SLT -> SSym a
x SSym a
-> Prod SSym (MergeMethods err as (a : as))
-> Prod SSym (a : MergeMethods err as (a : as))
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod SSym as
-> Prod SSym (a : as) -> Prod SSym (MergeMethods err as (a : as))
forall (err :: ErrorMessage) (xs :: [Symbol]) (ys :: [Symbol]).
Prod SSym xs -> Prod SSym ys -> Prod SSym (MergeMethods err xs ys)
sMergeMethods @err Prod SSym as
xs (SSym a
y SSym a -> Prod SSym as -> Prod SSym (a : as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod SSym as
ys)
        SOrdering (CmpSymbol a a)
SEQ -> String -> Prod SSym (TypeError ...)
forall a. HasCallStack => String -> a
error String
"sMergeMethods: forbidden by type system"
        SOrdering (CmpSymbol a a)
SGT -> SSym a
y SSym a
-> Prod SSym (MergeMethods err (a : as) as)
-> Prod SSym (a : MergeMethods err (a : as) as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod SSym (a : as)
-> Prod SSym as -> Prod SSym (MergeMethods err (a : as) as)
forall (err :: ErrorMessage) (xs :: [Symbol]) (ys :: [Symbol]).
Prod SSym xs -> Prod SSym ys -> Prod SSym (MergeMethods err xs ys)
sMergeMethods @err (SSym a
x SSym a -> Prod SSym as -> Prod SSym (a : as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod SSym as
xs) Prod SSym as
ys

sMergePaths
    :: forall base xs ys. ()
    => Prod (Tup SSym SApiTree) xs
    -> Prod (Tup SSym SApiTree) ys
    -> Prod (Tup SSym SApiTree) (MergePaths base xs ys)
sMergePaths :: Prod (Tup SSym SApiTree) xs
-> Prod (Tup SSym SApiTree) ys
-> Prod (Tup SSym SApiTree) (MergePaths base xs ys)
sMergePaths = \case
    Prod (Tup SSym SApiTree) xs
PNil -> \case
      Prod (Tup SSym SApiTree) ys
PNil -> Prod (Tup SSym SApiTree) (MergePaths base xs ys)
forall k (f :: k -> *). Prod f '[]
PNil
      Tup SSym x
b SApiTree y
y :< Prod (Tup SSym SApiTree) as
bys -> SSym x -> SApiTree y -> Tup SSym SApiTree '(x, y)
forall k k (f :: k -> *) (x :: k) (g :: k -> *) (y :: k).
f x -> g y -> Tup f g '(x, y)
Tup SSym x
b SApiTree y
y Tup SSym SApiTree '(x, y)
-> Prod (Tup SSym SApiTree) as
-> Prod (Tup SSym SApiTree) ('(x, y) : as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod (Tup SSym SApiTree) as
bys
    Tup (SSym x
a :: SSym a) SApiTree y
x :< Prod (Tup SSym SApiTree) as
axs -> \case
      Prod (Tup SSym SApiTree) ys
PNil -> SSym x -> SApiTree y -> Tup SSym SApiTree '(x, y)
forall k k (f :: k -> *) (x :: k) (g :: k -> *) (y :: k).
f x -> g y -> Tup f g '(x, y)
Tup SSym x
a SApiTree y
x Tup SSym SApiTree '(x, y)
-> Prod (Tup SSym SApiTree) as
-> Prod (Tup SSym SApiTree) ('(x, y) : as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod (Tup SSym SApiTree) as
axs
      Tup SSym x
b SApiTree y
y :< Prod (Tup SSym SApiTree) as
bys -> case SSym x -> SSym x -> SOrdering (CmpSymbol x x)
forall (a :: Symbol) (b :: Symbol).
SSym a -> SSym b -> SOrdering (CmpSymbol a b)
compSym SSym x
a SSym x
b of
        SOrdering (CmpSymbol x x)
SLT -> SSym x -> SApiTree y -> Tup SSym SApiTree '(x, y)
forall k k (f :: k -> *) (x :: k) (g :: k -> *) (y :: k).
f x -> g y -> Tup f g '(x, y)
Tup SSym x
a SApiTree y
x Tup SSym SApiTree '(x, y)
-> Prod (Tup SSym SApiTree) (MergePaths base as ('(x, y) : as))
-> Prod
     (Tup SSym SApiTree) ('(x, y) : MergePaths base as ('(x, y) : as))
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod (Tup SSym SApiTree) as
-> Prod (Tup SSym SApiTree) ('(x, y) : as)
-> Prod (Tup SSym SApiTree) (MergePaths base as ('(x, y) : as))
forall (base :: [Symbol]) (xs :: [(Symbol, ApiTree)])
       (ys :: [(Symbol, ApiTree)]).
Prod (Tup SSym SApiTree) xs
-> Prod (Tup SSym SApiTree) ys
-> Prod (Tup SSym SApiTree) (MergePaths base xs ys)
sMergePaths @base Prod (Tup SSym SApiTree) as
axs (SSym x -> SApiTree y -> Tup SSym SApiTree '(x, y)
forall k k (f :: k -> *) (x :: k) (g :: k -> *) (y :: k).
f x -> g y -> Tup f g '(x, y)
Tup SSym x
b SApiTree y
y Tup SSym SApiTree '(x, y)
-> Prod (Tup SSym SApiTree) as
-> Prod (Tup SSym SApiTree) ('(x, y) : as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod (Tup SSym SApiTree) as
bys)
        SOrdering (CmpSymbol x x)
SEQ -> SSym x
-> SApiTree (MergeTree (x : base) y y)
-> Tup SSym SApiTree '(x, MergeTree (x : base) y y)
forall k k (f :: k -> *) (x :: k) (g :: k -> *) (y :: k).
f x -> g y -> Tup f g '(x, y)
Tup SSym x
a (SApiTree y -> SApiTree y -> SApiTree (MergeTree (x : base) y y)
forall (base :: [Symbol]) (a :: ApiTree) (b :: ApiTree).
SApiTree a -> SApiTree b -> SApiTree (MergeTree base a b)
sMergeTree @(a ': base) SApiTree y
x SApiTree y
y) Tup SSym SApiTree '(x, MergeTree (x : base) y y)
-> Prod (Tup SSym SApiTree) (MergePaths base as as)
-> Prod
     (Tup SSym SApiTree)
     ('(x, MergeTree (x : base) y y) : MergePaths base as as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod (Tup SSym SApiTree) as
-> Prod (Tup SSym SApiTree) as
-> Prod (Tup SSym SApiTree) (MergePaths base as as)
forall (base :: [Symbol]) (xs :: [(Symbol, ApiTree)])
       (ys :: [(Symbol, ApiTree)]).
Prod (Tup SSym SApiTree) xs
-> Prod (Tup SSym SApiTree) ys
-> Prod (Tup SSym SApiTree) (MergePaths base xs ys)
sMergePaths @base Prod (Tup SSym SApiTree) as
axs Prod (Tup SSym SApiTree) as
bys
        SOrdering (CmpSymbol x x)
SGT -> SSym x -> SApiTree y -> Tup SSym SApiTree '(x, y)
forall k k (f :: k -> *) (x :: k) (g :: k -> *) (y :: k).
f x -> g y -> Tup f g '(x, y)
Tup SSym x
b SApiTree y
y Tup SSym SApiTree '(x, y)
-> Prod (Tup SSym SApiTree) (MergePaths base ('(x, y) : as) as)
-> Prod
     (Tup SSym SApiTree) ('(x, y) : MergePaths base ('(x, y) : as) as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod (Tup SSym SApiTree) ('(x, y) : as)
-> Prod (Tup SSym SApiTree) as
-> Prod (Tup SSym SApiTree) (MergePaths base ('(x, y) : as) as)
forall (base :: [Symbol]) (xs :: [(Symbol, ApiTree)])
       (ys :: [(Symbol, ApiTree)]).
Prod (Tup SSym SApiTree) xs
-> Prod (Tup SSym SApiTree) ys
-> Prod (Tup SSym SApiTree) (MergePaths base xs ys)
sMergePaths @base (SSym x -> SApiTree y -> Tup SSym SApiTree '(x, y)
forall k k (f :: k -> *) (x :: k) (g :: k -> *) (y :: k).
f x -> g y -> Tup f g '(x, y)
Tup SSym x
a SApiTree y
x Tup SSym SApiTree '(x, y)
-> Prod (Tup SSym SApiTree) as
-> Prod (Tup SSym SApiTree) ('(x, y) : as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> Prod f as -> Prod f (a : as)
:< Prod (Tup SSym SApiTree) as
axs) Prod (Tup SSym SApiTree) as
bys

sMergeTree :: forall base a b. SApiTree a -> SApiTree b -> SApiTree (MergeTree base a b)
sMergeTree :: SApiTree a -> SApiTree b -> SApiTree (MergeTree base a b)
sMergeTree (SBranch Prod SSym ms
mA Prod (Tup SSym SApiTree) ts
pA) (SBranch Prod SSym ms
mB Prod (Tup SSym SApiTree) ts
pB) = Prod
  SSym
  (MergeMethods
     ('Text "Duplicate method in API at path "
      ':<>: 'Text (AppendSymbol "/" (ShowPath base)))
     ms
     ms)
-> Prod (Tup SSym SApiTree) (MergePaths base ts ts)
-> SApiTree
     ('Branch
        (MergeMethods
           ('Text "Duplicate method in API at path "
            ':<>: 'Text (AppendSymbol "/" (ShowPath base)))
           ms
           ms)
        (MergePaths base ts ts))
forall (ms :: [Symbol]) (ts :: [(Symbol, ApiTree)]).
Prod SSym ms
-> Prod (Tup SSym SApiTree) ts -> SApiTree ('Branch ms ts)
SBranch Prod
  SSym
  (MergeMethods
     ('Text "Duplicate method in API at path "
      ':<>: 'Text (AppendSymbol "/" (ShowPath base)))
     ms
     ms)
forall a. HasCallStack => a
undefined (Prod (Tup SSym SApiTree) ts
-> Prod (Tup SSym SApiTree) ts
-> Prod (Tup SSym SApiTree) (MergePaths base ts ts)
forall (base :: [Symbol]) (xs :: [(Symbol, ApiTree)])
       (ys :: [(Symbol, ApiTree)]).
Prod (Tup SSym SApiTree) xs
-> Prod (Tup SSym SApiTree) ys
-> Prod (Tup SSym SApiTree) (MergePaths base xs ys)
sMergePaths @base Prod (Tup SSym SApiTree) ts
pA Prod (Tup SSym SApiTree) ts
pB)