Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
This module provides functions and instances for working with query parameter records.
Documentation
data RecordParam (mod :: Symbol -> Exp Symbol) (a :: Type) Source #
RecordParam
uses fields in a record to represent query parameters.
For each record field:
- The modified record field name becomes a query parameter name.
- The record field type becomes the query parameter type.
For example, this API:
type API = "users" :> (QueryParam "category" Category :> QueryParam' '[Required, Strict] "sort_by" SortBy :> QueryFlag "with_schema" :> QueryParams "filters" Filter :> Get '[JSON] User)
can be written using records:
data DropPrefixExp :: sym ->Exp
sym type instanceEval
(DropPrefixExp sym) =DropPrefix
sym data UserParams = UserParams { _userParams_category :: Maybe Category , _userParams_sort_by :: SortBy , _userParams_with_schema :: Bool , _userParams_filters :: [Filter] } type API = "users" :>RecordParam
DropPrefixExp UserParams :> Get '[JSON] User
Here, DropPrefixExp
wraps a sym
into Exp
.
The instance of Eval
for DropPrefixExp sym
drops the prefix of that sym
via DropPrefix
.
DropPrefix
is applied to the fields of UserParams
.
The "_userParams_category"
record field corresponds to the query parameter "category"
.
Instances
(Generic a, GHasLink mod (Rep a) sub) => HasLink (RecordParam mod a :> sub :: Type) Source # | |
Defined in Servant.Record type MkLink (RecordParam mod a :> sub) a # toLink :: (Link -> a0) -> Proxy (RecordParam mod a :> sub) -> Link -> MkLink (RecordParam mod a :> sub) a0 # | |
type MkLink (RecordParam mod a :> sub :: Type) b Source # | |
Defined in Servant.Record |
type family UnRecordParam (mod :: Symbol -> Exp Symbol) (x :: Type) :: Type where ... Source #
Type family for rewriting a RecordParam
API to a regular servant
API.
This family is useful for defining instances of classes that extract information from the API type,
such as classes from servant-swagger
or servant-foreign
.
Typical use:
instance SomeClass (UnRecordParam (RecordParam mod a :> api))) => SomeClass (RecordParam mod a :> api) where someMethod _ = someMethod (Proxy :: Proxy (UnRecordParam (RecordParam mod a :> api))
UnRecordParam mod (a :> b) = ServantAppend (UnRecordParam mod a) b | |
UnRecordParam mod (RecordParam mod a) = UnRecordParam mod (Rep a ()) | |
UnRecordParam mod (D1 m c d) = UnRecordParam mod (c d) | |
UnRecordParam mod ((a :*: b) d) = ServantAppend (UnRecordParam mod (a d)) (UnRecordParam mod (b d)) | |
UnRecordParam mod (C1 m a d) = UnRecordParam mod (a d) | |
UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 Bool) d) = QueryFlag (Eval (mod sym)) | |
UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 [a]) d) = QueryParams (Eval (mod sym)) a | |
UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 (Maybe a)) d) = QueryParam' [Optional, Strict] (Eval (mod sym)) a | |
UnRecordParam mod (S1 ('MetaSel ('Just sym) d1 d2 d3) (Rec0 a) d) = QueryParam' [Required, Strict] (Eval (mod sym)) a |