git.iko.soy/servant-reflex
on master help sign in
Merge pull request #54 from obsidiansystems/bump-servant

Bump servant to 0.13 and add instances for servant-checked-exceptions

commitcff34994d4776eff91c046a420615a2d6b097624 authorLuigy Leon <luichi.19@gmail.com> dateTue 27 Feb 2018, 17:22 (9 years ago) parentdd16ebb09de487
3 files changed+279−1
compare with master
unifiedsplit
servant-reflex.cabal+2−1 src/Servant/Reflex.hs+135 src/Servant/Reflex/Multi.hs+142
servant-reflex.cabal+2−1
@@ -42,7 +42,8 @@ library
4242 reflex >= 0.5 && < 0.6,
4343 reflex-dom-core == 0.4 && < 0.5,
4444 safe >= 0.3.9 && < 0.4,
45− servant >= 0.8 && < 0.12,
45+ servant >= 0.13 && < 0.14,
46+ servant-checked-exceptions >= 1.1.0.0 && < 1.2,
4647 servant-auth >= 0.2.1 && < 0.4,
4748 string-conversions >= 0.4 && < 0.5,
4849 text >= 1.2 && < 1.3,
src/Servant/Reflex.hs+135
@@ -84,6 +84,8 @@ import Servant.Common.Req (ClientOptions(..), MimeUnrender(..),
8484 response,
8585 reqTag,
8686 qParams, withCredentials)
87+import Servant.Checked.Exceptions.Internal.Envelope (Envelope)
88+import Servant.Checked.Exceptions.Internal.Servant.API (NoThrow, Throws, Throwing, ThrowingNonterminal)
8789
8890
8991-- * Accessing APIs as a Client
@@ -571,3 +573,136 @@ type family HasCookieAuth xs :: Constraint where
571573
572574class CookieAuthNotEnabled
573575
576+{- servant-checked-exceptions
577+~~~~~~~~~~~~~~~~~~~~~
578+-}
579+
580+-- | Change a 'Throws' into 'Throwing'.
581+instance (HasClient t m (Throwing '[e] :> api) tag) => HasClient t m (Throws e :> api) tag where
582+ type Client t m (Throws e :> api) tag = Client t m (Throwing '[e] :> api) tag
583+
584+ clientWithRoute
585+ :: Proxy (Throws e :> api)
586+ -> Proxy m
587+ -> Proxy tag
588+ -> Req t
589+ -> Dynamic t BaseUrl
590+ -> ClientOptions
591+ -> Client t m (Throwing '[e] :> api) tag
592+ clientWithRoute _ = clientWithRoute (Proxy :: Proxy (Throwing '[e] :> api))
593+
594+-- | When @'Throwing' es@ comes before a 'Verb', change it into the same 'Verb'
595+-- but returning an @'Envelope' es@.
596+instance (HasClient t m (Verb method status ctypes (Envelope es a)) tag) =>
597+ HasClient t m (Throwing es :> Verb method status ctypes a) tag where
598+
599+ type Client t m (Throwing es :> Verb method status ctypes a) tag =
600+ Client t m (Verb method status ctypes (Envelope es a)) tag
601+
602+ clientWithRoute
603+ :: Proxy (Throwing es :> Verb method status ctypes a)
604+ -> Proxy m
605+ -> Proxy tag
606+ -> Req t
607+ -> Dynamic t BaseUrl
608+ -> ClientOptions
609+ -> Client t m (Verb method status ctypes (Envelope es a)) tag
610+ clientWithRoute Proxy =
611+ clientWithRoute (Proxy :: Proxy (Verb method status ctypes (Envelope es a)))
612+
613+-- | When 'NoThrow' comes before a 'Verb', change it into the same 'Verb'
614+-- but returning an @'Envelope' \'[]@.
615+instance (HasClient t m (Verb method status ctypes (Envelope '[] a)) tag) =>
616+ HasClient t m (NoThrow :> Verb method status ctypes a) tag where
617+
618+ type Client t m (NoThrow :> Verb method status ctypes a) tag =
619+ Client t m (Verb method status ctypes (Envelope '[] a)) tag
620+
621+ clientWithRoute
622+ :: Proxy (NoThrow :> Verb method status ctypes a)
623+ -> Proxy m
624+ -> Proxy tag
625+ -> Req t
626+ -> Dynamic t BaseUrl
627+ -> ClientOptions
628+ -> Client t m (Verb method status ctypes (Envelope '[] a)) tag
629+ clientWithRoute Proxy =
630+ clientWithRoute (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a)))
631+
632+-- | When @'Throwing' es@ comes before ':<|>', push @'Throwing' es@ into each
633+-- branch of the API.
634+instance HasClient t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag =>
635+ HasClient t m (Throwing es :> (api1 :<|> api2)) tag where
636+
637+ type Client t m (Throwing es :> (api1 :<|> api2)) tag =
638+ Client t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag
639+
640+ clientWithRoute
641+ :: Proxy (Throwing es :> (api1 :<|> api2))
642+ -> Proxy m
643+ -> Proxy tag
644+ -> Req t
645+ -> Dynamic t BaseUrl
646+ -> ClientOptions
647+ -> Client t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag
648+ clientWithRoute _ =
649+ clientWithRoute (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))
650+
651+-- | When 'NoThrow' comes before ':<|>', push 'NoThrow' into each branch of the
652+-- API.
653+instance HasClient t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag =>
654+ HasClient t m (NoThrow :> (api1 :<|> api2)) tag where
655+
656+ type Client t m (NoThrow :> (api1 :<|> api2)) tag =
657+ Client t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag
658+
659+ clientWithRoute
660+ :: Proxy (NoThrow :> (api1 :<|> api2))
661+ -> Proxy m
662+ -> Proxy tag
663+ -> Req t
664+ -> Dynamic t BaseUrl
665+ -> ClientOptions
666+ -> Client t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag
667+ clientWithRoute _ =
668+ clientWithRoute (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2)))
669+
670+-- | When a @'Throws' e@ comes immediately after a @'Throwing' es@, 'Snoc' the
671+-- @e@ onto the @es@. Otherwise, if @'Throws' e@ comes before any other
672+-- combinator, push it down so it is closer to the 'Verb'.
673+instance HasClient t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag =>
674+ HasClient t m (Throwing es :> api :> apis) tag where
675+
676+ type Client t m (Throwing es :> api :> apis) tag =
677+ Client t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag
678+
679+ clientWithRoute
680+ :: Proxy (Throwing es :> api :> apis)
681+ -> Proxy m
682+ -> Proxy tag
683+ -> Req t
684+ -> Dynamic t BaseUrl
685+ -> ClientOptions
686+ -> Client t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag
687+ clientWithRoute _ =
688+ clientWithRoute (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))
689+
690+-- | When 'NoThrow' comes before any other combinator, push it down so it is
691+-- closer to the 'Verb'.
692+instance HasClient t m (api :> NoThrow :> apis) tag =>
693+ HasClient t m (NoThrow :> api :> apis) tag where
694+
695+ type Client t m (NoThrow :> api :> apis) tag =
696+ Client t m (api :> NoThrow :> apis) tag
697+
698+ clientWithRoute
699+ :: Proxy (NoThrow :> api :> apis)
700+ -> Proxy m
701+ -> Proxy tag
702+ -> Req t
703+ -> Dynamic t BaseUrl
704+ -> ClientOptions
705+ -> Client t m (api :> NoThrow :> apis) tag
706+ clientWithRoute _ =
707+ clientWithRoute (Proxy :: Proxy (api :> NoThrow :> apis))
708+
src/Servant/Reflex/Multi.hs+142
@@ -74,6 +74,8 @@ import Servant.Common.Req (ClientOptions, MimeUnrender,
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))