git.iko.soy/servant-reflex
on e18d6bd help sign in
f76dbeb
swap
16 ahead, 37 behind
4 files changed+359−27
since splitsnapshots
unifiedsplit
servant-reflex.cabal+3−1 src/Servant/Common/Req.hs+68−22 src/Servant/Reflex.hs+144−2 src/Servant/Reflex/Multi.hs+144−2
servant-reflex.cabal+3−1
@@ -27,6 +27,7 @@ library
2727 hs-source-dirs: src
2828 build-depends:
2929 base >= 4.8 && < 4.10,
30+ aeson >= 0.11 && < 1.3,
3031 bytestring >= 0.10 && < 0.11,
3132 case-insensitive >= 1.2.0.4 && < 1.3,
3233 containers >= 0.5.6 && < 0.6,
@@ -41,7 +42,8 @@ library
4142 reflex >= 0.5 && < 0.6,
4243 reflex-dom-core == 0.4 && < 0.5,
4344 safe >= 0.3.9 && < 0.4,
44− servant >= 0.8 && < 0.13,
45+ servant >= 0.13 && < 0.14,
46+ servant-checked-exceptions >= 1.1.0.0 && < 1.2,
4547 servant-auth >= 0.2.1 && < 0.4,
4648 string-conversions >= 0.4 && < 0.5,
4749 text >= 1.2 && < 1.3,
src/Servant/Common/Req.hs+68−22
@@ -8,6 +8,8 @@
88{-# LANGUAGE ScopedTypeVariables #-}
99{-# LANGUAGE TupleSections #-}
1010
11+{-# LANGUAGE MultiParamTypeClasses #-}
12+{-# LANGUAGE FlexibleInstances #-}
1113module Servant.Common.Req where
1214
1315-------------------------------------------------------------------------------
@@ -15,8 +17,11 @@ import Control.Applicative (liftA2, liftA3)
1517import Control.Concurrent
1618import Control.Monad (join)
1719import Control.Monad.IO.Class (MonadIO, liftIO)
20+import Data.Aeson
1821import Data.Bifunctor (first)
19−import qualified Data.ByteString.Builder as Builder
22+import qualified Data.ByteString.Builder as BB
23+import qualified Data.ByteString as BS
24+import Data.ByteString.Lazy (ByteString)
2025import qualified Data.ByteString.Lazy.Char8 as BL
2126import qualified Data.Map as Map
2227import Data.Maybe (catMaybes, fromMaybe)
@@ -25,17 +30,24 @@ import Data.Monoid ((<>))
2530import Data.Proxy (Proxy(..))
2631import Data.Text (Text)
2732import qualified Data.Text as T
28−import qualified Data.Text.Encoding as TE
33+import qualified Data.Text.Lazy as TL
34+import qualified Data.Text.Encoding as T
2935import Data.Traversable (forM)
3036import Language.Javascript.JSaddle.Monad (JSM, MonadJSM, liftJSM)
37+import qualified Language.Javascript.JSaddle as JS
38+import qualified Data.JSString.Text as JS (lazyTextFromJSString)
3139import qualified Network.URI as N
3240import Reflex.Dom.Core hiding (tag)
3341import Servant.Common.BaseUrl (BaseUrl, showBaseUrl,
3442 SupportsServantReflex)
35−import Servant.API.ContentTypes (MimeUnrender(..), NoContent(..))
43+import Servant.API.ContentTypes ( NoContent(..), Accept, JSON
44+ , OctetStream, PlainText
45+ , FormUrlEncoded)
3646import Web.HttpApiData (ToHttpApiData(..))
47+import Web.FormUrlEncoded (FromForm, urlDecodeAsForm)
3748-------------------------------------------------------------------------------
3849import Servant.API.BasicAuth
50+-------------------------------------------------------------------------------
3951
4052
4153------------------------------------------------------------------------------
@@ -150,7 +162,7 @@ prependToPathParts p req =
150162 req { reqPathParts = p : reqPathParts req }
151163
152164addHeader :: (ToHttpApiData a, Reflex t) => Text -> Dynamic t (Either Text a) -> Req t -> Req t
153−addHeader name val req = req { headers = (name, (fmap . fmap) (TE.decodeUtf8 . toHeader) val) : headers req }
165+addHeader name val req = req { headers = (name, (fmap . fmap) (T.decodeUtf8 . toHeader) val) : headers req }
154166
155167
156168reqToReflexRequest
@@ -223,7 +235,7 @@ reqToReflexRequest reqMeth reqHost req =
223235 Map.insert "Content-Type" bCT (Map.fromList hs)
224236 , _xhrRequestConfig_user = Nothing
225237 , _xhrRequestConfig_password = Nothing
226− , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer
238+ , _xhrRequestConfig_responseType = Nothing
227239 , _xhrRequestConfig_withCredentials = False
228240 , _xhrRequestConfig_responseHeaders = def
229241 }
@@ -235,7 +247,7 @@ reqToReflexRequest reqMeth reqHost req =
235247 Right hs -> Right $ def { _xhrRequestConfig_headers = Map.fromList hs
236248 , _xhrRequestConfig_user = Nothing
237249 , _xhrRequestConfig_password = Nothing
238− , _xhrRequestConfig_responseType = Just XhrResponseType_ArrayBuffer
250+ , _xhrRequestConfig_responseType = Nothing
239251 , _xhrRequestConfig_sendData = ""
240252 , _xhrRequestConfig_withCredentials = False
241253 }
@@ -245,8 +257,8 @@ reqToReflexRequest reqMeth reqHost req =
245257 mkAuth _ (Left e) = Left e
246258 mkAuth Nothing r = r
247259 mkAuth (Just (BasicAuthData u p)) (Right config) = Right $ config
248− { _xhrRequestConfig_user = Just $ TE.decodeUtf8 u
249− , _xhrRequestConfig_password = Just $ TE.decodeUtf8 p}
260+ { _xhrRequestConfig_user = Just $ T.decodeUtf8 u
261+ , _xhrRequestConfig_password = Just $ T.decodeUtf8 p}
250262
251263 addAuth :: Dynamic t (Either Text (XhrRequestConfig x))
252264 -> Dynamic t (Either Text (XhrRequestConfig x))
@@ -326,10 +338,9 @@ performSomeRequestsAsync' opts newXhr req = performEventAsync $ ffor req $ \hrs
326338 return ()
327339
328340
329−
330341type XhrPayload = T.Text
331342bytesToPayload :: BL.ByteString -> XhrPayload
332−bytesToPayload = TE.decodeUtf8 . BL.toStrict
343+bytesToPayload = T.decodeUtf8 . BL.toStrict
333344
334345
335346performRequestsCT
@@ -344,15 +355,14 @@ performRequestsCT
344355 -> m (Event t (f (ReqResult tag a)))
345356performRequestsCT ct reqMeth reqs reqHost opts trigger = do
346357 resps <- performRequests reqMeth reqs reqHost opts trigger
347− let decodeResp (Just (XhrResponseBody_ArrayBuffer x)) =
348− first T.pack .
349− mimeUnrender ct $
350− BL.fromStrict x
351− decodeResp _ = Left "No body"
358+ let decodeResp x = first T.pack
359+ . mimeUnrender ct
360+ . JS.textToJSString
361+ =<< note "No body text" (_xhrResponse_responseText x)
352362 return $ fmap
353363 (\(t,rs) -> ffor rs $ \r -> case r of
354364 Left e -> RequestFailure t e
355− Right g -> evalResponse (decodeResp . _xhrResponse_response) (t,g)
365+ Right g -> evalResponse decodeResp (t,g)
356366 )
357367 resps
358368
@@ -379,7 +389,7 @@ evalResponse
379389 :: (XhrResponse -> Either Text a)
380390 -> (tag, XhrResponse)
381391 -> ReqResult tag a
382−evalResponse decode (tag, xhr) =
392+evalResponse decodeRes (tag, xhr) =
383393 let status = _xhrResponse_status xhr
384394 okStatus = status >= 200 && status < 400
385395 errMsg = fromMaybe
@@ -390,20 +400,56 @@ evalResponse decode (tag, xhr) =
390400 then either
391401 (\e -> ResponseFailure tag e xhr)
392402 (\v -> ResponseSuccess tag v xhr)
393− (decode xhr)
403+ (decodeRes xhr)
394404 else ResponseFailure tag errMsg xhr
395405 in respPayld
396406
397407
408+-- | Similar to 'Servant.API.ContentType.MimeUnrender' but with the differnce that
409+-- the second argument expects a JSString instead of ByteString.
410+-- This can lead to better performance ghcjs.
411+class Accept contentType => MimeUnrender contentType a where
412+ mimeUnrender :: Proxy contentType -> JS.JSString -> Either String a
413+
414+instance FromJSON a => MimeUnrender JSON a where
415+ mimeUnrender _ = note "Failed to decode response" . jsonDecode
416+
417+-- | @urlDecodeAsForm@
418+-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
419+-- holds if every element of x is non-null (i.e., not @("", "")@)
420+instance FromForm a => MimeUnrender FormUrlEncoded a where
421+ mimeUnrender _ = first T.unpack . urlDecodeAsForm . BB.toLazyByteString . T.encodeUtf8Builder . JS.textFromJSString
422+
423+-- | @left show . TextL.decodeUtf8'@
424+instance MimeUnrender PlainText TL.Text where
425+ mimeUnrender _ = pure . JS.lazyTextFromJSString
426+
427+-- | @left show . TextS.decodeUtf8' . toStrict@
428+instance MimeUnrender PlainText T.Text where
429+ mimeUnrender _ = pure . JS.textFromJSString
430+
431+-- | @Right . BC.unpack@
432+instance MimeUnrender PlainText String where
433+ mimeUnrender _ = Right . T.unpack . JS.textFromJSString
434+
435+-- | @Right . id@
436+instance MimeUnrender OctetStream ByteString where
437+ mimeUnrender _ = pure . BB.toLazyByteString . T.encodeUtf8Builder . JS.textFromJSString
438+
439+-- | @Right . toStrict@
440+instance MimeUnrender OctetStream BS.ByteString where
441+ mimeUnrender _ = pure . T.encodeUtf8 . JS.textFromJSString
442+
398443note :: e -> Maybe a -> Either e a
399−note e = maybe (Left e) Right
444+note e Nothing = Left e
445+note _ (Just a) = Right a
400446
401447fmapL :: (e -> e') -> Either e a -> Either e' a
402448fmapL _ (Right a) = Right a
403449fmapL f (Left e) = Left (f e)
404450
405−builderToText :: Builder.Builder -> T.Text
406−builderToText = TE.decodeUtf8 . BL.toStrict . Builder.toLazyByteString
451+builderToText :: BB.Builder -> T.Text
452+builderToText = T.decodeUtf8 . BL.toStrict . BB.toLazyByteString
407453
408454escape :: T.Text -> T.Text
409−escape = T.pack . N.escapeURIString (not . N.isReserved) . T.unpack . TE.decodeUtf8 . BL.toStrict . Builder.toLazyByteString . toEncodedUrlPiece
455+escape = T.pack . N.escapeURIString (not . N.isReserved) . T.unpack . T.decodeUtf8 . BL.toStrict . BB.toLazyByteString . toEncodedUrlPiece
src/Servant/Reflex.hs+144−2
@@ -54,7 +54,7 @@ import Servant.API ((:<|>)(..),(:>), BasicAuth,
5454 BasicAuthData, BuildHeadersTo(..),
5555 Capture, contentType, Header,
5656 Headers(..), HttpVersion, IsSecure,
57− MimeRender(..), MimeUnrender,
57+ MimeRender(..),
5858 NoContent, QueryFlag, QueryParam,
5959 QueryParams, Raw, ReflectMethod(..),
6060 RemoteHost, ReqBody,
@@ -71,7 +71,7 @@ import Reflex.Dom.Core (Dynamic, Event, Reflex,
7171import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
7272 showBaseUrl,
7373 SupportsServantReflex)
74−import Servant.Common.Req (ClientOptions(..),
74+import Servant.Common.Req (ClientOptions(..), MimeUnrender(..),
7575 defaultClientOptions,
7676 Req, ReqResult(..), QParam(..),
7777 QueryPart(..), addHeader, authData,
@@ -87,6 +87,8 @@ import Servant.Common.Req (ClientOptions(..),
8787 response,
8888 reqTag,
8989 qParams, withCredentials)
90+import Servant.Checked.Exceptions.Internal.Envelope (Envelope)
91+import Servant.Checked.Exceptions.Internal.Servant.API (NoThrow, Throws, Throwing, ThrowingNonterminal)
9092
9193
9294-- * Accessing APIs as a Client
@@ -604,3 +606,143 @@ type family HasCookieAuth xs :: Constraint where
604606
605607class CookieAuthNotEnabled
606608
609+{- servant-checked-exceptions
610+~~~~~~~~~~~~~~~~~~~~~
611+-}
612+
613+-- | Change a 'Throws' into 'Throwing'.
614+instance (Monad m, HasClient t m (Throwing '[e] :> api) tag) => HasClient t m (Throws e :> api) tag where
615+ type Client t m (Throws e :> api) tag = Client t m (Throwing '[e] :> api) tag
616+
617+ clientWithRouteAndResultHandler
618+ :: Proxy (Throws e :> api)
619+ -> Proxy m
620+ -> Proxy tag
621+ -> Req t
622+ -> Dynamic t BaseUrl
623+ -> ClientOptions
624+ -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))
625+ -> Client t m (Throwing '[e] :> api) tag
626+ clientWithRouteAndResultHandler _ = clientWithRouteAndResultHandler (Proxy :: Proxy (Throwing '[e] :> api))
627+
628+-- | When @'Throwing' es@ comes before a 'Verb', change it into the same 'Verb'
629+-- but returning an @'Envelope' es@.
630+instance (HasClient t m (Verb method status ctypes (Envelope es a)) tag) =>
631+ HasClient t m (Throwing es :> Verb method status ctypes a) tag where
632+
633+ type Client t m (Throwing es :> Verb method status ctypes a) tag =
634+ Client t m (Verb method status ctypes (Envelope es a)) tag
635+
636+ clientWithRouteAndResultHandler
637+ :: Proxy (Throwing es :> Verb method status ctypes a)
638+ -> Proxy m
639+ -> Proxy tag
640+ -> Req t
641+ -> Dynamic t BaseUrl
642+ -> ClientOptions
643+ -> (forall x. Event t (ReqResult tag x) -> m (Event t (ReqResult tag x)))
644+ -> Client t m (Verb method status ctypes (Envelope es a)) tag
645+ clientWithRouteAndResultHandler Proxy =
646+ clientWithRouteAndResultHandler (Proxy :: Proxy (Verb method status ctypes (Envelope es a)))
647+
648+-- | When 'NoThrow' comes before a 'Verb', change it into the same 'Verb'
649+-- but returning an @'Envelope' \'[]@.
650+instance (Monad m, HasClient t m (Verb method status ctypes (Envelope '[] a)) tag) =>
651+ HasClient t m (NoThrow :> Verb method status ctypes a) tag where
652+
653+ type Client t m (NoThrow :> Verb method status ctypes a) tag =
654+ Client t m (Verb method status ctypes (Envelope '[] a)) tag
655+
656+ clientWithRouteAndResultHandler
657+ :: Proxy (NoThrow :> Verb method status ctypes a)
658+ -> Proxy m
659+ -> Proxy tag
660+ -> Req t
661+ -> Dynamic t BaseUrl
662+ -> ClientOptions
663+ -> (forall x. Event t (ReqResult tag x) -> m (Event t (ReqResult tag x)))
664+ -> Client t m (Verb method status ctypes (Envelope '[] a)) tag
665+ clientWithRouteAndResultHandler Proxy =
666+ clientWithRouteAndResultHandler (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a)))
667+
668+-- | When @'Throwing' es@ comes before ':<|>', push @'Throwing' es@ into each
669+-- branch of the API.
670+instance (Monad m, HasClient t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag) =>
671+ HasClient t m (Throwing es :> (api1 :<|> api2)) tag where
672+
673+ type Client t m (Throwing es :> (api1 :<|> api2)) tag =
674+ Client t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag
675+
676+ clientWithRouteAndResultHandler
677+ :: Proxy (Throwing es :> (api1 :<|> api2))
678+ -> Proxy m
679+ -> Proxy tag
680+ -> Req t
681+ -> Dynamic t BaseUrl
682+ -> ClientOptions
683+ -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))
684+ -> Client t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag
685+ clientWithRouteAndResultHandler _ =
686+ clientWithRouteAndResultHandler (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))
687+
688+-- | When 'NoThrow' comes before ':<|>', push 'NoThrow' into each branch of the
689+-- API.
690+instance (Monad m, HasClient t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag) =>
691+ HasClient t m (NoThrow :> (api1 :<|> api2)) tag where
692+
693+ type Client t m (NoThrow :> (api1 :<|> api2)) tag =
694+ Client t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag
695+
696+ clientWithRouteAndResultHandler
697+ :: Proxy (NoThrow :> (api1 :<|> api2))
698+ -> Proxy m
699+ -> Proxy tag
700+ -> Req t
701+ -> Dynamic t BaseUrl
702+ -> ClientOptions
703+ -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))
704+ -> Client t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag
705+ clientWithRouteAndResultHandler _ =
706+ clientWithRouteAndResultHandler (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2)))
707+
708+-- | When a @'Throws' e@ comes immediately after a @'Throwing' es@, 'Snoc' the
709+-- @e@ onto the @es@. Otherwise, if @'Throws' e@ comes before any other
710+-- combinator, push it down so it is closer to the 'Verb'.
711+instance (Monad m, HasClient t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag) =>
712+ HasClient t m (Throwing es :> api :> apis) tag where
713+
714+ type Client t m (Throwing es :> api :> apis) tag =
715+ Client t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag
716+
717+ clientWithRouteAndResultHandler
718+ :: Proxy (Throwing es :> api :> apis)
719+ -> Proxy m
720+ -> Proxy tag
721+ -> Req t
722+ -> Dynamic t BaseUrl
723+ -> ClientOptions
724+ -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))
725+ -> Client t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag
726+ clientWithRouteAndResultHandler _ =
727+ clientWithRouteAndResultHandler (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))
728+
729+-- | When 'NoThrow' comes before any other combinator, push it down so it is
730+-- closer to the 'Verb'.
731+instance (Monad m, HasClient t m (api :> NoThrow :> apis) tag) =>
732+ HasClient t m (NoThrow :> api :> apis) tag where
733+
734+ type Client t m (NoThrow :> api :> apis) tag =
735+ Client t m (api :> NoThrow :> apis) tag
736+
737+ clientWithRouteAndResultHandler
738+ :: Proxy (NoThrow :> api :> apis)
739+ -> Proxy m
740+ -> Proxy tag
741+ -> Req t
742+ -> Dynamic t BaseUrl
743+ -> ClientOptions
744+ -> (forall a. Event t (ReqResult tag a) -> m (Event t (ReqResult tag a)))
745+ -> Client t m (api :> NoThrow :> apis) tag
746+ clientWithRouteAndResultHandler _ =
747+ clientWithRouteAndResultHandler (Proxy :: Proxy (api :> NoThrow :> apis))
748+
src/Servant/Reflex/Multi.hs+144−2
@@ -49,7 +49,7 @@ import Servant.API ((:<|>) (..), (:>), BasicAuth,
4949 BasicAuthData, BuildHeadersTo (..),
5050 Capture, Header, Headers (..),
5151 HttpVersion, IsSecure, MimeRender (..),
52− MimeUnrender, NoContent, QueryFlag,
52+ NoContent, QueryFlag,
5353 QueryParam, QueryParams, Raw,
5454 ReflectMethod (..), RemoteHost,
5555 ReqBody, ToHttpApiData (..), Vault,
@@ -62,7 +62,7 @@ import Reflex.Dom.Core (Dynamic, Event, Reflex,
6262------------------------------------------------------------------------------
6363import Servant.Common.BaseUrl (BaseUrl (..), Scheme (..),
6464 SupportsServantReflex)
65−import Servant.Common.Req (ClientOptions,
65+import Servant.Common.Req (ClientOptions, MimeUnrender,
6666 QParam (..), QueryPart (..), Req,
6767 ReqResult (..), addHeader, authData,
6868 defReq,
@@ -74,6 +74,8 @@ import Servant.Common.Req (ClientOptions,
7474 qParams, reqBody, reqFailure,
7575 reqMethod, reqSuccess, reqSuccess',
7676 respHeaders, response, withCredentials)
77+import Servant.Checked.Exceptions.Internal.Envelope (Envelope)
78+import Servant.Checked.Exceptions.Internal.Servant.API (NoThrow, Throws, Throwing, ThrowingNonterminal)
7779import Servant.Reflex (BuildHeaderKeysTo (..), toHeaders)
7880
7981
@@ -386,3 +388,143 @@ instance (HasClientMulti t m api f tag, Reflex t, Applicative f)
386388 where
387389 req' a r = r { authData = Just (constDyn a) }
388390 reqs' = liftA2 req' <$> authdatas <*> reqs
391+
392+{- servant-checked-exceptions
393+~~~~~~~~~~~~~~~~~~~~~
394+-}
395+
396+-- | Change a 'Throws' into 'Throwing'.
397+instance (HasClientMulti t m (Throwing '[e] :> api) f tag) => HasClientMulti t m (Throws e :> api) f tag where
398+ type ClientMulti t m (Throws e :> api) f tag = ClientMulti t m (Throwing '[e] :> api) f tag
399+
400+ clientWithRouteMulti
401+ :: Proxy (Throws e :> api)
402+ -> Proxy m
403+ -> Proxy f
404+ -> Proxy tag
405+ -> Dynamic t (f (Req t))
406+ -> Dynamic t BaseUrl
407+ -> ClientOptions
408+ -> ClientMulti t m (Throwing '[e] :> api) f tag
409+ clientWithRouteMulti _ = clientWithRouteMulti (Proxy :: Proxy (Throwing '[e] :> api))
410+
411+-- | When @'Throwing' es@ comes before a 'Verb', change it into the same 'Verb'
412+-- but returning an @'Envelope' es@.
413+instance (HasClientMulti t m (Verb method status ctypes (Envelope es a)) f tag) =>
414+ HasClientMulti t m (Throwing es :> Verb method status ctypes a) f tag where
415+
416+ type ClientMulti t m (Throwing es :> Verb method status ctypes a) f tag =
417+ ClientMulti t m (Verb method status ctypes (Envelope es a)) f tag
418+
419+ clientWithRouteMulti
420+ :: Proxy (Throwing es :> Verb method status ctypes a)
421+ -> Proxy m
422+ -> Proxy f
423+ -> Proxy tag
424+ -> Dynamic t (f (Req t))
425+ -> Dynamic t BaseUrl
426+ -> ClientOptions
427+ -> ClientMulti t m (Verb method status ctypes (Envelope es a)) f tag
428+ clientWithRouteMulti Proxy =
429+ clientWithRouteMulti (Proxy :: Proxy (Verb method status ctypes (Envelope es a)))
430+
431+-- | When 'NoThrow' comes before a 'Verb', change it into the same 'Verb'
432+-- but returning an @'Envelope' \'[]@.
433+instance (HasClientMulti t m (Verb method status ctypes (Envelope '[] a)) f tag) =>
434+ HasClientMulti t m (NoThrow :> Verb method status ctypes a) f tag where
435+
436+ type ClientMulti t m (NoThrow :> Verb method status ctypes a) f tag =
437+ ClientMulti t m (Verb method status ctypes (Envelope '[] a)) f tag
438+
439+ clientWithRouteMulti
440+ :: Proxy (NoThrow :> Verb method status ctypes a)
441+ -> Proxy m
442+ -> Proxy f
443+ -> Proxy tag
444+ -> Dynamic t (f (Req t))
445+ -> Dynamic t BaseUrl
446+ -> ClientOptions
447+ -> ClientMulti t m (Verb method status ctypes (Envelope '[] a)) f tag
448+ clientWithRouteMulti Proxy =
449+ clientWithRouteMulti (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a)))
450+
451+-- | When @'Throwing' es@ comes before ':<|>', push @'Throwing' es@ into each
452+-- branch of the API.
453+instance HasClientMulti t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) f tag =>
454+ HasClientMulti t m (Throwing es :> (api1 :<|> api2)) f tag where
455+
456+ type ClientMulti t m (Throwing es :> (api1 :<|> api2)) f tag =
457+ ClientMulti t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) f tag
458+
459+ clientWithRouteMulti
460+ :: Proxy (Throwing es :> (api1 :<|> api2))
461+ -> Proxy m
462+ -> Proxy f
463+ -> Proxy tag
464+ -> Dynamic t (f (Req t))
465+ -> Dynamic t BaseUrl
466+ -> ClientOptions
467+ -> ClientMulti t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) f tag
468+ clientWithRouteMulti _ =
469+ clientWithRouteMulti (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))
470+
471+-- | When 'NoThrow' comes before ':<|>', push 'NoThrow' into each branch of the
472+-- API.
473+instance HasClientMulti t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) f tag =>
474+ HasClientMulti t m (NoThrow :> (api1 :<|> api2)) f tag where
475+
476+ type ClientMulti t m (NoThrow :> (api1 :<|> api2)) f tag =
477+ ClientMulti t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) f tag
478+
479+ clientWithRouteMulti
480+ :: Proxy (NoThrow :> (api1 :<|> api2))
481+ -> Proxy m
482+ -> Proxy f
483+ -> Proxy tag
484+ -> Dynamic t (f (Req t))
485+ -> Dynamic t BaseUrl
486+ -> ClientOptions
487+ -> ClientMulti t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) f tag
488+ clientWithRouteMulti _ =
489+ clientWithRouteMulti (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2)))
490+
491+-- | When a @'Throws' e@ comes immediately after a @'Throwing' es@, 'Snoc' the
492+-- @e@ onto the @es@. Otherwise, if @'Throws' e@ comes before any other
493+-- combinator, push it down so it is closer to the 'Verb'.
494+instance HasClientMulti t m (ThrowingNonterminal (Throwing es :> api :> apis)) f tag =>
495+ HasClientMulti t m (Throwing es :> api :> apis) f tag where
496+
497+ type ClientMulti t m (Throwing es :> api :> apis) f tag =
498+ ClientMulti t m (ThrowingNonterminal (Throwing es :> api :> apis)) f tag
499+
500+ clientWithRouteMulti
501+ :: Proxy (Throwing es :> api :> apis)
502+ -> Proxy m
503+ -> Proxy f
504+ -> Proxy tag
505+ -> Dynamic t (f (Req t))
506+ -> Dynamic t BaseUrl
507+ -> ClientOptions
508+ -> ClientMulti t m (ThrowingNonterminal (Throwing es :> api :> apis)) f tag
509+ clientWithRouteMulti _ =
510+ clientWithRouteMulti (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))
511+
512+-- | When 'NoThrow' comes before any other combinator, push it down so it is
513+-- closer to the 'Verb'.
514+instance HasClientMulti t m (api :> NoThrow :> apis) f tag =>
515+ HasClientMulti t m (NoThrow :> api :> apis) f tag where
516+
517+ type ClientMulti t m (NoThrow :> api :> apis) f tag =
518+ ClientMulti t m (api :> NoThrow :> apis) f tag
519+
520+ clientWithRouteMulti
521+ :: Proxy (NoThrow :> api :> apis)
522+ -> Proxy m
523+ -> Proxy f
524+ -> Proxy tag
525+ -> Dynamic t (f (Req t))
526+ -> Dynamic t BaseUrl
527+ -> ClientOptions
528+ -> ClientMulti t m (api :> NoThrow :> apis) f tag
529+ clientWithRouteMulti _ =
530+ clientWithRouteMulti (Proxy :: Proxy (api :> NoThrow :> apis))