@@ -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,136 +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 (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− clientWithRoute
618− :: Proxy (Throws e :> api)
619− -> Proxy m
620− -> Proxy tag
621− -> Req t
622− -> Dynamic t BaseUrl
623− -> ClientOptions
624− -> Client t m (Throwing '[e] :> api) tag
625− clientWithRoute _ = clientWithRoute (Proxy :: Proxy (Throwing '[e] :> api))
626−
627−-- | When @'Throwing' es@ comes before a 'Verb', change it into the same 'Verb'
628−-- but returning an @'Envelope' es@.
629−instance (HasClient t m (Verb method status ctypes (Envelope es a)) tag) =>
630− HasClient t m (Throwing es :> Verb method status ctypes a) tag where
631−
632− type Client t m (Throwing es :> Verb method status ctypes a) tag =
633− Client t m (Verb method status ctypes (Envelope es a)) tag
634−
635− clientWithRoute
636− :: Proxy (Throwing es :> Verb method status ctypes a)
637− -> Proxy m
638− -> Proxy tag
639− -> Req t
640− -> Dynamic t BaseUrl
641− -> ClientOptions
642− -> Client t m (Verb method status ctypes (Envelope es a)) tag
643− clientWithRoute Proxy =
644− clientWithRoute (Proxy :: Proxy (Verb method status ctypes (Envelope es a)))
645−
646−-- | When 'NoThrow' comes before a 'Verb', change it into the same 'Verb'
647−-- but returning an @'Envelope' \'[]@.
648−instance (HasClient t m (Verb method status ctypes (Envelope '[] a)) tag) =>
649− HasClient t m (NoThrow :> Verb method status ctypes a) tag where
650−
651− type Client t m (NoThrow :> Verb method status ctypes a) tag =
652− Client t m (Verb method status ctypes (Envelope '[] a)) tag
653−
654− clientWithRoute
655− :: Proxy (NoThrow :> Verb method status ctypes a)
656− -> Proxy m
657− -> Proxy tag
658− -> Req t
659− -> Dynamic t BaseUrl
660− -> ClientOptions
661− -> Client t m (Verb method status ctypes (Envelope '[] a)) tag
662− clientWithRoute Proxy =
663− clientWithRoute (Proxy :: Proxy (Verb method status ctypes (Envelope '[] a)))
664−
665−-- | When @'Throwing' es@ comes before ':<|>', push @'Throwing' es@ into each
666−-- branch of the API.
667−instance HasClient t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag =>
668− HasClient t m (Throwing es :> (api1 :<|> api2)) tag where
669−
670− type Client t m (Throwing es :> (api1 :<|> api2)) tag =
671− Client t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag
672−
673− clientWithRoute
674− :: Proxy (Throwing es :> (api1 :<|> api2))
675− -> Proxy m
676− -> Proxy tag
677− -> Req t
678− -> Dynamic t BaseUrl
679− -> ClientOptions
680− -> Client t m ((Throwing es :> api1) :<|> (Throwing es :> api2)) tag
681− clientWithRoute _ =
682− clientWithRoute (Proxy :: Proxy ((Throwing es :> api1) :<|> (Throwing es :> api2)))
683−
684−-- | When 'NoThrow' comes before ':<|>', push 'NoThrow' into each branch of the
685−-- API.
686−instance HasClient t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag =>
687− HasClient t m (NoThrow :> (api1 :<|> api2)) tag where
688−
689− type Client t m (NoThrow :> (api1 :<|> api2)) tag =
690− Client t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag
691−
692− clientWithRoute
693− :: Proxy (NoThrow :> (api1 :<|> api2))
694− -> Proxy m
695− -> Proxy tag
696− -> Req t
697− -> Dynamic t BaseUrl
698− -> ClientOptions
699− -> Client t m ((NoThrow :> api1) :<|> (NoThrow :> api2)) tag
700− clientWithRoute _ =
701− clientWithRoute (Proxy :: Proxy ((NoThrow :> api1) :<|> (NoThrow :> api2)))
702−
703−-- | When a @'Throws' e@ comes immediately after a @'Throwing' es@, 'Snoc' the
704−-- @e@ onto the @es@. Otherwise, if @'Throws' e@ comes before any other
705−-- combinator, push it down so it is closer to the 'Verb'.
706−instance HasClient t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag =>
707− HasClient t m (Throwing es :> api :> apis) tag where
708−
709− type Client t m (Throwing es :> api :> apis) tag =
710− Client t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag
711−
712− clientWithRoute
713− :: Proxy (Throwing es :> api :> apis)
714− -> Proxy m
715− -> Proxy tag
716− -> Req t
717− -> Dynamic t BaseUrl
718− -> ClientOptions
719− -> Client t m (ThrowingNonterminal (Throwing es :> api :> apis)) tag
720− clientWithRoute _ =
721− clientWithRoute (Proxy :: Proxy (ThrowingNonterminal (Throwing es :> api :> apis)))
722−
723−-- | When 'NoThrow' comes before any other combinator, push it down so it is
724−-- closer to the 'Verb'.
725−instance HasClient t m (api :> NoThrow :> apis) tag =>
726− HasClient t m (NoThrow :> api :> apis) tag where
727−
728− type Client t m (NoThrow :> api :> apis) tag =
729− Client t m (api :> NoThrow :> apis) tag
730−
731− clientWithRoute
732− :: Proxy (NoThrow :> api :> apis)
733− -> Proxy m
734− -> Proxy tag
735− -> Req t
736− -> Dynamic t BaseUrl
737− -> ClientOptions
738− -> Client t m (api :> NoThrow :> apis) tag
739− clientWithRoute _ =
740− clientWithRoute (Proxy :: Proxy (api :> NoThrow :> apis))
741−