servant: clean up some white spaces, add link explaining why Or works.
This commit is contained in:
parent
c87b846815
commit
13fcb4f3f1
1 changed files with 25 additions and 22 deletions
|
@ -137,16 +137,19 @@ data Link = Link
|
||||||
} deriving Show
|
} deriving Show
|
||||||
|
|
||||||
-- | If either a or b produce an empty constraint, produce an empty constraint.
|
-- | If either a or b produce an empty constraint, produce an empty constraint.
|
||||||
|
--
|
||||||
|
-- This works because of:
|
||||||
|
-- https://ghc.haskell.org/trac/ghc/wiki/NewAxioms/CoincidentOverlap
|
||||||
type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
|
type family Or (a :: Constraint) (b :: Constraint) :: Constraint where
|
||||||
Or () b = ()
|
Or () b = ()
|
||||||
Or a () = ()
|
Or a () = ()
|
||||||
|
|
||||||
-- | If both a or b produce an empty constraint, produce an empty constraint.
|
-- | If both a or b produce an empty constraint, produce an empty constraint.
|
||||||
type family And (a :: Constraint) (b :: Constraint) :: Constraint where
|
type family And (a :: Constraint) (b :: Constraint) :: Constraint where
|
||||||
And () () = ()
|
And () () = ()
|
||||||
|
|
||||||
-- | You may use this type family to tell the type checker that your custom type
|
-- | You may use this type family to tell the type checker that your custom
|
||||||
-- may be skipped as part of a link. This is useful for things like
|
-- type may be skipped as part of a link. This is useful for things like
|
||||||
-- 'QueryParam' that are optional in a URI and do not affect them if they are
|
-- 'QueryParam' that are optional in a URI and do not affect them if they are
|
||||||
-- omitted.
|
-- omitted.
|
||||||
--
|
--
|
||||||
|
@ -162,30 +165,30 @@ type family IsElem' a s :: Constraint
|
||||||
|
|
||||||
-- | Closed type family, check if endpoint is within api
|
-- | Closed type family, check if endpoint is within api
|
||||||
type family IsElem endpoint api :: Constraint where
|
type family IsElem endpoint api :: Constraint where
|
||||||
IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
|
IsElem e (sa :<|> sb) = Or (IsElem e sa) (IsElem e sb)
|
||||||
IsElem (e :> sa) (e :> sb) = IsElem sa sb
|
IsElem (e :> sa) (e :> sb) = IsElem sa sb
|
||||||
IsElem sa (Header x :> sb) = IsElem sa sb
|
IsElem sa (Header x :> sb) = IsElem sa sb
|
||||||
IsElem sa (ReqBody y x :> sb) = IsElem sa sb
|
IsElem sa (ReqBody y x :> sb) = IsElem sa sb
|
||||||
IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb
|
IsElem (e :> sa) (Capture x y :> sb) = IsElem sa sb
|
||||||
IsElem sa (QueryParam x y :> sb) = IsElem sa sb
|
IsElem sa (QueryParam x y :> sb) = IsElem sa sb
|
||||||
IsElem sa (QueryParams x y :> sb) = IsElem sa sb
|
IsElem sa (QueryParams x y :> sb) = IsElem sa sb
|
||||||
IsElem sa (QueryFlag x :> sb) = IsElem sa sb
|
IsElem sa (QueryFlag x :> sb) = IsElem sa sb
|
||||||
IsElem sa (MatrixParam x y :> sb) = IsElem sa sb
|
IsElem sa (MatrixParam x y :> sb) = IsElem sa sb
|
||||||
IsElem sa (MatrixParams x y :> sb) = IsElem sa sb
|
IsElem sa (MatrixParams x y :> sb) = IsElem sa sb
|
||||||
IsElem sa (MatrixFlag x :> sb) = IsElem sa sb
|
IsElem sa (MatrixFlag x :> sb) = IsElem sa sb
|
||||||
IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct'
|
IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct'
|
||||||
IsElem (Post ct typ) (Post ct' typ) = IsSubList ct ct'
|
IsElem (Post ct typ) (Post ct' typ) = IsSubList ct ct'
|
||||||
IsElem (Put ct typ) (Put ct' typ) = IsSubList ct ct'
|
IsElem (Put ct typ) (Put ct' typ) = IsSubList ct ct'
|
||||||
IsElem (Delete ct typ) (Delete ct' typ) = IsSubList ct ct'
|
IsElem (Delete ct typ) (Delete ct' typ) = IsSubList ct ct'
|
||||||
IsElem e e = ()
|
IsElem e e = ()
|
||||||
IsElem e a = IsElem' e a
|
IsElem e a = IsElem' e a
|
||||||
|
|
||||||
|
|
||||||
type family IsSubList a b :: Constraint where
|
type family IsSubList a b :: Constraint where
|
||||||
IsSubList '[] b = ()
|
IsSubList '[] b = ()
|
||||||
IsSubList '[x] (x ': xs) = ()
|
IsSubList '[x] (x ': xs) = ()
|
||||||
IsSubList '[x] (y ': ys) = IsSubList '[x] ys
|
IsSubList '[x] (y ': ys) = IsSubList '[x] ys
|
||||||
IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y
|
IsSubList (x ': xs) y = IsSubList '[x] y `And` IsSubList xs y
|
||||||
|
|
||||||
-- Phantom types for Param
|
-- Phantom types for Param
|
||||||
data Matrix
|
data Matrix
|
||||||
|
|
Loading…
Reference in a new issue