@@ -74,6 +74,8 @@ import Servant.Common.Req (ClientOptions, MimeUnrender,
74 qParams, reqBody, reqFailure,
74 qParams, reqBody, reqFailure,
75 reqMethod, reqSuccess, reqSuccess',
75 reqMethod, reqSuccess, reqSuccess',
76 respHeaders, response, withCredentials)
76 respHeaders, response, withCredentials)
77+import Servant.Checked.Exceptions.Internal.Envelope (Envelope)
78+import Servant.Checked.Exceptions.Internal.Servant.API (NoThrow, Throws, Throwing, ThrowingNonterminal)
77import Servant.Reflex (BuildHeaderKeysTo (..), toHeaders)
79import Servant.Reflex (BuildHeaderKeysTo (..), toHeaders)
@@ -386,3 +388,143 @@ instance (HasClientMulti t m api f tag, Reflex t, Applicative f)
387 req' a r = r { authData = Just (constDyn a) }
389 req' a r = r { authData = Just (constDyn a) }
388 reqs' = liftA2 req' <$> authdatas <*> reqs
390 reqs' = liftA2 req' <$> authdatas <*> reqs
392+{- servant-checked-exceptions
393+~~~~~~~~~~~~~~~~~~~~~
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
400+ clientWithRouteMulti
401+ :: Proxy (Throws e :> api)
405+ -> Dynamic t (f (Req t))
406+ -> Dynamic t BaseUrl
408+ -> ClientMulti t m (Throwing '[e] :> api) f tag
409+ clientWithRouteMulti _ = clientWithRouteMulti (Proxy :: Proxy (Throwing '[e] :> api))
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
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
419+ clientWithRouteMulti
420+ :: Proxy (Throwing es :> Verb method status ctypes a)
424+ -> Dynamic t (f (Req t))
425+ -> Dynamic t BaseUrl
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)))
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
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
439+ clientWithRouteMulti
440+ :: Proxy (NoThrow :> Verb method status ctypes a)
444+ -> Dynamic t (f (Req t))
445+ -> Dynamic t BaseUrl
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)))
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
456+ type ClientMulti t m (Throwing es :> (api1 :<|> api2)) f tag =
457+ ClientMulti t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) f tag
459+ clientWithRouteMulti
460+ :: Proxy (Throwing es :> (api1 :<|> api2))
464+ -> Dynamic t (f (Req t))
465+ -> Dynamic t BaseUrl
467+ -> ClientMulti t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) f tag
468+ clientWithRouteMulti _ =
469+ clientWithRouteMulti (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))
471+-- | When 'NoThrow' comes before ':<|>', push 'NoThrow' into each branch of the
473+instance HasClientMulti t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) f tag =>
474+ HasClientMulti t m (NoThrow :> (api1 :<|> api2)) f tag where
476+ type ClientMulti t m (NoThrow :> (api1 :<|> api2)) f tag =
477+ ClientMulti t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) f tag
479+ clientWithRouteMulti
480+ :: Proxy (NoThrow :> (api1 :<|> api2))
484+ -> Dynamic t (f (Req t))
485+ -> Dynamic t BaseUrl
487+ -> ClientMulti t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) f tag
488+ clientWithRouteMulti _ =
489+ clientWithRouteMulti (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2)))
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
497+ type ClientMulti t m (Throwing es :> api :> apis) f tag =
498+ ClientMulti t m (ThrowingNonterminal (Throwing es :> api :> apis)) f tag
500+ clientWithRouteMulti
501+ :: Proxy (Throwing es :> api :> apis)
505+ -> Dynamic t (f (Req t))
506+ -> Dynamic t BaseUrl
508+ -> ClientMulti t m (ThrowingNonterminal (Throwing es :> api :> apis)) f tag
509+ clientWithRouteMulti _ =
510+ clientWithRouteMulti (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))
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
517+ type ClientMulti t m (NoThrow :> api :> apis) f tag =
518+ ClientMulti t m (api :> NoThrow :> apis) f tag
520+ clientWithRouteMulti
521+ :: Proxy (NoThrow :> api :> apis)
525+ -> Dynamic t (f (Req t))
526+ -> Dynamic t BaseUrl
528+ -> ClientMulti t m (api :> NoThrow :> apis) f tag
529+ clientWithRouteMulti _ =
530+ clientWithRouteMulti (Proxy :: Proxy (api :> NoThrow :> apis))