@@ -1,14 +1,18 @@
11{-# LANGUAGE AllowAmbiguousTypes #-}
22{-# LANGUAGE CPP #-}
33{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE DefaultSignatures #-}
5+{-# LANGUAGE ExtendedDefaultRules #-}
46{-# LANGUAGE FlexibleContexts #-}
57{-# LANGUAGE FlexibleInstances #-}
8+{-# LANGUAGE FunctionalDependencies #-}
69{-# LANGUAGE GeneralizedNewtypeDeriving #-}
710{-# LANGUAGE InstanceSigs #-}
11+{-# LANGUAGE LambdaCase #-}
812{-# LANGUAGE MultiParamTypeClasses #-}
913{-# LANGUAGE OverloadedStrings #-}
1014{-# LANGUAGE PolyKinds #-}
11−{-# LANGUAGE Rank2Types #-}
15+{-# LANGUAGE RecordWildCards #-}
1216{-# LANGUAGE ScopedTypeVariables #-}
1317{-# LANGUAGE TupleSections #-}
1418{-# LANGUAGE TypeFamilies #-}
@@ -26,10 +30,9 @@
2630module Servant.Reflex
2731 ( client
2832 , clientWithOpts
29− , clientWithOptsAndResultHandler
3033 , clientWithRoute
31− , clientWithRouteAndResultHandler
3234 , BuildHeaderKeysTo(..)
35+ , GHCJS'MimeRender(..)
3336 , toHeaders
3437 , HasClient
3538 , Client
@@ -39,56 +42,101 @@ module Servant.Reflex
3942
4043------------------------------------------------------------------------------
4144import Control.Applicative
42−import qualified Data.CaseInsensitive as CI
45+import qualified Data.ByteString as BS
46+import qualified Data.ByteString.Lazy as BL
47+import Data.CaseInsensitive (mk)
4348import Data.Functor.Identity
44−import qualified Data.Map as Map
45−import Data.Monoid ((<>))
46−import Data.Proxy (Proxy (..))
47−import qualified Data.Set as Set
48−import Data.Text (Text)
49−import qualified Data.Text as T
50−import qualified Data.Text.Encoding as E
51−import GHC.Exts (Constraint)
52−import GHC.TypeLits (KnownSymbol, symbolVal)
53−import Servant.API ((:<|>) (..), (:>), BasicAuth,
54− BasicAuthData, BuildHeadersTo (..),
55− Capture, Header, Headers (..),
56− HttpVersion, IsSecure,
57− MimeRender (..), MimeUnrender,
58− NoContent, QueryFlag, QueryParam,
59− QueryParams, Raw, ReflectMethod (..),
60− RemoteHost, ReqBody,
61− ToHttpApiData (..), Vault, Verb,
62− contentType)
63−import Servant.API.Description (Summary)
64−import qualified Servant.Auth as Auth
65−
66−import Reflex.Dom.Core (Dynamic, Event, Reflex,
67− XhrRequest (..), XhrResponse (..),
68− XhrResponseHeaders (..),
69− attachPromptlyDynWith, constDyn, ffor,
70− fmapMaybe, leftmost,
71− performRequestsAsync)
49+import Data.Kind (Type)
50+import qualified Data.Map as Map
51+import Data.Monoid ((<>))
52+import Data.Proxy (Proxy (..))
53+import qualified Data.Set as Set
54+import Data.Text (Text)
55+import qualified Data.Text as T
56+import qualified Data.Text.Encoding as E
57+import qualified Data.Text.Lazy as TL
58+import GHC.Exts (Constraint)
59+import GHC.TypeLits (KnownSymbol,
60+ symbolVal)
61+import GHCJS.DOM.Types (Blob)
62+import Servant.API ((:<|>) (..),
63+ (:>),
64+ Accept (..),
65+ BasicAuth,
66+ BasicAuthData,
67+ BuildHeadersTo (..),
68+ Capture,
69+ FormUrlEncoded,
70+ Header,
71+ Headers (..),
72+ HttpVersion,
73+ IsSecure,
74+ JSON,
75+ MimeRender (..),
76+ NoContent,
77+ OctetStream,
78+ PlainText,
79+ QueryFlag,
80+ QueryParam,
81+ QueryParams,
82+ Raw,
83+ ReflectMethod (..),
84+ RemoteHost,
85+ ReqBody,
86+ ToHttpApiData (..),
87+ Vault, Verb,
88+ contentType)
89+import qualified Servant.Auth as Auth
90+
91+import Reflex.Dom.Core (Dynamic,
92+ Event,
93+ IsXhrPayload,
94+ Reflex,
95+ XhrRequest (..),
96+ XhrResponse (..),
97+ XhrResponseHeaders (..),
98+ attachPromptlyDynWith,
99+ constDyn,
100+ ffor,
101+ fmapMaybe,
102+ leftmost,
103+ performRequestsAsync)
72104------------------------------------------------------------------------------
73−import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
74− showBaseUrl,
75− SupportsServantReflex)
76−import Servant.Common.Req (ClientOptions(..),
77− defaultClientOptions,
78− Req, ReqResult(..), QParam(..),
79− QueryPart(..), addHeader, authData,
80− defReq, evalResponse, prependToPathParts,
81− -- performRequestCT,
82− performRequestsCT,
83− -- performRequestNoBody,
84− performRequestsNoBody,
85− performSomeRequestsAsync,
86− qParamToQueryPart, reqBody,
87− reqSuccess, reqFailure,
88− reqMethod, respHeaders,
89− response,
90− reqTag,
91− qParams, withCredentials)
105+import Servant.Checked.Exceptions.Internal.Envelope (Envelope)
106+import Servant.Checked.Exceptions.Internal.Servant.API (NoThrow,
107+ Throwing,
108+ ThrowingNonterminal,
109+ Throws)
110+import Servant.Common.BaseUrl (BaseUrl (..),
111+ Scheme (..),
112+ SupportsServantReflex,
113+ baseUrlWidget,
114+ showBaseUrl)
115+import Servant.Common.Req (ClientOptions (..),
116+ MimeUnrender (..),
117+ QParam (..),
118+ QueryPart (..),
119+ Req (..),
120+ ReqResult (..),
121+ addHeader,
122+ authData,
123+ defReq,
124+ defaultClientOptions,
125+ evalResponse,
126+ performRequestsCT,
127+ performRequestsNoBody,
128+ performSomeRequestsAsync,
129+ prependToPathParts,
130+ qParamToQueryPart,
131+ qParams,
132+ reqBody,
133+ reqFailure,
134+ reqMethod,
135+ reqSuccess,
136+ reqTag,
137+ respHeaders,
138+ response,
139+ withCredentials)
92140
93141
94142-- * Accessing APIs as a Client
@@ -103,7 +151,7 @@ import Servant.Common.Req (ClientOptions(..),
103151-- >
104152-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))
105153-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l
106−-- > -> m (Event t (l, ReqResult Book)))
154+-- -> m (Event t (l, ReqResult Book)))
107155-- > (getAllBooks :<|> postNewBook) = client myApi host
108156-- > where host = constDyn $ BaseUrl Http "localhost" 8080
109157client
@@ -125,53 +173,21 @@ clientWithOpts
125173 -> Client t m layout tag
126174clientWithOpts p q t baseurl = clientWithRoute p q t defReq baseurl
127175
128−-- | Like 'clientWithOpts' but allows passing a function which will process the
129−-- result event in some way. This can be used to handle errors in a uniform way
130−-- across call sites.
131−clientWithOptsAndResultHandler
132− :: (HasClient t m layout tag)
133− => Proxy layout
134− -> Proxy m
135− -> Proxy tag
136− -> Dynamic t BaseUrl
137− -> ClientOptions
138− -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))
139− -> Client t m layout tag
140−clientWithOptsAndResultHandler p q t = clientWithRouteAndResultHandler p q t defReq
141−
142176
143177-- | This class lets us define how each API combinator
144178-- influences the creation of an HTTP request. It's mostly
145179-- an internal class, you can just use 'client'.
146−class Monad m => HasClient t m layout (tag :: *) where
147− type Client t m layout tag :: *
148− clientWithRoute
149− :: Proxy layout
150− -> Proxy m
151− -> Proxy tag
152− -> Req t
153− -> Dynamic t BaseUrl
154− -> ClientOptions
155− -> Client t m layout tag
156− clientWithRoute l m t r b o = clientWithRouteAndResultHandler l m t r b o return
157−
158− clientWithRouteAndResultHandler
159− :: Proxy layout
160− -> Proxy m
161− -> Proxy tag
162− -> Req t
163− -> Dynamic t BaseUrl
164− -> ClientOptions
165− -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))
166− -> Client t m layout tag
180+class HasClient t m layout (tag :: Type) where
181+ type Client t m layout tag :: Type
182+ clientWithRoute :: Proxy layout -> Proxy m -> Proxy tag -> Req t -> Dynamic t BaseUrl -> ClientOptions -> Client t m layout tag
167183
168184
169185instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b) tag where
170186 type Client t m (a :<|> b) tag = Client t m a tag :<|> Client t m b tag
171187
172− clientWithRouteAndResultHandler Proxy q pTag req baseurl opts wrap =
173− clientWithRouteAndResultHandler (Proxy :: Proxy a) q pTag req baseurl opts wrap :<|>
174− clientWithRouteAndResultHandler (Proxy :: Proxy b) q pTag req baseurl opts wrap
188+ clientWithRoute Proxy q pTag req baseurl opts =
189+ clientWithRoute (Proxy :: Proxy a) q pTag req baseurl opts :<|>
190+ clientWithRoute (Proxy :: Proxy b) q pTag req baseurl opts
175191
176192
177193-- Capture. Example:
@@ -192,9 +208,11 @@ instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout ta
192208 type Client t m (Capture capture a :> sublayout) tag =
193209 Dynamic t (Either Text a) -> Client t m sublayout tag
194210
195− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap val =
196− clientWithRouteAndResultHandler
197− (Proxy :: Proxy sublayout) q t (prependToPathParts p req) baseurl opts wrap
211+ clientWithRoute Proxy q t req baseurl opts val =
212+ clientWithRoute (Proxy :: Proxy sublayout)
213+ q t
214+ (prependToPathParts p req)
215+ baseurl opts
198216 where p = (fmap . fmap) (toUrlPiece) val
199217
200218
@@ -207,8 +225,8 @@ instance {-# OVERLAPPABLE #-}
207225 Event t tag -> m (Event t (ReqResult tag a))
208226 -- TODO how to access input types here?
209227 -- ExceptT ServantError IO a
210− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =
211− wrap =<< fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl opts trigs
228+ clientWithRoute Proxy _ _ req baseurl opts trigs =
229+ fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl opts trigs
212230 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
213231 req' = req { reqMethod = method }
214232
@@ -221,33 +239,29 @@ instance {-# OVERLAPPING #-}
221239 Event t tag -> m (Event t (ReqResult tag NoContent))
222240 -- TODO: how to access input types here?
223241 -- ExceptT ServantError IO NoContent
224− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs =
225− wrap =<< fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req) baseurl opts trigs
242+ clientWithRoute Proxy _ _ req baseurl opts =
243+ (fmap . fmap) runIdentity . performRequestsNoBody method (constDyn $ Identity req) baseurl opts
226244 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
227245
228246
229247toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a)
230248toHeaders r =
231− let hdrs = maybe []
232− (\xhr -> fmap (\(h,v) -> (CI.map E.encodeUtf8 h, E.encodeUtf8 v))
249+ let toBS = E.encodeUtf8
250+ hdrs = maybe []
251+ (\xhr -> fmap (\(h,v) -> (mk (toBS h), toBS v))
233252 (Map.toList $ _xhrResponse_headers xhr))
234253 (response r)
235254 in ffor r $ \a -> Headers {getResponse = a ,getHeadersHList = buildHeadersTo hdrs}
236255
237−
238256class BuildHeaderKeysTo hs where
239− buildHeaderKeysTo :: Proxy hs -> [CI.CI T.Text]
257+ buildHeaderKeysTo :: Proxy hs -> [T.Text]
240258
241259instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[]
242260 where buildHeaderKeysTo _ = []
243261
244262instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)
245263 => BuildHeaderKeysTo ((Header h v) ': xs) where
246− buildHeaderKeysTo _ =
247− let
248− thisKey = CI.mk $ T.pack (symbolVal (Proxy :: Proxy h))
249− in thisKey : buildHeaderKeysTo (Proxy :: Proxy xs)
250−
264+ buildHeaderKeysTo _ = T.pack (symbolVal (Proxy :: Proxy h)) : buildHeaderKeysTo (Proxy :: Proxy xs)
251265
252266-- HEADERS Verb (Content) --
253267-- Headers combinator not treated in fully general case,
@@ -262,10 +276,10 @@ instance {-# OVERLAPPABLE #-}
262276 ) => HasClient t m (Verb method status cts' (Headers ls a)) tag where
263277 type Client t m (Verb method status cts' (Headers ls a)) tag =
264278 Event t tag -> m (Event t (ReqResult tag (Headers ls a)))
265− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do
279+ clientWithRoute Proxy _ _ req baseurl opts trigs = do
266280 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
267281 resp <- fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl opts trigs
268− wrap $ toHeaders <$> resp
282+ return $ toHeaders <$> resp
269283 where req' = req { respHeaders =
270284 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
271285 }
@@ -278,10 +292,10 @@ instance {-# OVERLAPPABLE #-}
278292 ) => HasClient t m (Verb method status cts (Headers ls NoContent)) tag where
279293 type Client t m (Verb method status cts (Headers ls NoContent)) tag
280294 = Event t tag -> m (Event t (ReqResult tag (Headers ls NoContent)))
281− clientWithRouteAndResultHandler Proxy _ _ req baseurl opts wrap trigs = do
295+ clientWithRoute Proxy _ _ req baseurl opts trigs = do
282296 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
283297 resp <- fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req') baseurl opts trigs
284− wrap $ toHeaders <$> resp
298+ return $ toHeaders <$> resp
285299 where req' = req {respHeaders =
286300 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
287301 }
@@ -308,11 +322,11 @@ instance (KnownSymbol sym, ToHttpApiData a,
308322 type Client t m (Header sym a :> sublayout) tag =
309323 Dynamic t (Either Text a) -> Client t m sublayout tag
310324
311− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap eVal =
312− clientWithRouteAndResultHandler
313− (Proxy :: Proxy sublayout) q t
314− (Servant.Common.Req.addHeader hname eVal req)
315− baseurl opts wrap
325+ clientWithRoute Proxy q t req baseurl opts eVal =
326+ clientWithRoute (Proxy :: Proxy sublayout)
327+ q t
328+ (Servant.Common.Req.addHeader hname eVal req)
329+ baseurl opts
316330 where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
317331
318332
@@ -326,21 +340,8 @@ instance HasClient t m sublayout tag
326340 type Client t m (HttpVersion :> sublayout) tag =
327341 Client t m sublayout tag
328342
329− clientWithRouteAndResultHandler Proxy =
330− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)
331−
332−-- | Using a 'Summary' combinator in your API doesn't affect the client
333−-- functions.
334−instance (HasClient t m sublayout tag, KnownSymbol sym)
335− => HasClient t m (Summary sym :> sublayout) tag where
336−
337− type Client t m (Summary sym :> sublayout) tag =
338− Client t m sublayout tag
339−
340− clientWithRouteAndResultHandler Proxy =
341− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)
342−
343−
343+ clientWithRoute Proxy q t =
344+ clientWithRoute (Proxy :: Proxy sublayout) q t
344345
345346
346347-- | If you use a 'QueryParam' in one of your endpoints in your API,
@@ -376,9 +377,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex
376377 Dynamic t (QParam a) -> Client t m sublayout tag
377378
378379 -- if mparam = Nothing, we don't add it to the query string
379− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap mparam =
380− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t
381− (req {qParams = paramPair : qParams req}) baseurl opts wrap
380+ clientWithRoute Proxy q t req baseurl opts mparam =
381+ clientWithRoute (Proxy :: Proxy sublayout) q t
382+ (req {qParams = paramPair : qParams req}) baseurl opts
382383
383384 where pname = symbolVal (Proxy :: Proxy sym)
384385 --p prm = QueryPartParam $ (fmap . fmap) (toQueryParam) prm
@@ -422,8 +423,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex
422423 type Client t m (QueryParams sym a :> sublayout) tag =
423424 Dynamic t [a] -> Client t m sublayout tag
424425
425− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap paramlist =
426− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap
426+ clientWithRoute Proxy q t req baseurl opts paramlist =
427+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts
427428
428429 where req' = req { qParams = (T.pack pname, params') : qParams req }
429430 pname = symbolVal (Proxy :: Proxy sym)
@@ -462,8 +463,8 @@ instance (KnownSymbol sym, HasClient t m sublayout tag, Reflex t)
462463 type Client t m (QueryFlag sym :> sublayout) tag =
463464 Dynamic t Bool -> Client t m sublayout tag
464465
465− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap flag =
466− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap
466+ clientWithRoute Proxy q t req baseurl opts flag =
467+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts
467468
468469 where req' = req { qParams = thisPair : qParams req }
469470 thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)
@@ -477,7 +478,7 @@ instance SupportsServantReflex t m => HasClient t m Raw tag where
477478 -> Event t tag
478479 -> m (Event t (ReqResult tag ()))
479480
480− clientWithRouteAndResultHandler _ _ _ _ baseurl _ wrap xhrs triggers = do
481+ clientWithRoute _ _ _ _ baseurl _ xhrs triggers = do
481482
482483 let xhrs' = liftA2 (\x path -> case x of
483484 Left e -> Left e
@@ -488,7 +489,7 @@ instance SupportsServantReflex t m => HasClient t m Raw tag where
488489 okReq = fmapMaybe (\(t,x) -> either (const Nothing) (Just . (t,)) x) xhrs'' :: Event t (tag, XhrRequest ())
489490
490491 resps <- performRequestsAsync okReq
491− wrap $ leftmost [ uncurry RequestFailure <$> badReq
492+ return $ leftmost [ uncurry RequestFailure <$> badReq
492493 , evalResponse (const $ Right ()) <$> resps
493494 ]
494495
@@ -513,30 +514,73 @@ instance SupportsServantReflex t m => HasClient t m Raw tag where
513514-- > where host = BaseUrl Http "localhost" 8080
514515-- > -- then you can just use "addBook" to query that endpoint
515516
516−instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
517− => HasClient t m (ReqBody (ct ': cts) a :> sublayout) tag where
517+instance (GHCJS'MimeRender ct a, IsXhrPayload (ToSend ct a), Show (ToSend ct a),
518+ HasClient t m sublayout tag, Reflex t)
519+ => HasClient t m (ReqBody (ct ': cts) (a :: Type) :> sublayout) tag where
518520
519521 type Client t m (ReqBody (ct ': cts) a :> sublayout) tag =
520− Dynamic t (Either Text a) -> Client t m sublayout tag
522+ Dynamic t (Either Text (ToConvert ct a)) -> Client t m sublayout tag
521523
522− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap body =
523− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t req' baseurl opts wrap
524− where req' = req { reqBody = bodyBytesCT }
524+ clientWithRoute Proxy q t Req{..} baseurl opts body =
525+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl opts
526+ where req' = Req { reqBody = Just $ (fmap . fmap)
527+ (\b -> (ghcjsMimeRender ctProxy atProxy b, ctString)) body
528+ , ..}
525529 ctProxy = Proxy :: Proxy ct
530+ atProxy = Proxy :: Proxy a
526531 ctString = T.pack $ show $ contentType ctProxy
527− bodyBytesCT = Just $ (fmap . fmap)
528− (\b -> (mimeRender ctProxy b, ctString))
529− body
530532
533+class Accept ctype => GHCJS'MimeRender (ctype :: Type) (a :: Type) where
534+ type ToConvert ctype a :: Type
535+ type ToConvert ctype a = a
536+
537+ type ToSend ctype a :: Type
538+ type ToSend ctype a = BS.ByteString
539+
540+ ghcjsMimeRender
541+ :: IsXhrPayload (ToSend ctype a)
542+ => Proxy ctype -> Proxy a -> ToConvert ctype a -> ToSend ctype a
543+ default ghcjsMimeRender
544+ :: (MimeRender ctype a,
545+ MimeRender ctype (ToConvert ctype a), ToSend ctype a ~ BS.ByteString)
546+ => Proxy ctype -> Proxy a -> ToConvert ctype a -> ToSend ctype a
547+ ghcjsMimeRender ctype _ = BL.toStrict . mimeRender ctype
548+
549+instance MimeRender JSON x => GHCJS'MimeRender JSON x
550+
551+instance MimeRender FormUrlEncoded x => GHCJS'MimeRender FormUrlEncoded x
552+
553+instance GHCJS'MimeRender OctetStream BL.ByteString where
554+ type ToConvert OctetStream BL.ByteString = Either BL.ByteString Blob
555+ type ToSend OctetStream BL.ByteString = Either BS.ByteString Blob
556+ ghcjsMimeRender _ _ = \case Left bl -> Left $ BL.toStrict bl; Right x -> Right x
557+
558+instance GHCJS'MimeRender PlainText String where
559+ type ToSend PlainText String = Text
560+ ghcjsMimeRender _ _ = T.pack
561+
562+instance GHCJS'MimeRender PlainText Text where
563+ type ToSend PlainText Text = Text
564+ ghcjsMimeRender _ _ = id
565+
566+instance GHCJS'MimeRender PlainText TL.Text where
567+ type ToSend PlainText TL.Text = Text
568+ ghcjsMimeRender _ _ = TL.toStrict
531569
570+instance GHCJS'MimeRender PlainText BL.ByteString where
571+ type ToSend PlainText BL.ByteString = BS.ByteString
572+ ghcjsMimeRender _ _ = BL.toStrict
573+
574+instance GHCJS'MimeRender PlainText BS.ByteString where
575+ ghcjsMimeRender _ _ = id
532576
533577-- | Make the querying function append @path@ to the request path.
534578instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where
535579 type Client t m (path :> sublayout) tag = Client t m sublayout tag
536580
537− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap =
538− clientWithRouteAndResultHandler (Proxy :: Proxy sublayout) q t
539− (prependToPathParts (pure (Right $ T.pack p)) req) baseurl opts wrap
581+ clientWithRoute Proxy q t req baseurl opts =
582+ clientWithRoute (Proxy :: Proxy sublayout) q t
583+ (prependToPathParts (pure (Right $ T.pack p)) req) baseurl opts
540584
541585 where p = symbolVal (Proxy :: Proxy path)
542586
@@ -544,23 +588,23 @@ instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient
544588instance HasClient t m api tag => HasClient t m (Vault :> api) tag where
545589 type Client t m (Vault :> api) tag = Client t m api tag
546590
547− clientWithRouteAndResultHandler Proxy =
548− clientWithRouteAndResultHandler (Proxy :: Proxy api)
591+ clientWithRoute Proxy q t req baseurl =
592+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
549593
550594
551595instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where
552596 type Client t m (RemoteHost :> api) tag = Client t m api tag
553597
554− clientWithRouteAndResultHandler Proxy =
555− clientWithRouteAndResultHandler (Proxy :: Proxy api)
598+ clientWithRoute Proxy q t req baseurl =
599+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
556600
557601
558602
559603instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where
560604 type Client t m (IsSecure :> api) tag = Client t m api tag
561605
562− clientWithRouteAndResultHandler Proxy =
563− clientWithRouteAndResultHandler (Proxy :: Proxy api)
606+ clientWithRoute Proxy q t req baseurl =
607+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
564608
565609
566610instance (HasClient t m api tag, Reflex t)
@@ -569,8 +613,8 @@ instance (HasClient t m api tag, Reflex t)
569613 type Client t m (BasicAuth realm usr :> api) tag = Dynamic t (Maybe BasicAuthData)
570614 -> Client t m api tag
571615
572− clientWithRouteAndResultHandler Proxy q t req baseurl opts wrap authdata =
573− clientWithRouteAndResultHandler (Proxy :: Proxy api) q t req' baseurl opts wrap
616+ clientWithRoute Proxy q t req baseurl opts authdata =
617+ clientWithRoute (Proxy :: Proxy api) q t req' baseurl opts
574618 where
575619 req' = req { authData = Just authdata }
576620
@@ -613,7 +657,7 @@ for empty and one for non-empty lists).
613657instance (HasCookieAuth auths, HasClient t m api tag) => HasClient t m (Auth.Auth auths a :> api) tag where
614658
615659 type Client t m (Auth.Auth auths a :> api) tag = Client t m api tag
616− clientWithRouteAndResultHandler Proxy = clientWithRouteAndResultHandler (Proxy :: Proxy api)
660+ clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy api)
617661
618662
619663type family HasCookieAuth xs :: Constraint where
@@ -623,3 +667,135 @@ type family HasCookieAuth xs :: Constraint where
623667
624668class CookieAuthNotEnabled
625669
670+{- servant-checked-exceptions
671+~~~~~~~~~~~~~~~~~~~~~
672+-}
673+
674+-- | Change a 'Throws' into 'Throwing'.
675+instance (HasClient t m (Throwing '[e] :> api) tag) => HasClient t m (Throws e :> api) tag where
676+ type Client t m (Throws e :> api) tag = Client t m (Throwing '[e] :> api) tag
677+
678+ clientWithRoute
679+ :: Proxy (Throws e :> api)
680+ -> Proxy m
681+ -> Proxy tag
682+ -> Req t
683+ -> Dynamic t BaseUrl
684+ -> ClientOptions
685+ -> Client t m (Throwing '[e] :> api) tag
686+ clientWithRoute _ = clientWithRoute (Proxy :: Proxy (Throwing '[e] :> api))
687+
688+-- | When @'Throwing' es@ comes before a 'Verb', change it into the same 'Verb'
689+-- but returning an @'Envelope' es@.
690+instance (HasClient t m (Verb method status ctypes (Envelope es a)) tag) =>
691+ HasClient t m (Throwing es :> Verb method status ctypes a) tag where
692+
693+ type Client t m (Throwing es :> Verb method status ctypes a) tag =
694+ Client t m (Verb method status ctypes (Envelope es a)) tag
695+
696+ clientWithRoute
697+ :: Proxy (Throwing es :> Verb method status ctypes a)
698+ -> Proxy m
699+ -> Proxy tag
700+ -> Req t
701+ -> Dynamic t BaseUrl
702+ -> ClientOptions
703+ -> Client t m (Verb method status ctypes (Envelope es a)) tag
704+ clientWithRoute Proxy =
705+ clientWithRoute (Proxy :: Proxy (Verb method status ctypes (Envelope es a)))
706+
707+-- | When 'NoThrow' comes before a 'Verb', change it into the same 'Verb'
708+-- but returning an @'Envelope' \'[]@.
709+instance (HasClient t m (Verb method status ctypes (Envelope '[] a)) tag) =>
710+ HasClient t m (NoThrow :> Verb method status ctypes a) tag where
711+
712+ type Client t m (NoThrow :> Verb method status ctypes a) tag =
713+ Client t m (Verb method status ctypes (Envelope '[] a)) tag
714+
715+ clientWithRoute
716+ :: Proxy (NoThrow :> Verb method status ctypes a)
717+ -> Proxy m
718+ -> Proxy tag
719+ -> Req t
720+ -> Dynamic t BaseUrl
721+ -> ClientOptions
722+ -> Client t m (Verb method status ctypes (Envelope '[] a)) tag
723+ clientWithRoute Proxy =
724+ clientWithRoute (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a)))
725+
726+-- | When @'Throwing' es@ comes before ':<|>', push @'Throwing' es@ into each
727+-- branch of the API.
728+instance HasClient t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag =>
729+ HasClient t m (Throwing es :> (api1 :<|> api2)) tag where
730+
731+ type Client t m (Throwing es :> (api1 :<|> api2)) tag =
732+ Client t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag
733+
734+ clientWithRoute
735+ :: Proxy (Throwing es :> (api1 :<|> api2))
736+ -> Proxy m
737+ -> Proxy tag
738+ -> Req t
739+ -> Dynamic t BaseUrl
740+ -> ClientOptions
741+ -> Client t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag
742+ clientWithRoute _ =
743+ clientWithRoute (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))
744+
745+-- | When 'NoThrow' comes before ':<|>', push 'NoThrow' into each branch of the
746+-- API.
747+instance HasClient t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag =>
748+ HasClient t m (NoThrow :> (api1 :<|> api2)) tag where
749+
750+ type Client t m (NoThrow :> (api1 :<|> api2)) tag =
751+ Client t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag
752+
753+ clientWithRoute
754+ :: Proxy (NoThrow :> (api1 :<|> api2))
755+ -> Proxy m
756+ -> Proxy tag
757+ -> Req t
758+ -> Dynamic t BaseUrl
759+ -> ClientOptions
760+ -> Client t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag
761+ clientWithRoute _ =
762+ clientWithRoute (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2)))
763+
764+-- | When a @'Throws' e@ comes immediately after a @'Throwing' es@, 'Snoc' the
765+-- @e@ onto the @es@. Otherwise, if @'Throws' e@ comes before any other
766+-- combinator, push it down so it is closer to the 'Verb'.
767+instance HasClient t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag =>
768+ HasClient t m (Throwing es :> api :> apis) tag where
769+
770+ type Client t m (Throwing es :> api :> apis) tag =
771+ Client t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag
772+
773+ clientWithRoute
774+ :: Proxy (Throwing es :> api :> apis)
775+ -> Proxy m
776+ -> Proxy tag
777+ -> Req t
778+ -> Dynamic t BaseUrl
779+ -> ClientOptions
780+ -> Client t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag
781+ clientWithRoute _ =
782+ clientWithRoute (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))
783+
784+-- | When 'NoThrow' comes before any other combinator, push it down so it is
785+-- closer to the 'Verb'.
786+instance HasClient t m (api :> NoThrow :> apis) tag =>
787+ HasClient t m (NoThrow :> api :> apis) tag where
788+
789+ type Client t m (NoThrow :> api :> apis) tag =
790+ Client t m (api :> NoThrow :> apis) tag
791+
792+ clientWithRoute
793+ :: Proxy (NoThrow :> api :> apis)
794+ -> Proxy m
795+ -> Proxy tag
796+ -> Req t
797+ -> Dynamic t BaseUrl
798+ -> ClientOptions
799+ -> Client t m (api :> NoThrow :> apis) tag
800+ clientWithRoute _ =
801+ clientWithRoute (Proxy :: Proxy (api :> NoThrow :> apis))