reflex-gadt-api 0.2.2.3 → 0.3.0.0
raw patch · 5 files changed
+47/−17 lines, 5 filesdep −bytestring
Dependencies removed: bytestring
Files
- ChangeLog.md +4/−0
- Readme.lhs +8/−1
- Readme.md +8/−1
- reflex-gadt-api.cabal +4/−5
- src/Reflex/Dom/GadtApi/XHR.hs +23/−10
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for reflex-gadt-api +## 0.3.0.0++* *Breaking*: switch to a more useful xhr error response type. To retain the current behavior, you must convert `Either XhrResponse` to `Either Text`. See `Readme.lhs` for an example using `xhrErrorToText`.+ ## 0.2.2.3 * Support GHC 9.12
Readme.lhs view
@@ -150,10 +150,17 @@ ```haskell > responses <- case endpoint of-> Left xhr -> performXhrRequests xhr (requests :: Event t (RequesterData CatApi))+> Left xhr -> do+> r <- performXhrRequests xhr (requests :: Event t (RequesterData CatApi))+> performEvent $ ffor r $ traverseRequesterData $ \x ->+> pure $ mapLeft xhrErrorToText x > Right ws -> performWebSocketRequests ws (requests :: Event t (RequesterData CatApi)) > pure () > where+> mapLeft f = \case+> Right a -> Right a+> Left x -> Left $ f x+> ```
Readme.md view
@@ -150,10 +150,17 @@ ```haskell > responses <- case endpoint of-> Left xhr -> performXhrRequests xhr (requests :: Event t (RequesterData CatApi))+> Left xhr -> do+> r <- performXhrRequests xhr (requests :: Event t (RequesterData CatApi))+> performEvent $ ffor r $ traverseRequesterData $ \x ->+> pure $ mapLeft xhrErrorToText x > Right ws -> performWebSocketRequests ws (requests :: Event t (RequesterData CatApi)) > pure () > where+> mapLeft f = \case+> Right a -> Right a+> Left x -> Left $ f x+> ```
reflex-gadt-api.cabal view
@@ -1,12 +1,12 @@-cabal-version: >=1.10+cabal-version: 3.0 name: reflex-gadt-api-version: 0.2.2.3+version: 0.3.0.0 synopsis: Interact with a GADT API in your reflex-dom application. description: This package is designed to be used in full-stack Haskell applications where the API is defined as a GADT and the frontend is using reflex-dom. bug-reports: https://github.com/reflex-frp/reflex-gadt-api/issues-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Obsidian Systems maintainer: maintainer@obsidian.systems@@ -17,7 +17,7 @@ ChangeLog.md Readme.md -tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.8.2 || ==9.10.1 || ==9.12.1+tested-with: GHC ==8.10.7 || ==9.10 || ==9.12 library hs-source-dirs: src, .@@ -25,7 +25,6 @@ aeson >=1.4.4 && <2.3 , aeson-gadt-th >=0.2.4 && <0.3 , base >=4.12 && <4.22- , bytestring >=0.10.8 && <0.13 , constraints-extras >=0.3.0 && <0.5 , containers >=0.6 && <0.8 , data-default >=0.6 && <0.9
src/Reflex/Dom/GadtApi/XHR.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}@@ -9,11 +10,10 @@ import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson-import qualified Data.ByteString.Lazy as LBS import Data.Constraint.Extras (Has, has) import Data.Functor (void) import Data.Text (Text)-import qualified Data.Text.Encoding as T+import GHC.Generics import Language.Javascript.JSaddle (MonadJSM) import Language.Javascript.JSaddle.Monad (runJSM, askJSM) import Reflex.Dom.Core@@ -38,13 +38,28 @@ ) => ApiEndpoint -> Event t (RequesterData api)- -> m (Event t (RequesterData (Either Text)))+ -> m (Event t (RequesterData (Either XhrError))) performXhrRequests apiUrl req = fmap switchPromptlyDyn $ prerender (pure never) $ do performEventAsync $ ffor req $ \r yield -> do ctx <- askJSM void $ liftIO $ forkIO $ flip runJSM ctx $ liftIO . yield =<< apiRequestXhr apiUrl r +data XhrError = XhrError+ { _xhrError_request :: XhrRequest Text+ , _xhrError_response :: XhrResponse+ }+ deriving (Generic)++xhrErrorToText :: XhrError -> Text+xhrErrorToText e =+ let+ status = _xhrResponse_statusText . _xhrError_response $ e+ rsp = _xhrResponse_responseText . _xhrError_response $ e+ in status <> case rsp of+ Nothing -> ""+ Just r -> ": " <> r+ -- | Encodes an API request as JSON and issues an 'XhrRequest', -- and attempts to decode the response. apiRequestXhr@@ -56,21 +71,19 @@ ) => ApiEndpoint -> RequesterData api- -> m (RequesterData (Either Text))+ -> m (RequesterData (Either XhrError)) apiRequestXhr apiUrl = traverseRequesterData $ \x -> has @FromJSON @api x $ mkRequest x where mkRequest :: (MonadJSM m, FromJSON b) => api b- -> m (Either Text b)+ -> m (Either XhrError b) mkRequest req = do response <- liftIO newEmptyMVar- _ <- newXMLHttpRequest (postJson apiUrl req) $- liftIO . putMVar response+ let request = postJson apiUrl req+ _ <- newXMLHttpRequest request $ liftIO . putMVar response xhrResp <- liftIO $ takeMVar response case decodeXhrResponse xhrResp of- Nothing -> pure $ Left $- "Response could not be decoded for request: " <>- T.decodeUtf8 (LBS.toStrict $ encode req)+ Nothing -> pure $ Left $ XhrError request xhrResp Just r -> pure $ Right r