@@ -39,34 +39,36 @@ module Servant.Reflex
40------------------------------------------------------------------------------
40------------------------------------------------------------------------------
41import Control.Applicative
41import 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
46import Data.Functor.Identity
43import Data.Functor.Identity
47−import Data.Proxy (Proxy (..))
48import qualified Data.Map as Map
44import qualified Data.Map as Map
45+import Data.Monoid ((<>))
46+import Data.Proxy (Proxy (..))
47+import qualified Data.Set as Set
49import Data.Text (Text)
48import Data.Text (Text)
50import qualified Data.Text as T
49import qualified Data.Text as T
50+import qualified Data.Text.Encoding as E
51import GHC.Exts (Constraint)
51import GHC.Exts (Constraint)
52import GHC.TypeLits (KnownSymbol, symbolVal)
52import GHC.TypeLits (KnownSymbol, symbolVal)
53−import Servant.API ((:<|>)(..),(:>), BasicAuth,
53+import Servant.API ((:<|>) (..), (:>), BasicAuth,
54− BasicAuthData, BuildHeadersTo(..),
54+ BasicAuthData, BuildHeadersTo (..),
55− Capture, contentType, Header,
55+ Capture, Header, Headers (..),
56− Headers(..), HttpVersion, IsSecure,
56+ HttpVersion, IsSecure,
57− MimeRender(..), MimeUnrender,
57+ MimeRender (..), MimeUnrender,
58− NoContent, QueryFlag, QueryParam,
58+ NoContent, QueryFlag, QueryParam',
59− QueryParams, Raw, ReflectMethod(..),
59+ QueryParams, Raw, ReflectMethod (..),
60 RemoteHost, ReqBody,
60 RemoteHost, ReqBody,
61− ToHttpApiData(..), Vault, Verb)
61+ ToHttpApiData (..), Vault, Verb,
63+import Servant.API.Description (Summary)
62import qualified Servant.Auth as Auth
64import qualified Servant.Auth as Auth
64import Reflex.Dom.Core (Dynamic, Event, Reflex,
66import Reflex.Dom.Core (Dynamic, Event, Reflex,
65− XhrRequest(..),
67+ XhrRequest (..), XhrResponse (..),
66− XhrResponseHeaders(..),
68+ XhrResponseHeaders (..),
67− XhrResponse(..), attachPromptlyDynWith, constDyn, ffor, fmapMaybe,
69+ attachPromptlyDynWith, constDyn, ffor,
68− leftmost, performRequestsAsync,
71+ performRequestsAsync)
70------------------------------------------------------------------------------
72------------------------------------------------------------------------------
71import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
73import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
72 showBaseUrl,
74 showBaseUrl,
@@ -101,7 +103,7 @@ import Servant.Common.Req (ClientOptions(..),
102-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))
104-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))
103-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l
105-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l
104−-- -> m (Event t (l, ReqResult Book)))
106+-- > -> m (Event t (l, ReqResult Book)))
105-- > (getAllBooks :<|> postNewBook) = client myApi host
107-- > (getAllBooks :<|> postNewBook) = client myApi host
106-- > where host = constDyn $ BaseUrl Http "localhost" 8080
108-- > where host = constDyn $ BaseUrl Http "localhost" 8080
@@ -226,22 +228,26 @@ instance {-# OVERLAPPING #-}
227toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a)
229toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a)
228toHeaders r =
230toHeaders r =
229− let toBS = E.encodeUtf8
230− hdrs = maybe []
231+ let hdrs = maybe []
231− (\xhr -> fmap (\(h,v) -> (mk (toBS h), toBS v))
232+ (\xhr -> fmap (\(h,v) -> (CI.map E.encodeUtf8 h, E.encodeUtf8 v))
232 (Map.toList $ _xhrResponse_headers xhr))
233 (Map.toList $ _xhrResponse_headers xhr))
233 (response r)
234 (response r)
234 in ffor r $ \a -> Headers {getResponse = a ,getHeadersHList = buildHeadersTo hdrs}
235 in ffor r $ \a -> Headers {getResponse = a ,getHeadersHList = buildHeadersTo hdrs}
236class BuildHeaderKeysTo hs where
238class BuildHeaderKeysTo hs where
237− buildHeaderKeysTo :: Proxy hs -> [T.Text]
239+ buildHeaderKeysTo :: Proxy hs -> [CI.CI T.Text]
239instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[]
241instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[]
240 where buildHeaderKeysTo _ = []
242 where buildHeaderKeysTo _ = []
242instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)
244instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)
243 => BuildHeaderKeysTo ((Header h v) ': xs) where
245 => BuildHeaderKeysTo ((Header h v) ': xs) where
246+ buildHeaderKeysTo _ =
248+ thisKey = CI.mk $ T.pack (symbolVal (Proxy :: Proxy h))
244− buildHeaderKeysTo _ = T.pack (symbolVal (Proxy :: Proxy h)) : buildHeaderKeysTo (Proxy :: Proxy xs)
249+ in thisKey : buildHeaderKeysTo (Proxy :: Proxy xs)
246-- HEADERS Verb (Content) --
252-- HEADERS Verb (Content) --
247-- Headers combinator not treated in fully general case,
253-- Headers combinator not treated in fully general case,
@@ -323,6 +329,19 @@ instance HasClient t m sublayout tag
323 clientWithRouteAndResultHandler Proxy =
329 clientWithRouteAndResultHandler Proxy =
324 clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)
330 clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)
332+-- | Using a 'Summary' combinator in your API doesn't affect the client
334+instance (HasClient t m sublayout tag, KnownSymbol sym)
335+ => HasClient t m (Summary sym :> sublayout) tag where
337+ type Client t m (Summary sym :> sublayout) tag =
338+ Client t m sublayout tag
340+ clientWithRouteAndResultHandler Proxy =
341+ clientWithRouteAndResultHandler (Proxy :: Proxy sublayout)
327-- | If you use a 'QueryParam' in one of your endpoints in your API,
346-- | If you use a 'QueryParam' in one of your endpoints in your API,
328-- the corresponding querying function will automatically take
347-- the corresponding querying function will automatically take
@@ -351,9 +370,9 @@ instance HasClient t m sublayout tag
351-- > -- 'getBooksBy Nothing' for all books
370-- > -- 'getBooksBy Nothing' for all books
352-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
371-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
353instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
372instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
354− => HasClient t m (QueryParam sym a :> sublayout) tag where
373+ => HasClient t m (QueryParam' mods sym a :> sublayout) tag where
356− type Client t m (QueryParam sym a :> sublayout) tag =
375+ type Client t m (QueryParam' mods sym a :> sublayout) tag =
357 Dynamic t (QParam a) -> Client t m sublayout tag
376 Dynamic t (QParam a) -> Client t m sublayout tag
359 -- if mparam = Nothing, we don't add it to the query string
378 -- if mparam = Nothing, we don't add it to the query string
@@ -603,4 +622,3 @@ type family HasCookieAuth xs :: Constraint where
603 HasCookieAuth '[] = CookieAuthNotEnabled
622 HasCookieAuth '[] = CookieAuthNotEnabled
605class CookieAuthNotEnabled
624class CookieAuthNotEnabled