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