@@ -42,56 +42,101 @@ module Servant.Reflex
4242
4343------------------------------------------------------------------------------
4444import Control.Applicative
45−import qualified Data.ByteString as BS
46−import qualified Data.ByteString.Lazy as BL
47−import Data.CaseInsensitive (mk)
45+import qualified Data.ByteString as BS
46+import qualified Data.ByteString.Lazy as BL
47+import Data.CaseInsensitive (mk)
4848import Data.Functor.Identity
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, symbolVal)
60−import GHCJS.DOM.Types (Blob)
61−import Servant.API ((:<|>) (..), (:>), Accept (..),
62− BasicAuth, BasicAuthData,
63− BuildHeadersTo (..), Capture,
64− FormUrlEncoded, Header, Headers (..),
65− HttpVersion, IsSecure, JSON,
66− MimeRender (..), NoContent,
67− OctetStream, PlainText, QueryFlag,
68− QueryParam, QueryParams, Raw,
69− ReflectMethod (..), RemoteHost,
70− ReqBody, ToHttpApiData (..), Vault,
71− Verb, contentType)
72−import qualified Servant.Auth as Auth
73−
74−import Reflex.Dom.Core (Dynamic, Event, IsXhrPayload, Reflex,
75− XhrRequest (..), XhrResponse (..),
76− XhrResponseHeaders (..),
77− attachPromptlyDynWith, constDyn, ffor,
78− fmapMaybe, leftmost,
79− 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)
80104------------------------------------------------------------------------------
81−import Servant.Common.BaseUrl (BaseUrl (..), Scheme (..),
82− SupportsServantReflex, baseUrlWidget,
83− showBaseUrl)
84−import Servant.Common.Req (ClientOptions (..), MimeUnrender (..),
85− QParam (..), QueryPart (..), Req (..),
86− ReqResult (..), addHeader, authData,
87− defReq, defaultClientOptions,
88− evalResponse, performRequestsCT,
89− performRequestsNoBody,
90− performSomeRequestsAsync,
91− prependToPathParts, qParamToQueryPart,
92− qParams, reqBody, reqFailure,
93− reqMethod, reqSuccess, reqTag,
94− respHeaders, response, 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)
95140
96141
97142-- * Accessing APIs as a Client
@@ -621,3 +666,136 @@ type family HasCookieAuth xs :: Constraint where
621666 HasCookieAuth '[] = CookieAuthNotEnabled
622667
623668class CookieAuthNotEnabled
669+
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))