@@ -39,39 +39,41 @@ module Servant.Reflex
3939
4040------------------------------------------------------------------------------
4141import Control.Applicative
42−import Data.Monoid ((<>))
43−import qualified Data.Set as Set
44−import qualified Data.Text.Encoding as E
45−import Data.CaseInsensitive (mk)
42+import qualified Data.CaseInsensitive as CI
4643import Data.Functor.Identity
47−import Data.Proxy (Proxy (..))
4844import qualified Data.Map as Map
45+import Data.Monoid ((<>))
46+import Data.Proxy (Proxy (..))
47+import qualified Data.Set as Set
4948import Data.Text (Text)
5049import qualified Data.Text as T
50+import qualified Data.Text.Encoding as E
5151import GHC.Exts (Constraint)
5252import GHC.TypeLits (KnownSymbol, symbolVal)
53−import Servant.API ((:<|>)(..),(:>), BasicAuth,
54− BasicAuthData, BuildHeadersTo(..),
55− Capture, contentType, Header,
56− Headers(..), HttpVersion, IsSecure,
57− MimeRender(..),
53+import Servant.API ((:<|>) (..), (:>), BasicAuth,
54+ BasicAuthData, BuildHeadersTo (..),
55+ Capture, Header, Headers (..),
56+ HttpVersion, IsSecure,
57+ MimeRender (..), MimeUnrender,
5858 NoContent, QueryFlag, QueryParam,
59− QueryParams, Raw, ReflectMethod(..),
59+ QueryParams, Raw, ReflectMethod (..),
6060 RemoteHost, ReqBody,
61− ToHttpApiData(..), Vault, Verb)
61+ ToHttpApiData (..), Vault, Verb,
62+ contentType)
63+import Servant.API.Description (Summary)
6264import qualified Servant.Auth as Auth
6365
6466import Reflex.Dom.Core (Dynamic, Event, Reflex,
65− XhrRequest(..),
66− XhrResponseHeaders(..),
67− XhrResponse(..), attachPromptlyDynWith, constDyn, ffor, fmapMaybe,
68− leftmost, performRequestsAsync,
69− )
67+ XhrRequest (..), XhrResponse (..),
68+ XhrResponseHeaders (..),
69+ attachPromptlyDynWith, constDyn, ffor,
70+ fmapMaybe, leftmost,
71+ performRequestsAsync)
7072------------------------------------------------------------------------------
7173import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
7274 showBaseUrl,
7375 SupportsServantReflex)
74−import Servant.Common.Req (ClientOptions(..), MimeUnrender(..),
76+import Servant.Common.Req (ClientOptions(..),
7577 defaultClientOptions,
7678 Req, ReqResult(..), QParam(..),
7779 QueryPart(..), addHeader, authData,
@@ -87,8 +89,6 @@ import Servant.Common.Req (ClientOptions(..), MimeUnrender(..),
8789 response,
8890 reqTag,
8991 qParams, withCredentials)
90−import Servant.Checked.Exceptions.Internal.Envelope (Envelope)
91−import Servant.Checked.Exceptions.Internal.Servant.API (NoThrow, Throws, Throwing, ThrowingNonterminal)
9292
9393
9494-- * Accessing APIs as a Client
@@ -103,7 +103,7 @@ import Servant.Checked.Exceptions.Internal.Servant.API (NoThrow, Throws, Throwin
103103-- >
104104-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))
105105-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l
106−-- -> m (Event t (l, ReqResult Book)))
106+-- > -> m (Event t (l, ReqResult Book)))
107107-- > (getAllBooks :<|> postNewBook) = client myApi host
108108-- > where host = constDyn $ BaseUrl Http "localhost" 8080
109109client
@@ -228,22 +228,26 @@ instance {-# OVERLAPPING #-}
228228
229229toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a)
230230toHeaders r =
231− let toBS = E.encodeUtf8
232− hdrs = maybe []
233− (\xhr -> fmap (\(h,v) -> (mk (toBS h), toBS v))
231+ let hdrs = maybe []
232+ (\xhr -> fmap (\(h,v) -> (CI.map E.encodeUtf8 h, E.encodeUtf8 v))
234233 (Map.toList $ _xhrResponse_headers xhr))
235234 (response r)
236235 in ffor r $ \a -> Headers {getResponse = a ,getHeadersHList = buildHeadersTo hdrs}
237236
237+
238238class BuildHeaderKeysTo hs where
239− buildHeaderKeysTo :: Proxy hs -> [T.Text]
239+ buildHeaderKeysTo :: Proxy hs -> [CI.CI T.Text]
240240
241241instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[]
242242 where buildHeaderKeysTo _ = []
243243
244244instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)
245245 => BuildHeaderKeysTo ((Header h v) ': xs) where
246− buildHeaderKeysTo _ = T.pack (symbolVal (Proxy :: Proxy h)) : buildHeaderKeysTo (Proxy :: Proxy xs)
246+ buildHeaderKeysTo _ =
247+ let
248+ thisKey = CI.mk $ T.pack (symbolVal (Proxy :: Proxy h))
249+ in thisKey : buildHeaderKeysTo (Proxy :: Proxy xs)
250+
247251
248252-- HEADERS Verb (Content) --
249253-- Headers combinator not treated in fully general case,
@@ -325,6 +329,19 @@ instance HasClient t m sublayout tag
325329 clientWithRouteAndResultHandler Proxy =
326330 clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)
327331
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+
344+
328345
329346-- | If you use a 'QueryParam' in one of your endpoints in your API,
330347-- the corresponding querying function will automatically take
@@ -606,143 +623,3 @@ type family HasCookieAuth xs :: Constraint where
606623
607624class CookieAuthNotEnabled
608625
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−