Rename type variables 'layout' and 'sublayout' to 'api'
This commit is contained in:
Sönke Hahn
parent
023368c396
commit
5effdfdbbb
|
|
@ -57,15 +57,15 @@ import Servant.Common.Req
|
|||
-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]
|
||||
-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book
|
||||
-- > (getAllBooks :<|> postNewBook) = client myApi
|
||||
client :: HasClient layout => Proxy layout -> Client layout
|
||||
client :: HasClient api => Proxy api -> Client api
|
||||
client p = clientWithRoute p defReq
|
||||
|
||||
-- | This class lets us define how each API combinator
|
||||
-- influences the creation of an HTTP request. It's mostly
|
||||
-- an internal class, you can just use 'client'.
|
||||
class HasClient layout where
|
||||
type Client layout :: *
|
||||
clientWithRoute :: Proxy layout -> Req -> Client layout
|
||||
class HasClient api where
|
||||
type Client api :: *
|
||||
clientWithRoute :: Proxy api -> Req -> Client api
|
||||
|
||||
|
||||
-- | A client querying function for @a ':<|>' b@ will actually hand you
|
||||
|
|
@ -106,14 +106,14 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
|
|||
-- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book
|
||||
-- > getBook = client myApi
|
||||
-- > -- then you can just use "getBook" to query that endpoint
|
||||
instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
|
||||
=> HasClient (Capture capture a :> sublayout) where
|
||||
instance (KnownSymbol capture, ToHttpApiData a, HasClient api)
|
||||
=> HasClient (Capture capture a :> api) where
|
||||
|
||||
type Client (Capture capture a :> sublayout) =
|
||||
a -> Client sublayout
|
||||
type Client (Capture capture a :> api) =
|
||||
a -> Client api
|
||||
|
||||
clientWithRoute Proxy req val =
|
||||
clientWithRoute (Proxy :: Proxy sublayout)
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
(appendToPath p req)
|
||||
|
||||
where p = unpack (toUrlPiece val)
|
||||
|
|
@ -186,14 +186,14 @@ instance OVERLAPPING_
|
|||
-- > viewReferer = client myApi
|
||||
-- > -- then you can just use "viewRefer" to query that endpoint
|
||||
-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
|
||||
=> HasClient (Header sym a :> sublayout) where
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
|
||||
=> HasClient (Header sym a :> api) where
|
||||
|
||||
type Client (Header sym a :> sublayout) =
|
||||
Maybe a -> Client sublayout
|
||||
type Client (Header sym a :> api) =
|
||||
Maybe a -> Client api
|
||||
|
||||
clientWithRoute Proxy req mval =
|
||||
clientWithRoute (Proxy :: Proxy sublayout)
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
(maybe req
|
||||
(\value -> Servant.Common.Req.addHeader hname value req)
|
||||
mval
|
||||
|
|
@ -203,14 +203,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
|
|||
|
||||
-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
|
||||
-- functions.
|
||||
instance HasClient sublayout
|
||||
=> HasClient (HttpVersion :> sublayout) where
|
||||
instance HasClient api
|
||||
=> HasClient (HttpVersion :> api) where
|
||||
|
||||
type Client (HttpVersion :> sublayout) =
|
||||
Client sublayout
|
||||
type Client (HttpVersion :> api) =
|
||||
Client api
|
||||
|
||||
clientWithRoute Proxy =
|
||||
clientWithRoute (Proxy :: Proxy sublayout)
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
|
||||
-- | If you use a 'QueryParam' in one of your endpoints in your API,
|
||||
-- the corresponding querying function will automatically take
|
||||
|
|
@ -237,15 +237,15 @@ instance HasClient sublayout
|
|||
-- > -- then you can just use "getBooksBy" to query that endpoint.
|
||||
-- > -- 'getBooksBy Nothing' for all books
|
||||
-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
|
||||
=> HasClient (QueryParam sym a :> sublayout) where
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
|
||||
=> HasClient (QueryParam sym a :> api) where
|
||||
|
||||
type Client (QueryParam sym a :> sublayout) =
|
||||
Maybe a -> Client sublayout
|
||||
type Client (QueryParam sym a :> api) =
|
||||
Maybe a -> Client api
|
||||
|
||||
-- if mparam = Nothing, we don't add it to the query string
|
||||
clientWithRoute Proxy req mparam =
|
||||
clientWithRoute (Proxy :: Proxy sublayout)
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
(maybe req
|
||||
(flip (appendToQueryString pname) req . Just)
|
||||
mparamText
|
||||
|
|
@ -282,14 +282,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
|
|||
-- > -- 'getBooksBy []' for all books
|
||||
-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
|
||||
-- > -- to get all books by Asimov and Heinlein
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
|
||||
=> HasClient (QueryParams sym a :> sublayout) where
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
|
||||
=> HasClient (QueryParams sym a :> api) where
|
||||
|
||||
type Client (QueryParams sym a :> sublayout) =
|
||||
[a] -> Client sublayout
|
||||
type Client (QueryParams sym a :> api) =
|
||||
[a] -> Client api
|
||||
|
||||
clientWithRoute Proxy req paramlist =
|
||||
clientWithRoute (Proxy :: Proxy sublayout)
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
(foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
|
||||
req
|
||||
paramlist'
|
||||
|
|
@ -320,14 +320,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
|
|||
-- > -- then you can just use "getBooks" to query that endpoint.
|
||||
-- > -- 'getBooksBy False' for all books
|
||||
-- > -- 'getBooksBy True' to only get _already published_ books
|
||||
instance (KnownSymbol sym, HasClient sublayout)
|
||||
=> HasClient (QueryFlag sym :> sublayout) where
|
||||
instance (KnownSymbol sym, HasClient api)
|
||||
=> HasClient (QueryFlag sym :> api) where
|
||||
|
||||
type Client (QueryFlag sym :> sublayout) =
|
||||
Bool -> Client sublayout
|
||||
type Client (QueryFlag sym :> api) =
|
||||
Bool -> Client api
|
||||
|
||||
clientWithRoute Proxy req flag =
|
||||
clientWithRoute (Proxy :: Proxy sublayout)
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
(if flag
|
||||
then appendToQueryString paramname Nothing req
|
||||
else req
|
||||
|
|
@ -364,14 +364,14 @@ instance HasClient Raw where
|
|||
-- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book
|
||||
-- > addBook = client myApi
|
||||
-- > -- then you can just use "addBook" to query that endpoint
|
||||
instance (MimeRender ct a, HasClient sublayout)
|
||||
=> HasClient (ReqBody (ct ': cts) a :> sublayout) where
|
||||
instance (MimeRender ct a, HasClient api)
|
||||
=> HasClient (ReqBody (ct ': cts) a :> api) where
|
||||
|
||||
type Client (ReqBody (ct ': cts) a :> sublayout) =
|
||||
a -> Client sublayout
|
||||
type Client (ReqBody (ct ': cts) a :> api) =
|
||||
a -> Client api
|
||||
|
||||
clientWithRoute Proxy req body =
|
||||
clientWithRoute (Proxy :: Proxy sublayout)
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
(let ctProxy = Proxy :: Proxy ct
|
||||
in setRQBody (mimeRender ctProxy body)
|
||||
(contentType ctProxy)
|
||||
|
|
@ -379,11 +379,11 @@ instance (MimeRender ct a, HasClient sublayout)
|
|||
)
|
||||
|
||||
-- | Make the querying function append @path@ to the request path.
|
||||
instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
|
||||
type Client (path :> sublayout) = Client sublayout
|
||||
instance (KnownSymbol path, HasClient api) => HasClient (path :> api) where
|
||||
type Client (path :> api) = Client api
|
||||
|
||||
clientWithRoute Proxy req =
|
||||
clientWithRoute (Proxy :: Proxy sublayout)
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
(appendToPath p req)
|
||||
|
||||
where p = symbolVal (Proxy :: Proxy path)
|
||||
|
|
|
|||
|
|
@ -163,7 +163,7 @@ data DocNote = DocNote
|
|||
--
|
||||
-- These are intended to be built using extraInfo.
|
||||
-- Multiple ExtraInfo may be combined with the monoid instance.
|
||||
newtype ExtraInfo layout = ExtraInfo (HashMap Endpoint Action)
|
||||
newtype ExtraInfo api = ExtraInfo (HashMap Endpoint Action)
|
||||
instance Monoid (ExtraInfo a) where
|
||||
mempty = ExtraInfo mempty
|
||||
ExtraInfo a `mappend` ExtraInfo b =
|
||||
|
|
@ -300,11 +300,11 @@ makeLenses ''Action
|
|||
-- default way to create documentation.
|
||||
--
|
||||
-- prop> docs == docsWithOptions defaultDocOptions
|
||||
docs :: HasDocs layout => Proxy layout -> API
|
||||
docs :: HasDocs api => Proxy api -> API
|
||||
docs p = docsWithOptions p defaultDocOptions
|
||||
|
||||
-- | Generate the docs for a given API that implements 'HasDocs'.
|
||||
docsWithOptions :: HasDocs layout => Proxy layout -> DocOptions -> API
|
||||
docsWithOptions :: HasDocs api => Proxy api -> DocOptions -> API
|
||||
docsWithOptions p = docsFor p (defEndpoint, defAction)
|
||||
|
||||
-- | Closed type family, check if endpoint is exactly within API.
|
||||
|
|
@ -316,7 +316,7 @@ type family IsIn (endpoint :: *) (api :: *) :: Constraint where
|
|||
IsIn (e :> sa) (e :> sb) = IsIn sa sb
|
||||
IsIn e e = ()
|
||||
|
||||
-- | Create an 'ExtraInfo' that is garunteed to be within the given API layout.
|
||||
-- | Create an 'ExtraInfo' that is guaranteed to be within the given API layout.
|
||||
--
|
||||
-- The safety here is to ensure that you only add custom documentation to an
|
||||
-- endpoint that actually exists within your API.
|
||||
|
|
@ -329,8 +329,8 @@ type family IsIn (endpoint :: *) (api :: *) :: Constraint where
|
|||
-- > , DocNote "Second secton" ["And some more"]
|
||||
-- > ]
|
||||
|
||||
extraInfo :: (IsIn endpoint layout, HasLink endpoint, HasDocs endpoint)
|
||||
=> Proxy endpoint -> Action -> ExtraInfo layout
|
||||
extraInfo :: (IsIn endpoint api, HasLink endpoint, HasDocs endpoint)
|
||||
=> Proxy endpoint -> Action -> ExtraInfo api
|
||||
extraInfo p action =
|
||||
let api = docsFor p (defEndpoint, defAction) defaultDocOptions
|
||||
-- Assume one endpoint, HasLink constraint means that we should only ever
|
||||
|
|
@ -349,7 +349,7 @@ extraInfo p action =
|
|||
-- 'extraInfo'.
|
||||
--
|
||||
-- If you only want to add an introduction, use 'docsWithIntros'.
|
||||
docsWith :: HasDocs layout => DocOptions -> [DocIntro] -> ExtraInfo layout -> Proxy layout -> API
|
||||
docsWith :: HasDocs api => DocOptions -> [DocIntro] -> ExtraInfo api -> Proxy api -> API
|
||||
docsWith opts intros (ExtraInfo endpoints) p =
|
||||
docsWithOptions p opts
|
||||
& apiIntros <>~ intros
|
||||
|
|
@ -358,13 +358,13 @@ docsWith opts intros (ExtraInfo endpoints) p =
|
|||
|
||||
-- | Generate the docs for a given API that implements 'HasDocs' with with any
|
||||
-- number of introduction(s)
|
||||
docsWithIntros :: HasDocs layout => [DocIntro] -> Proxy layout -> API
|
||||
docsWithIntros :: HasDocs api => [DocIntro] -> Proxy api -> API
|
||||
docsWithIntros intros = docsWith defaultDocOptions intros mempty
|
||||
|
||||
-- | The class that abstracts away the impact of API combinators
|
||||
-- on documentation generation.
|
||||
class HasDocs layout where
|
||||
docsFor :: Proxy layout -> (Endpoint, Action) -> DocOptions -> API
|
||||
class HasDocs api where
|
||||
docsFor :: Proxy api -> (Endpoint, Action) -> DocOptions -> API
|
||||
|
||||
-- | The class that lets us display a sample input or output in the supported
|
||||
-- content-types when generating documentation for endpoints that either:
|
||||
|
|
@ -675,26 +675,26 @@ markdown api = unlines $
|
|||
-- | The generated docs for @a ':<|>' b@ just appends the docs
|
||||
-- for @a@ with the docs for @b@.
|
||||
instance OVERLAPPABLE_
|
||||
(HasDocs layout1, HasDocs layout2)
|
||||
=> HasDocs (layout1 :<|> layout2) where
|
||||
(HasDocs a, HasDocs b)
|
||||
=> HasDocs (a :<|> b) where
|
||||
|
||||
docsFor Proxy (ep, action) = docsFor p1 (ep, action) <> docsFor p2 (ep, action)
|
||||
|
||||
where p1 :: Proxy layout1
|
||||
where p1 :: Proxy a
|
||||
p1 = Proxy
|
||||
|
||||
p2 :: Proxy layout2
|
||||
p2 :: Proxy b
|
||||
p2 = Proxy
|
||||
|
||||
-- | @"books" :> 'Capture' "isbn" Text@ will appear as
|
||||
-- @/books/:isbn@ in the docs.
|
||||
instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout)
|
||||
=> HasDocs (Capture sym a :> sublayout) where
|
||||
instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs api)
|
||||
=> HasDocs (Capture sym a :> api) where
|
||||
|
||||
docsFor Proxy (endpoint, action) =
|
||||
docsFor sublayoutP (endpoint', action')
|
||||
docsFor subApiP (endpoint', action')
|
||||
|
||||
where sublayoutP = Proxy :: Proxy sublayout
|
||||
where subApiP = Proxy :: Proxy api
|
||||
captureP = Proxy :: Proxy (Capture sym a)
|
||||
|
||||
action' = over captures (|> toCapture captureP) action
|
||||
|
|
@ -736,43 +736,43 @@ instance OVERLAPPING_
|
|||
status = fromInteger $ natVal (Proxy :: Proxy status)
|
||||
p = Proxy :: Proxy a
|
||||
|
||||
instance (KnownSymbol sym, HasDocs sublayout)
|
||||
=> HasDocs (Header sym a :> sublayout) where
|
||||
instance (KnownSymbol sym, HasDocs api)
|
||||
=> HasDocs (Header sym a :> api) where
|
||||
docsFor Proxy (endpoint, action) =
|
||||
docsFor sublayoutP (endpoint, action')
|
||||
docsFor subApiP (endpoint, action')
|
||||
|
||||
where sublayoutP = Proxy :: Proxy sublayout
|
||||
where subApiP = Proxy :: Proxy api
|
||||
action' = over headers (|> headername) action
|
||||
headername = T.pack $ symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs sublayout)
|
||||
=> HasDocs (QueryParam sym a :> sublayout) where
|
||||
instance (KnownSymbol sym, ToParam (QueryParam sym a), HasDocs api)
|
||||
=> HasDocs (QueryParam sym a :> api) where
|
||||
|
||||
docsFor Proxy (endpoint, action) =
|
||||
docsFor sublayoutP (endpoint, action')
|
||||
docsFor subApiP (endpoint, action')
|
||||
|
||||
where sublayoutP = Proxy :: Proxy sublayout
|
||||
where subApiP = Proxy :: Proxy api
|
||||
paramP = Proxy :: Proxy (QueryParam sym a)
|
||||
action' = over params (|> toParam paramP) action
|
||||
|
||||
instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs sublayout)
|
||||
=> HasDocs (QueryParams sym a :> sublayout) where
|
||||
instance (KnownSymbol sym, ToParam (QueryParams sym a), HasDocs api)
|
||||
=> HasDocs (QueryParams sym a :> api) where
|
||||
|
||||
docsFor Proxy (endpoint, action) =
|
||||
docsFor sublayoutP (endpoint, action')
|
||||
docsFor subApiP (endpoint, action')
|
||||
|
||||
where sublayoutP = Proxy :: Proxy sublayout
|
||||
where subApiP = Proxy :: Proxy api
|
||||
paramP = Proxy :: Proxy (QueryParams sym a)
|
||||
action' = over params (|> toParam paramP) action
|
||||
|
||||
|
||||
instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs sublayout)
|
||||
=> HasDocs (QueryFlag sym :> sublayout) where
|
||||
instance (KnownSymbol sym, ToParam (QueryFlag sym), HasDocs api)
|
||||
=> HasDocs (QueryFlag sym :> api) where
|
||||
|
||||
docsFor Proxy (endpoint, action) =
|
||||
docsFor sublayoutP (endpoint, action')
|
||||
docsFor subApiP (endpoint, action')
|
||||
|
||||
where sublayoutP = Proxy :: Proxy sublayout
|
||||
where subApiP = Proxy :: Proxy api
|
||||
paramP = Proxy :: Proxy (QueryFlag sym)
|
||||
action' = over params (|> toParam paramP) action
|
||||
|
||||
|
|
@ -785,49 +785,49 @@ instance HasDocs Raw where
|
|||
-- example data. However, there's no reason to believe that the instances of
|
||||
-- 'AllMimeUnrender' and 'AllMimeRender' actually agree (or to suppose that
|
||||
-- both are even defined) for any particular type.
|
||||
instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs sublayout)
|
||||
=> HasDocs (ReqBody (ct ': cts) a :> sublayout) where
|
||||
instance (ToSample a, AllMimeRender (ct ': cts) a, HasDocs api)
|
||||
=> HasDocs (ReqBody (ct ': cts) a :> api) where
|
||||
|
||||
docsFor Proxy (endpoint, action) =
|
||||
docsFor sublayoutP (endpoint, action')
|
||||
docsFor subApiP (endpoint, action')
|
||||
|
||||
where sublayoutP = Proxy :: Proxy sublayout
|
||||
where subApiP = Proxy :: Proxy api
|
||||
action' = action & rqbody .~ sampleByteString t p
|
||||
& rqtypes .~ allMime t
|
||||
t = Proxy :: Proxy (ct ': cts)
|
||||
p = Proxy :: Proxy a
|
||||
|
||||
instance (KnownSymbol path, HasDocs sublayout) => HasDocs (path :> sublayout) where
|
||||
instance (KnownSymbol path, HasDocs api) => HasDocs (path :> api) where
|
||||
|
||||
docsFor Proxy (endpoint, action) =
|
||||
docsFor sublayoutP (endpoint', action)
|
||||
docsFor subApiP (endpoint', action)
|
||||
|
||||
where sublayoutP = Proxy :: Proxy sublayout
|
||||
where subApiP = Proxy :: Proxy api
|
||||
endpoint' = endpoint & path <>~ [symbolVal pa]
|
||||
pa = Proxy :: Proxy path
|
||||
|
||||
instance HasDocs sublayout => HasDocs (RemoteHost :> sublayout) where
|
||||
instance HasDocs api => HasDocs (RemoteHost :> api) where
|
||||
docsFor Proxy ep =
|
||||
docsFor (Proxy :: Proxy sublayout) ep
|
||||
docsFor (Proxy :: Proxy api) ep
|
||||
|
||||
instance HasDocs sublayout => HasDocs (IsSecure :> sublayout) where
|
||||
instance HasDocs api => HasDocs (IsSecure :> api) where
|
||||
docsFor Proxy ep =
|
||||
docsFor (Proxy :: Proxy sublayout) ep
|
||||
docsFor (Proxy :: Proxy api) ep
|
||||
|
||||
instance HasDocs sublayout => HasDocs (HttpVersion :> sublayout) where
|
||||
instance HasDocs api => HasDocs (HttpVersion :> api) where
|
||||
docsFor Proxy ep =
|
||||
docsFor (Proxy :: Proxy sublayout) ep
|
||||
docsFor (Proxy :: Proxy api) ep
|
||||
|
||||
instance HasDocs sublayout => HasDocs (Vault :> sublayout) where
|
||||
instance HasDocs api => HasDocs (Vault :> api) where
|
||||
docsFor Proxy ep =
|
||||
docsFor (Proxy :: Proxy sublayout) ep
|
||||
docsFor (Proxy :: Proxy api) ep
|
||||
|
||||
instance HasDocs sublayout => HasDocs (WithNamedContext name context sublayout) where
|
||||
docsFor Proxy = docsFor (Proxy :: Proxy sublayout)
|
||||
instance HasDocs api => HasDocs (WithNamedContext name context api) where
|
||||
docsFor Proxy = docsFor (Proxy :: Proxy api)
|
||||
|
||||
instance (ToAuthInfo (BasicAuth realm usr), HasDocs sublayout) => HasDocs (BasicAuth realm usr :> sublayout) where
|
||||
instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth realm usr :> api) where
|
||||
docsFor Proxy (endpoint, action) =
|
||||
docsFor (Proxy :: Proxy sublayout) (endpoint, action')
|
||||
docsFor (Proxy :: Proxy api) (endpoint, action')
|
||||
where
|
||||
authProxy = Proxy :: Proxy (BasicAuth realm usr)
|
||||
action' = over authInfo (|> toAuthInfo authProxy) action
|
||||
|
|
|
|||
|
|
@ -29,12 +29,12 @@ instance ToJSON a => MimeRender PrettyJSON a where
|
|||
-- @
|
||||
-- 'docs' ('pretty' ('Proxy' :: 'Proxy' MyAPI))
|
||||
-- @
|
||||
pretty :: Proxy layout -> Proxy (Pretty layout)
|
||||
pretty :: Proxy api -> Proxy (Pretty api)
|
||||
pretty Proxy = Proxy
|
||||
|
||||
-- | Replace all JSON content types with PrettyJSON.
|
||||
-- Kind-polymorphic so it can operate on kinds @*@ and @[*]@.
|
||||
type family Pretty (layout :: k) :: k where
|
||||
type family Pretty (api :: k) :: k where
|
||||
Pretty (x :<|> y) = Pretty x :<|> Pretty y
|
||||
Pretty (x :> y) = Pretty x :> Pretty y
|
||||
Pretty (Get cs r) = Get (Pretty cs) r
|
||||
|
|
|
|||
|
|
@ -184,9 +184,9 @@ data NoTypes
|
|||
instance HasForeignType NoTypes () ftype where
|
||||
typeFor _ _ _ = ()
|
||||
|
||||
class HasForeign lang ftype (layout :: *) where
|
||||
type Foreign ftype layout :: *
|
||||
foreignFor :: Proxy lang -> Proxy ftype -> Proxy layout -> Req ftype -> Foreign ftype layout
|
||||
class HasForeign lang ftype (api :: *) where
|
||||
type Foreign ftype api :: *
|
||||
foreignFor :: Proxy lang -> Proxy ftype -> Proxy api -> Req ftype -> Foreign ftype api
|
||||
|
||||
instance (HasForeign lang ftype a, HasForeign lang ftype b)
|
||||
=> HasForeign lang ftype (a :<|> b) where
|
||||
|
|
@ -196,12 +196,12 @@ instance (HasForeign lang ftype a, HasForeign lang ftype b)
|
|||
foreignFor lang ftype (Proxy :: Proxy a) req
|
||||
:<|> foreignFor lang ftype (Proxy :: Proxy b) req
|
||||
|
||||
instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype sublayout)
|
||||
=> HasForeign lang ftype (Capture sym t :> sublayout) where
|
||||
type Foreign ftype (Capture sym a :> sublayout) = Foreign ftype sublayout
|
||||
instance (KnownSymbol sym, HasForeignType lang ftype t, HasForeign lang ftype api)
|
||||
=> HasForeign lang ftype (Capture sym t :> api) where
|
||||
type Foreign ftype (Capture sym a :> api) = Foreign ftype api
|
||||
|
||||
foreignFor lang Proxy Proxy req =
|
||||
foreignFor lang Proxy (Proxy :: Proxy sublayout) $
|
||||
foreignFor lang Proxy (Proxy :: Proxy api) $
|
||||
req & reqUrl . path <>~ [Segment (Cap arg)]
|
||||
& reqFuncName . _FunctionName %~ (++ ["by", str])
|
||||
where
|
||||
|
|
@ -224,9 +224,9 @@ instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)
|
|||
method = reflectMethod (Proxy :: Proxy method)
|
||||
methodLC = toLower $ decodeUtf8 method
|
||||
|
||||
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
|
||||
=> HasForeign lang ftype (Header sym a :> sublayout) where
|
||||
type Foreign ftype (Header sym a :> sublayout) = Foreign ftype sublayout
|
||||
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype api)
|
||||
=> HasForeign lang ftype (Header sym a :> api) where
|
||||
type Foreign ftype (Header sym a :> api) = Foreign ftype api
|
||||
|
||||
foreignFor lang Proxy Proxy req =
|
||||
foreignFor lang Proxy subP $ req & reqHeaders <>~ [HeaderArg arg]
|
||||
|
|
@ -235,14 +235,14 @@ instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype su
|
|||
arg = Arg
|
||||
{ _argName = PathSegment hname
|
||||
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
|
||||
subP = Proxy :: Proxy sublayout
|
||||
subP = Proxy :: Proxy api
|
||||
|
||||
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
|
||||
=> HasForeign lang ftype (QueryParam sym a :> sublayout) where
|
||||
type Foreign ftype (QueryParam sym a :> sublayout) = Foreign ftype sublayout
|
||||
instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype api)
|
||||
=> HasForeign lang ftype (QueryParam sym a :> api) where
|
||||
type Foreign ftype (QueryParam sym a :> api) = Foreign ftype api
|
||||
|
||||
foreignFor lang Proxy Proxy req =
|
||||
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
|
||||
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy api) $
|
||||
req & reqUrl.queryStr <>~ [QueryArg arg Normal]
|
||||
where
|
||||
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||
|
|
@ -251,11 +251,11 @@ instance (KnownSymbol sym, HasForeignType lang ftype a, HasForeign lang ftype su
|
|||
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) }
|
||||
|
||||
instance
|
||||
(KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype sublayout)
|
||||
=> HasForeign lang ftype (QueryParams sym a :> sublayout) where
|
||||
type Foreign ftype (QueryParams sym a :> sublayout) = Foreign ftype sublayout
|
||||
(KnownSymbol sym, HasForeignType lang ftype [a], HasForeign lang ftype api)
|
||||
=> HasForeign lang ftype (QueryParams sym a :> api) where
|
||||
type Foreign ftype (QueryParams sym a :> api) = Foreign ftype api
|
||||
foreignFor lang Proxy Proxy req =
|
||||
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy sublayout) $
|
||||
foreignFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy api) $
|
||||
req & reqUrl.queryStr <>~ [QueryArg arg List]
|
||||
where
|
||||
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||
|
|
@ -264,12 +264,12 @@ instance
|
|||
, _argType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy [a]) }
|
||||
|
||||
instance
|
||||
(KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype sublayout)
|
||||
=> HasForeign lang ftype (QueryFlag sym :> sublayout) where
|
||||
type Foreign ftype (QueryFlag sym :> sublayout) = Foreign ftype sublayout
|
||||
(KnownSymbol sym, HasForeignType lang ftype Bool, HasForeign lang ftype api)
|
||||
=> HasForeign lang ftype (QueryFlag sym :> api) where
|
||||
type Foreign ftype (QueryFlag sym :> api) = Foreign ftype api
|
||||
|
||||
foreignFor lang ftype Proxy req =
|
||||
foreignFor lang ftype (Proxy :: Proxy sublayout) $
|
||||
foreignFor lang ftype (Proxy :: Proxy api) $
|
||||
req & reqUrl.queryStr <>~ [QueryArg arg Flag]
|
||||
where
|
||||
str = pack . symbolVal $ (Proxy :: Proxy sym)
|
||||
|
|
@ -284,20 +284,20 @@ instance HasForeign lang ftype Raw where
|
|||
req & reqFuncName . _FunctionName %~ ((toLower $ decodeUtf8 method) :)
|
||||
& reqMethod .~ method
|
||||
|
||||
instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype sublayout)
|
||||
=> HasForeign lang ftype (ReqBody list a :> sublayout) where
|
||||
type Foreign ftype (ReqBody list a :> sublayout) = Foreign ftype sublayout
|
||||
instance (Elem JSON list, HasForeignType lang ftype a, HasForeign lang ftype api)
|
||||
=> HasForeign lang ftype (ReqBody list a :> api) where
|
||||
type Foreign ftype (ReqBody list a :> api) = Foreign ftype api
|
||||
|
||||
foreignFor lang ftype Proxy req =
|
||||
foreignFor lang ftype (Proxy :: Proxy sublayout) $
|
||||
foreignFor lang ftype (Proxy :: Proxy api) $
|
||||
req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a))
|
||||
|
||||
instance (KnownSymbol path, HasForeign lang ftype sublayout)
|
||||
=> HasForeign lang ftype (path :> sublayout) where
|
||||
type Foreign ftype (path :> sublayout) = Foreign ftype sublayout
|
||||
instance (KnownSymbol path, HasForeign lang ftype api)
|
||||
=> HasForeign lang ftype (path :> api) where
|
||||
type Foreign ftype (path :> api) = Foreign ftype api
|
||||
|
||||
foreignFor lang ftype Proxy req =
|
||||
foreignFor lang ftype (Proxy :: Proxy sublayout) $
|
||||
foreignFor lang ftype (Proxy :: Proxy api) $
|
||||
req & reqUrl . path <>~ [Segment (Static (PathSegment str))]
|
||||
& reqFuncName . _FunctionName %~ (++ [str])
|
||||
where
|
||||
|
|
@ -305,39 +305,39 @@ instance (KnownSymbol path, HasForeign lang ftype sublayout)
|
|||
Data.Text.map (\c -> if c == '.' then '_' else c)
|
||||
. pack . symbolVal $ (Proxy :: Proxy path)
|
||||
|
||||
instance HasForeign lang ftype sublayout
|
||||
=> HasForeign lang ftype (RemoteHost :> sublayout) where
|
||||
type Foreign ftype (RemoteHost :> sublayout) = Foreign ftype sublayout
|
||||
instance HasForeign lang ftype api
|
||||
=> HasForeign lang ftype (RemoteHost :> api) where
|
||||
type Foreign ftype (RemoteHost :> api) = Foreign ftype api
|
||||
|
||||
foreignFor lang ftype Proxy req =
|
||||
foreignFor lang ftype (Proxy :: Proxy sublayout) req
|
||||
foreignFor lang ftype (Proxy :: Proxy api) req
|
||||
|
||||
instance HasForeign lang ftype sublayout
|
||||
=> HasForeign lang ftype (IsSecure :> sublayout) where
|
||||
type Foreign ftype (IsSecure :> sublayout) = Foreign ftype sublayout
|
||||
instance HasForeign lang ftype api
|
||||
=> HasForeign lang ftype (IsSecure :> api) where
|
||||
type Foreign ftype (IsSecure :> api) = Foreign ftype api
|
||||
|
||||
foreignFor lang ftype Proxy req =
|
||||
foreignFor lang ftype (Proxy :: Proxy sublayout) req
|
||||
foreignFor lang ftype (Proxy :: Proxy api) req
|
||||
|
||||
instance HasForeign lang ftype sublayout => HasForeign lang ftype (Vault :> sublayout) where
|
||||
type Foreign ftype (Vault :> sublayout) = Foreign ftype sublayout
|
||||
instance HasForeign lang ftype api => HasForeign lang ftype (Vault :> api) where
|
||||
type Foreign ftype (Vault :> api) = Foreign ftype api
|
||||
|
||||
foreignFor lang ftype Proxy req =
|
||||
foreignFor lang ftype (Proxy :: Proxy sublayout) req
|
||||
foreignFor lang ftype (Proxy :: Proxy api) req
|
||||
|
||||
instance HasForeign lang ftype sublayout =>
|
||||
HasForeign lang ftype (WithNamedContext name context sublayout) where
|
||||
instance HasForeign lang ftype api =>
|
||||
HasForeign lang ftype (WithNamedContext name context api) where
|
||||
|
||||
type Foreign ftype (WithNamedContext name context sublayout) = Foreign ftype sublayout
|
||||
type Foreign ftype (WithNamedContext name context api) = Foreign ftype api
|
||||
|
||||
foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy sublayout)
|
||||
foreignFor lang ftype Proxy = foreignFor lang ftype (Proxy :: Proxy api)
|
||||
|
||||
instance HasForeign lang ftype sublayout
|
||||
=> HasForeign lang ftype (HttpVersion :> sublayout) where
|
||||
type Foreign ftype (HttpVersion :> sublayout) = Foreign ftype sublayout
|
||||
instance HasForeign lang ftype api
|
||||
=> HasForeign lang ftype (HttpVersion :> api) where
|
||||
type Foreign ftype (HttpVersion :> api) = Foreign ftype api
|
||||
|
||||
foreignFor lang ftype Proxy req =
|
||||
foreignFor lang ftype (Proxy :: Proxy sublayout) req
|
||||
foreignFor lang ftype (Proxy :: Proxy api) req
|
||||
|
||||
-- | Utility class used by 'listFromAPI' which computes
|
||||
-- the data needed to generate a function for each endpoint
|
||||
|
|
|
|||
|
|
@ -128,7 +128,7 @@ import Servant.Foreign (listFromAPI)
|
|||
-- | Generate the data necessary to generate javascript code
|
||||
-- for all the endpoints of an API, as ':<|>'-separated values
|
||||
-- of type 'AjaxReq'.
|
||||
javascript :: HasForeign NoTypes () layout => Proxy layout -> Foreign () layout
|
||||
javascript :: HasForeign NoTypes () api => Proxy api -> Foreign () api
|
||||
javascript p = foreignFor (Proxy :: Proxy NoTypes) (Proxy :: Proxy ()) p defReq
|
||||
|
||||
-- | Directly generate all the javascript functions for your API
|
||||
|
|
|
|||
|
|
@ -23,11 +23,11 @@ import Servant.JS.Internal
|
|||
-- using -- Basic, Digest, whatever.
|
||||
data Authorization (sym :: Symbol) a
|
||||
|
||||
instance (KnownSymbol sym, HasForeign lang () sublayout)
|
||||
=> HasForeign lang () (Authorization sym a :> sublayout) where
|
||||
type Foreign () (Authorization sym a :> sublayout) = Foreign () sublayout
|
||||
instance (KnownSymbol sym, HasForeign lang () api)
|
||||
=> HasForeign lang () (Authorization sym a :> api) where
|
||||
type Foreign () (Authorization sym a :> api) = Foreign () api
|
||||
|
||||
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
|
||||
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $
|
||||
req & reqHeaders <>~
|
||||
[ ReplaceHeaderArg (Arg "Authorization" ())
|
||||
$ tokenType (pack . symbolVal $ (Proxy :: Proxy sym)) ]
|
||||
|
|
@ -37,11 +37,11 @@ instance (KnownSymbol sym, HasForeign lang () sublayout)
|
|||
-- | This is a combinator that fetches an X-MyLovelyHorse header.
|
||||
data MyLovelyHorse a
|
||||
|
||||
instance (HasForeign lang () sublayout)
|
||||
=> HasForeign lang () (MyLovelyHorse a :> sublayout) where
|
||||
type Foreign () (MyLovelyHorse a :> sublayout) = Foreign () sublayout
|
||||
instance (HasForeign lang () api)
|
||||
=> HasForeign lang () (MyLovelyHorse a :> api) where
|
||||
type Foreign () (MyLovelyHorse a :> api) = Foreign () api
|
||||
|
||||
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
|
||||
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $
|
||||
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-MyLovelyHorse" ()) tpl ]
|
||||
where
|
||||
tpl = "I am good friends with {X-MyLovelyHorse}"
|
||||
|
|
@ -49,11 +49,11 @@ instance (HasForeign lang () sublayout)
|
|||
-- | This is a combinator that fetches an X-WhatsForDinner header.
|
||||
data WhatsForDinner a
|
||||
|
||||
instance (HasForeign lang () sublayout)
|
||||
=> HasForeign lang () (WhatsForDinner a :> sublayout) where
|
||||
type Foreign () (WhatsForDinner a :> sublayout) = Foreign () sublayout
|
||||
instance (HasForeign lang () api)
|
||||
=> HasForeign lang () (WhatsForDinner a :> api) where
|
||||
type Foreign () (WhatsForDinner a :> api) = Foreign () api
|
||||
|
||||
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy sublayout) $
|
||||
foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $
|
||||
req & reqHeaders <>~ [ ReplaceHeaderArg (Arg "X-WhatsForDinner" ()) tpl ]
|
||||
where
|
||||
tpl = "I would like {X-WhatsForDinner} with a cherry on top."
|
||||
|
|
|
|||
|
|
@ -130,11 +130,11 @@ import Servant.Utils.Enter
|
|||
-- > main :: IO ()
|
||||
-- > main = Network.Wai.Handler.Warp.run 8080 app
|
||||
--
|
||||
serve :: (HasServer layout '[]) => Proxy layout -> Server layout -> Application
|
||||
serve :: (HasServer api '[]) => Proxy api -> Server api -> Application
|
||||
serve p = serveWithContext p EmptyContext
|
||||
|
||||
serveWithContext :: (HasServer layout context)
|
||||
=> Proxy layout -> Context context -> Server layout -> Application
|
||||
serveWithContext :: (HasServer api context)
|
||||
=> Proxy api -> Context context -> Server api -> Application
|
||||
serveWithContext p context server =
|
||||
toApplication (runRouter (route p context (emptyDelayed (Route server))))
|
||||
|
||||
|
|
@ -189,12 +189,12 @@ serveWithContext p context server =
|
|||
-- that one takes precedence. If both parts fail, the \"better\" error
|
||||
-- code will be returned.
|
||||
--
|
||||
layout :: (HasServer layout '[]) => Proxy layout -> Text
|
||||
layout :: (HasServer api '[]) => Proxy api -> Text
|
||||
layout p = layoutWithContext p EmptyContext
|
||||
|
||||
-- | Variant of 'layout' that takes an additional 'Context'.
|
||||
layoutWithContext :: (HasServer layout context)
|
||||
=> Proxy layout -> Context context -> Text
|
||||
layoutWithContext :: (HasServer api context)
|
||||
=> Proxy api -> Context context -> Text
|
||||
layoutWithContext p context =
|
||||
routerLayout (route p context (emptyDelayed (FailFatal err501)))
|
||||
|
||||
|
|
|
|||
|
|
@ -68,16 +68,16 @@ import Servant.Server.Internal.RoutingApplication
|
|||
import Servant.Server.Internal.ServantErr
|
||||
|
||||
|
||||
class HasServer layout context where
|
||||
type ServerT layout (m :: * -> *) :: *
|
||||
class HasServer api context where
|
||||
type ServerT api (m :: * -> *) :: *
|
||||
|
||||
route ::
|
||||
Proxy layout
|
||||
Proxy api
|
||||
-> Context context
|
||||
-> Delayed env (Server layout)
|
||||
-> Delayed env (Server api)
|
||||
-> Router env
|
||||
|
||||
type Server layout = ServerT layout Handler
|
||||
type Server api = ServerT api Handler
|
||||
|
||||
-- * Instances
|
||||
|
||||
|
|
@ -118,15 +118,15 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont
|
|||
-- > server = getBook
|
||||
-- > where getBook :: Text -> Handler Book
|
||||
-- > getBook isbn = ...
|
||||
instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout context)
|
||||
=> HasServer (Capture capture a :> sublayout) context where
|
||||
instance (KnownSymbol capture, FromHttpApiData a, HasServer api context)
|
||||
=> HasServer (Capture capture a :> api) context where
|
||||
|
||||
type ServerT (Capture capture a :> sublayout) m =
|
||||
a -> ServerT sublayout m
|
||||
type ServerT (Capture capture a :> api) m =
|
||||
a -> ServerT api m
|
||||
|
||||
route Proxy context d =
|
||||
CaptureRouter $
|
||||
route (Proxy :: Proxy sublayout)
|
||||
route (Proxy :: Proxy api)
|
||||
context
|
||||
(addCapture d $ \ txt -> case parseUrlPieceMaybe txt :: Maybe a of
|
||||
Nothing -> delayedFail err400
|
||||
|
|
@ -236,15 +236,15 @@ instance OVERLAPPING_
|
|||
-- > server = viewReferer
|
||||
-- > where viewReferer :: Referer -> Handler referer
|
||||
-- > viewReferer referer = return referer
|
||||
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
|
||||
=> HasServer (Header sym a :> sublayout) context where
|
||||
instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)
|
||||
=> HasServer (Header sym a :> api) context where
|
||||
|
||||
type ServerT (Header sym a :> sublayout) m =
|
||||
Maybe a -> ServerT sublayout m
|
||||
type ServerT (Header sym a :> api) m =
|
||||
Maybe a -> ServerT api m
|
||||
|
||||
route Proxy context subserver =
|
||||
let mheader req = parseHeaderMaybe =<< lookup str (requestHeaders req)
|
||||
in route (Proxy :: Proxy sublayout) context (passToServer subserver mheader)
|
||||
in route (Proxy :: Proxy api) context (passToServer subserver mheader)
|
||||
where str = fromString $ symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
-- | If you use @'QueryParam' "author" Text@ in one of the endpoints for your API,
|
||||
|
|
@ -268,11 +268,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
|
|||
-- > where getBooksBy :: Maybe Text -> Handler [Book]
|
||||
-- > getBooksBy Nothing = ...return all books...
|
||||
-- > getBooksBy (Just author) = ...return books by the given author...
|
||||
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
|
||||
=> HasServer (QueryParam sym a :> sublayout) context where
|
||||
instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)
|
||||
=> HasServer (QueryParam sym a :> api) context where
|
||||
|
||||
type ServerT (QueryParam sym a :> sublayout) m =
|
||||
Maybe a -> ServerT sublayout m
|
||||
type ServerT (QueryParam sym a :> api) m =
|
||||
Maybe a -> ServerT api m
|
||||
|
||||
route Proxy context subserver =
|
||||
let querytext r = parseQueryText $ rawQueryString r
|
||||
|
|
@ -282,7 +282,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
|
|||
Just Nothing -> Nothing -- param present with no value -> Nothing
|
||||
Just (Just v) -> parseQueryParamMaybe v -- if present, we try to convert to
|
||||
-- the right type
|
||||
in route (Proxy :: Proxy sublayout) context (passToServer subserver param)
|
||||
in route (Proxy :: Proxy api) context (passToServer subserver param)
|
||||
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
|
||||
|
||||
-- | If you use @'QueryParams' "authors" Text@ in one of the endpoints for your API,
|
||||
|
|
@ -304,11 +304,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
|
|||
-- > server = getBooksBy
|
||||
-- > where getBooksBy :: [Text] -> Handler [Book]
|
||||
-- > getBooksBy authors = ...return all books by these authors...
|
||||
instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
|
||||
=> HasServer (QueryParams sym a :> sublayout) context where
|
||||
instance (KnownSymbol sym, FromHttpApiData a, HasServer api context)
|
||||
=> HasServer (QueryParams sym a :> api) context where
|
||||
|
||||
type ServerT (QueryParams sym a :> sublayout) m =
|
||||
[a] -> ServerT sublayout m
|
||||
type ServerT (QueryParams sym a :> api) m =
|
||||
[a] -> ServerT api m
|
||||
|
||||
route Proxy context subserver =
|
||||
let querytext r = parseQueryText $ rawQueryString r
|
||||
|
|
@ -317,7 +317,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
|
|||
-- corresponding values
|
||||
parameters r = filter looksLikeParam (querytext r)
|
||||
values r = mapMaybe (convert . snd) (parameters r)
|
||||
in route (Proxy :: Proxy sublayout) context (passToServer subserver values)
|
||||
in route (Proxy :: Proxy api) context (passToServer subserver values)
|
||||
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
|
||||
looksLikeParam (name, _) = name == paramname || name == (paramname <> "[]")
|
||||
convert Nothing = Nothing
|
||||
|
|
@ -335,11 +335,11 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)
|
|||
-- > server = getBooks
|
||||
-- > where getBooks :: Bool -> Handler [Book]
|
||||
-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...
|
||||
instance (KnownSymbol sym, HasServer sublayout context)
|
||||
=> HasServer (QueryFlag sym :> sublayout) context where
|
||||
instance (KnownSymbol sym, HasServer api context)
|
||||
=> HasServer (QueryFlag sym :> api) context where
|
||||
|
||||
type ServerT (QueryFlag sym :> sublayout) m =
|
||||
Bool -> ServerT sublayout m
|
||||
type ServerT (QueryFlag sym :> api) m =
|
||||
Bool -> ServerT api m
|
||||
|
||||
route Proxy context subserver =
|
||||
let querytext r = parseQueryText $ rawQueryString r
|
||||
|
|
@ -347,7 +347,7 @@ instance (KnownSymbol sym, HasServer sublayout context)
|
|||
Just Nothing -> True -- param is there, with no value
|
||||
Just (Just v) -> examine v -- param with a value
|
||||
Nothing -> False -- param not in the query string
|
||||
in route (Proxy :: Proxy sublayout) context (passToServer subserver param)
|
||||
in route (Proxy :: Proxy api) context (passToServer subserver param)
|
||||
where paramname = cs $ symbolVal (Proxy :: Proxy sym)
|
||||
examine v | v == "true" || v == "1" || v == "" = True
|
||||
| otherwise = False
|
||||
|
|
@ -392,14 +392,14 @@ instance HasServer Raw context where
|
|||
-- > server = postBook
|
||||
-- > where postBook :: Book -> Handler Book
|
||||
-- > postBook book = ...insert into your db...
|
||||
instance ( AllCTUnrender list a, HasServer sublayout context
|
||||
) => HasServer (ReqBody list a :> sublayout) context where
|
||||
instance ( AllCTUnrender list a, HasServer api context
|
||||
) => HasServer (ReqBody list a :> api) context where
|
||||
|
||||
type ServerT (ReqBody list a :> sublayout) m =
|
||||
a -> ServerT sublayout m
|
||||
type ServerT (ReqBody list a :> api) m =
|
||||
a -> ServerT api m
|
||||
|
||||
route Proxy context subserver =
|
||||
route (Proxy :: Proxy sublayout) context (addBodyCheck subserver bodyCheck)
|
||||
route (Proxy :: Proxy api) context (addBodyCheck subserver bodyCheck)
|
||||
where
|
||||
bodyCheck = withRequest $ \ request -> do
|
||||
-- See HTTP RFC 2616, section 7.2.1
|
||||
|
|
@ -416,15 +416,15 @@ instance ( AllCTUnrender list a, HasServer sublayout context
|
|||
Just (Right v) -> return v
|
||||
|
||||
-- | Make sure the incoming request starts with @"/path"@, strip it and
|
||||
-- pass the rest of the request path to @sublayout@.
|
||||
instance (KnownSymbol path, HasServer sublayout context) => HasServer (path :> sublayout) context where
|
||||
-- pass the rest of the request path to @api@.
|
||||
instance (KnownSymbol path, HasServer api context) => HasServer (path :> api) context where
|
||||
|
||||
type ServerT (path :> sublayout) m = ServerT sublayout m
|
||||
type ServerT (path :> api) m = ServerT api m
|
||||
|
||||
route Proxy context subserver =
|
||||
pathRouter
|
||||
(cs (symbolVal proxyPath))
|
||||
(route (Proxy :: Proxy sublayout) context subserver)
|
||||
(route (Proxy :: Proxy api) context subserver)
|
||||
where proxyPath = Proxy :: Proxy path
|
||||
|
||||
instance HasServer api context => HasServer (RemoteHost :> api) context where
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user