module Serv.Api (
Api (..)
, Path (..)
, Handler (..)
, Output (..)
, Body (..)
, type (:::)
, Sing (
SEndpoint, SOneOf, SAbstract, (:%>)
, SConst, SHeaderAs, SSeg, SHeader, SWildcard
, SMethod, SCaptureBody, SCaptureHeaders, SCaptureQuery
, SRespond
, SHasBody, SEmpty
)
, Endpoint, OneOf, Abstract, (:>)
, Const, HeaderAs, Seg, Header, Wildcard
, Method, CaptureBody, CaptureHeaders, CaptureQuery
, Respond
, HasBody, Empty
) where
import Data.Singletons
import Data.Singletons.TypeLits
import Network.HTTP.Kinder.Header (HeaderName)
import Network.HTTP.Kinder.Status (Status)
import Network.HTTP.Kinder.Verb
type a ::: b = '( a, b )
infixr 6 :::
data Body star
= HasBody [star] star
| Empty
data instance Sing (b :: Body *)
= forall ts a . b ~ HasBody ts a => SHasBody (Sing ts) (Sing a)
| b ~ Empty => SEmpty
instance (SingI ts, SingI a) => SingI ('HasBody ts a :: Body *) where
sing = SHasBody sing sing
instance SingI ('Empty :: Body *) where
sing = SEmpty
type HasBody ctypes ty = 'HasBody ctypes ty
type Empty = 'Empty
data Output star = Respond [ (HeaderName, star) ] (Body star)
data instance Sing (o :: Output *)
= forall ts b . o ~ Respond ts b => SRespond (Sing ts) (Sing b)
instance (SingI ts, SingI b) => SingI ('Respond ts b :: Output *) where
sing = SRespond sing sing
type Respond hdrs body = 'Respond hdrs body
data Handler star
= Method Verb [(Status, Output star)]
| CaptureBody [star] star (Handler star)
| CaptureHeaders [(HeaderName, star)] (Handler star)
| CaptureQuery [(Symbol, star)] (Handler star)
data instance Sing (h :: Handler *)
= forall v ts . h ~ Method v ts => SMethod (Sing v) (Sing ts)
| forall ts a k . h ~ CaptureBody ts a k => SCaptureBody (Sing ts) (Sing a) (Sing k)
| forall ts k . h ~ CaptureHeaders ts k => SCaptureHeaders (Sing ts) (Sing k)
| forall ts k . h ~ CaptureQuery ts k => SCaptureQuery (Sing ts) (Sing k)
instance (SingI v, SingI ts) => SingI ('Method v ts :: Handler *) where
sing = SMethod sing sing
instance (SingI ts, SingI a, SingI k) => SingI ('CaptureBody ts a k :: Handler *) where
sing = SCaptureBody sing sing sing
instance (SingI ts, SingI k) => SingI ('CaptureHeaders ts k :: Handler *) where
sing = SCaptureHeaders sing sing
instance (SingI ts, SingI k) => SingI ('CaptureQuery ts k :: Handler *) where
sing = SCaptureQuery sing sing
type Method verb responses = 'Method verb responses
type CaptureBody cTypes ty method = 'CaptureBody cTypes ty method
type CaptureHeaders hdrs method = 'CaptureHeaders hdrs method
type CaptureQuery query method = 'CaptureQuery query method
data Path star
= Const Symbol
| HeaderAs HeaderName Symbol
| Seg Symbol star
| Header HeaderName star
| Wildcard
data instance Sing (p :: Path *)
= forall s . p ~ Const s => SConst (Sing s)
| forall n v . p ~ HeaderAs n v => SHeaderAs (Sing n) (Sing v)
| forall n t . p ~ Seg n t => SSeg (Sing n) (Sing t)
| forall n t . p ~ Header n t => SHeader (Sing n) (Sing t)
| p ~ Wildcard => SWildcard
instance SingI s => SingI (Const s :: Path *) where
sing = SConst sing
instance (SingI n, SingI v) => SingI (HeaderAs n v :: Path *) where
sing = SHeaderAs sing sing
instance (SingI n, SingI t) => SingI (Seg n t :: Path *) where
sing = SSeg sing sing
instance (SingI n, SingI t) => SingI (Header n t :: Path *) where
sing = SHeader sing sing
instance SingI (Wildcard :: Path *) where
sing = SWildcard
type Const sym = 'Const sym
type HeaderAs ty sym = 'HeaderAs ty sym
type Seg sym ty = 'Seg sym ty
type Header name ty = 'Header name ty
type Wildcard = 'Wildcard
data Api star
= Endpoint star [Handler star]
| OneOf [Api star]
| Abstract
| Path star :> Api star
infixr 5 :>
data instance Sing (a :: Api *)
= forall t ts . a ~ Endpoint t ts => SEndpoint (Sing t) (Sing ts)
| forall ts . a ~ OneOf ts => SOneOf (Sing ts)
| a ~ Abstract => SAbstract
| forall p k . a ~ (p :> k) => Sing p :%> Sing k
instance (SingI t, SingI ts) => SingI ('Endpoint t ts :: Api *) where
sing = SEndpoint sing sing
instance SingI ts => SingI ('OneOf ts :: Api *) where
sing = SOneOf sing
instance SingI (Abstract :: Api *) where
sing = SAbstract
instance (SingI p, SingI k) => SingI (p :> k :: Api *) where
sing = sing :%> sing
type Endpoint ann ms = 'Endpoint ann ms
type OneOf apis = 'OneOf apis
type Abstract = 'Abstract
type a :> b = a ':> b