module Servant.Swagger.Internal.TypeLevel.API where
import Data.Type.Bool (If)
import Servant.API
import GHC.Exts (Constraint)
type family EndpointsList api where
EndpointsList (a :<|> b) = AppendList (EndpointsList a) (EndpointsList b)
EndpointsList (e :> a) = MapSub e (EndpointsList a)
EndpointsList a = '[a]
type family IsSubAPI sub api :: Constraint where
IsSubAPI sub api = AllIsElem (EndpointsList sub) api
type family AllIsElem xs api :: Constraint where
AllIsElem '[] api = ()
AllIsElem (x ': xs) api = (IsIn x api, AllIsElem xs api)
type family MapSub e xs where
MapSub e '[] = '[]
MapSub e (x ': xs) = (e :> x) ': MapSub e xs
type family AppendList xs ys where
AppendList '[] ys = ys
AppendList (x ': xs) ys = x ': AppendList xs ys
type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
Or () b = ()
Or a () = ()
type family IsIn sub api :: Constraint where
IsIn e (a :<|> b) = Or (IsIn e a) (IsIn e b)
IsIn (e :> a) (e :> b) = IsIn a b
IsIn e e = ()
type family Elem x xs where
Elem x '[] = 'False
Elem x (x ': xs) = 'True
Elem x (y ': xs) = Elem x xs
type AddBodyType c cs a as = If (Elem c cs) (Insert a as) as
type Insert x xs = If (Elem x xs) xs (x ': xs)
type family Merge xs ys where
Merge '[] ys = ys
Merge (x ': xs) ys = Insert x (Merge xs ys)
type family BodyTypes c api :: [*] where
BodyTypes c (Delete cs (Headers hdrs a)) = AddBodyType c cs a '[]
BodyTypes c (Get cs (Headers hdrs a)) = AddBodyType c cs a '[]
BodyTypes c (Patch cs (Headers hdrs a)) = AddBodyType c cs a '[]
BodyTypes c (Post cs (Headers hdrs a)) = AddBodyType c cs a '[]
BodyTypes c (Put cs (Headers hdrs a)) = AddBodyType c cs a '[]
BodyTypes c (Delete cs a) = AddBodyType c cs a '[]
BodyTypes c (Get cs a) = AddBodyType c cs a '[]
BodyTypes c (Patch cs a) = AddBodyType c cs a '[]
BodyTypes c (Post cs a) = AddBodyType c cs a '[]
BodyTypes c (Put cs a) = AddBodyType c cs a '[]
BodyTypes c (ReqBody cs a :> api) = AddBodyType c cs a (BodyTypes c api)
BodyTypes c (e :> api) = BodyTypes c api
BodyTypes c (a :<|> b) = Merge (BodyTypes c a) (BodyTypes c b)