mirror of
https://github.com/ilyakooo0/servant-reflex.git
synced 2024-09-11 07:15:29 +03:00
inline performAJAX
This commit is contained in:
parent
19b3e44eab
commit
11e01e767f
@ -55,7 +55,7 @@ data ServantError
|
||||
deriving (Show, Typeable)
|
||||
|
||||
instance Exception ServantError
|
||||
|
||||
|
||||
data Req = Req
|
||||
{ reqPath :: String
|
||||
, qs :: QueryText
|
||||
@ -129,18 +129,19 @@ performRequestNoBody = undefined
|
||||
-- performRequest :: Method -> Req -> BaseUrl -> Manager
|
||||
-- -> ExceptT ServantError IO ( Int, ByteString, MediaType
|
||||
-- , [HTTP.Header], Response ByteString)
|
||||
-- performRequest :: MonadWidget t m => Method -> Req -> BaseUrl ->
|
||||
-- performRequest reqMethod req reqHost manager = do
|
||||
-- partialRequest <- liftIO $ reqToRequest req reqHost
|
||||
|
||||
--
|
||||
-- let request = partialRequest { Client.method = reqMethod
|
||||
-- , checkStatus = \ _status _headers _cookies -> Nothing
|
||||
-- }
|
||||
|
||||
--
|
||||
-- eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager
|
||||
-- case eResponse of
|
||||
-- Left err ->
|
||||
-- throwE . ConnectionError $ SomeException err
|
||||
|
||||
--
|
||||
-- Right response -> do
|
||||
-- let status = Client.responseStatus response
|
||||
-- body = Client.responseBody response
|
||||
@ -151,7 +152,7 @@ performRequestNoBody = undefined
|
||||
-- Just t -> case parseAccept t of
|
||||
-- Nothing -> throwE $ InvalidContentTypeHeader (cs t) body
|
||||
-- Just t' -> pure t'
|
||||
-- unless (status_code >= 200 && status_code < 300) $
|
||||
-- unless (status_code >= 200 && status_code < 300) $
|
||||
-- throwE $ FailureResponse status ct body
|
||||
-- return (status_code, body, ct, hrds, response)
|
||||
|
||||
|
@ -84,20 +84,36 @@ class HasReflexClient layout where
|
||||
-> Client (Input layout) (Output layout)
|
||||
|
||||
|
||||
-- -- | If you have a 'Get' endpoint in your API, the client
|
||||
-- -- side querying function that is created when calling 'client'
|
||||
-- -- will just require an argument that specifies the scheme, host
|
||||
-- -- and port to send the request to.
|
||||
-- instance
|
||||
-- #if MIN_VERSION_base(4,8,0)
|
||||
-- {-# OVERLAPPABLE #-}
|
||||
-- #endif
|
||||
-- (MimeUnrender ct result) => HasReflexClient (Get (ct ': cts) result) where
|
||||
-- type Input (Get (ct ': cts) result) = ()
|
||||
-- -- type Output (Get (ct' : cts) result) = result
|
||||
-- type Client (Get (ct ': cts) result) = Final result
|
||||
-- clientWithRoute Proxy req baseurl _ =
|
||||
-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl
|
||||
-- | If you have a 'Get' endpoint in your API, the client
|
||||
-- side querying function that is created when calling 'client'
|
||||
-- will just require an argument that specifies the scheme, host
|
||||
-- and port to send the request to.
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPABLE #-}
|
||||
#endif
|
||||
(MimeUnrender ct result) => HasReflexClient (Get (ct ': cts) result) where
|
||||
type Input (Get (ct ': cts) result) = ()
|
||||
type Output (Get (ct' : cts) result) = result
|
||||
clientWithRoute Proxy req baseurl trigEvents = performAJAX requestBuilder responseParser
|
||||
where
|
||||
requestBuilder _ = XhrRequest "GET" (showBaseUrl baseurl) def
|
||||
responseParser xhrResp =
|
||||
|
||||
performAJAX
|
||||
:: (MonadWidget t m)
|
||||
=> (a -> XhrRequest)
|
||||
-- ^ Function to build the request
|
||||
-> (XhrResponse -> b)
|
||||
-- ^ Function to parse the response
|
||||
-> Event t a
|
||||
-> m (Event t (a, b))
|
||||
performAJAX mkRequest parseResponse req =
|
||||
performEventAsync $ ffor req $ \a cb -> do
|
||||
_ <- newXMLHttpRequest (mkRequest a) $ \response ->
|
||||
liftIO $ cb (a, parseResponse response)
|
||||
return ()
|
||||
|
||||
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
@ -106,7 +122,6 @@ instance
|
||||
HasReflexClient (Get (ct ': cts) ()) where
|
||||
type Input (Get (ct ': cts) ()) = ()
|
||||
type Output (Get (ct ': cts) ()) = ()
|
||||
-- type Client (Get (ct ': cts) ()) = Final ()
|
||||
clientWithRoute Proxy req baseurl trigEvents =
|
||||
performAJAX requestBuilder responseParser trigEvents
|
||||
where
|
||||
|
Loading…
Reference in New Issue
Block a user