inline performAJAX

src/Servant/Common/Req.hs

@@ -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)
 

src/Servant/Reflex.hs

@@ -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