hreq-core-0.1.0.0: Core functionality for Hreq Http client library

Safe HaskellNone
LanguageHaskell2010

Hreq.Core.API.TypeLevel

Description

Type level functions over ReqContent and ResContent

Synopsis

Documentation

type family ApiToReq (a :: api) :: [ReqContent Type] where ... Source #

ApiToReq transforms an API type into a type level list of Request component content types. The resulting list is used by the HasRequest class.

Equations

ApiToReq (Verb m ts) = '[] 
ApiToReq ((path :: Symbol) :> ts) = Path () path ': ApiToReq ts 
ApiToReq ((x :: ReqContent Type) :> ts) = x ': ApiToReq ts 

type family GetVerb (a :: api) :: Type where ... Source #

Given an API type, GetVerb retrieves the Verb type component which is used by the HasResponse class.

Equations

GetVerb (Verb m ts) = Verb m ts 
GetVerb (api :> sub) = GetVerb sub 

type family HttpReq (ts :: [ReqContent Type]) :: [Type] where ... Source #

HttpReq interprets a ReqContent list as a Type level list used in the HasRequest class for representing request component inputs

Equations

HttpReq '[] = '[] 
HttpReq (Path _ _ ': ts) = HttpReq ts 
HttpReq (ReqBody ctyp a ': ts) = a ': HttpReq ts 
HttpReq (StreamBody ctyp a ': ts) = a ': HttpReq ts 
HttpReq (BasicAuth _ _ ': ts) = BasicAuthData ': HttpReq ts 
HttpReq (QueryFlags _ _ ': ts) = HttpReq ts 
HttpReq (Params ('(s, a) ': ps) ': ts) = a ': HttpReq (Params ps ': ts) 
HttpReq (Params '[] ': ts) = HttpReq ts 
HttpReq (CaptureAll a ': ts) = [a] ': HttpReq ts 
HttpReq (Captures (a ': cs) ': ts) = a ': HttpReq (Captures cs ': ts) 
HttpReq (Captures '[] ': ts) = HttpReq ts 
HttpReq (ReqHeaders ('(s, a) ': hs) ': ts) = a ': HttpReq (ReqHeaders hs ': ts) 
HttpReq (ReqHeaders '[] ': ts) = HttpReq ts 

type family HttpRes (res :: [ResContent Type]) :: [Type] where ... Source #

HttpRes interprets a ResContent list as a Type level list for used HasResponse class to represent responses

Equations

HttpRes '[] = '[] 
HttpRes (ResBody ctyp a ': ts) = a ': HttpRes ts 
HttpRes (ResHeaders (s ': hs) ': ts) = [Header] ': HttpRes ts 
HttpRes (ResHeaders '[] ': ts) = HttpRes ts 
HttpRes (Raw a ': ts) = HttpRes ts 

type family HttpResConstraints (res :: [ResContent Type]) :: Constraint where ... Source #

Response content types Constraints.

type family HttpSymbolTypePair (ts :: [(Symbol, Type)]) :: Constraint where ... Source #

For a given HTTP API data Symbol Type tuple list generate Constraints for all the members.

type family UniqMembers (ts :: [k]) (label :: Symbol) :: Constraint where ... Source #

Cross check that there are no repeated instance of an item with in a type level list. For instance we want to have only one ResBody with in a Response type level list

Equations

UniqMembers '[] label = () 
UniqMembers (a ': ts) label = (UniqMember a ts label, UniqMembers ts label) 

type family UniqMember (a :: k) (ts :: [k]) (label :: Symbol) :: Constraint where ... Source #

Equations

UniqMember a '[] label = () 
UniqMember a (a ': ts) label = TypeError ((((Text "Type " :<>: ShowType a) :<>: Text "Should be unique with in the ") :<>: Text label) :<>: Text " type level list") 
UniqMember a (b ': ts) label = UniqMember b ts label 

type family All (a :: k -> Constraint) (ts :: [k]) :: Constraint where ... Source #

Equations

All c '[] = () 
All c (t ': ts) = (c t, All c ts) 

type family AllFsts (a :: [(k1, k2)]) :: [k1] where ... Source #

Equations

AllFsts '[] = '[] 
AllFsts ('(f, s) ': ts) = f ': AllFsts ts 

type family AllSnds (a :: [(k1, k2)]) :: [k2] where ... Source #

Equations

AllSnds '[] = '[] 
AllSnds ('(f, s) ': ts) = s ': AllSnds ts