Merge pull request #7 from sambnt/master

Update for new GHC JS backend

Author: fisx

servant-jsaddle.cabal

@@ -1,5 +1,5 @@
 name:               servant-jsaddle
-version:            0.16
+version:            0.17
 synopsis:
   automatic derivation of querying functions for servant webservices for jsaddle
 
@@ -46,29 +46,29 @@ library
   -- Bundled with GHC: Lower bound to not force re-installs
   -- text and mtl are bundled starting with GHC-8.4
   build-depends:
-      base          >=4.9      && <4.14
-    , bytestring    >=0.10.8.1 && <0.11
+      base          >=4.9      && <5
+    , bytestring    >=0.10.8.1 && <0.13
     , containers    >=0.5.7.1  && <0.7
-    , mtl           >=2.2.2    && <2.3
-    , text          >=1.2.3.0  && <1.3
-    , transformers  >=0.5.2.0  && <0.6
+    , mtl           >=2.2.2    && <2.4
+    , text          >=1.2.3.0  && <2.2
+    , transformers  >=0.5.2.0  && <0.7
 
-  if impl(ghcjs -any)
+  if impl(ghcjs -any) || arch(javascript)
     build-depends: ghcjs-base
 
   -- Servant dependencies.
   -- Strict dependency on `servant-client-core` as we re-export things.
-  build-depends:    servant-client-core >=0.16 && <0.16.1
+  build-depends:    servant-client-core >=0.16 && <0.21
   build-depends:
-      base-compat         >=0.10.5  && <0.12
+      base-compat         >=0.10.5 && <=0.13.1
     , case-insensitive    >=1.2.0.0 && <1.3
     , exceptions          >=0.10.0  && <0.11
     , ghcjs-dom           >=0.9.4.0 && <0.10
     , http-media          >=0.7.1.3 && <0.9
     , http-types          >=0.12.2  && <0.13
     , jsaddle             >=0.9.6.0 && <0.10
     , monad-control       >=1.0.2.3 && <1.1
-    , semigroupoids       >=5.3.1   && <5.4
+    , semigroupoids       >=5.3.1   && <6.1
     , string-conversions  >=0.3     && <0.5
     , transformers-base   >=0.4.4   && <0.5
 
@@ -82,7 +82,7 @@ test-suite spec
   hs-source-dirs:   test
   main-is:          Spec.hs
 
-  if impl(ghcjs -any)
+  if impl(ghcjs -any) || arch(javascript)
     build-depends:
         base
       , servant-jsaddle

src/Servant/Client/Internal/JSaddleXhrClient.hs

@@ -48,6 +48,8 @@ import           Data.Foldable
                  (toList)
 import           Data.Functor.Alt
                  (Alt (..))
+import           Data.Maybe
+                 (fromMaybe)
 import           Data.Proxy
                  (Proxy (..))
 import qualified Data.Sequence                     as Seq
@@ -70,7 +72,7 @@ import qualified Language.Javascript.JSaddle.Types as JSaddle
 import           Network.HTTP.Media
                  (renderHeader)
 import           Network.HTTP.Types
-                 (ResponseHeaders, http11, mkStatus, renderQuery, statusCode)
+                 (ResponseHeaders, Status, http11, mkStatus, renderQuery, statusCode)
 import           System.IO
                  (hPutStrLn, stderr)
 
@@ -120,9 +122,15 @@ instance Alt ClientM where
 
 instance RunClient ClientM where
   throwClientError = throwError
+#if MIN_VERSION_servant_client_core(0,18,1)
+  runRequestAcceptStatus acceptStatuses r = do
+    d <- ClientM askDOM
+    performRequest (fromMaybe [] acceptStatuses) d r
+#else
   runRequest r = do
     d <- ClientM askDOM
-    performRequest d r
+    performRequest [] d r
+#endif
 
 runClientM :: ClientM a -> ClientEnv -> DOM (Either ClientError a)
 runClientM cm env = runExceptT $ flip runReaderT env $ fromClientM cm
@@ -156,16 +164,16 @@ getDefaultBaseUrl = do
 
     pure (BaseUrl protocol hostname port "")
 
-performRequest :: DOMContext -> Request -> ClientM Response
-performRequest domc req = do
+performRequest :: [Status] -> DOMContext -> Request -> ClientM Response
+performRequest acceptStatuses domc req = do
   xhr <- JS.newXMLHttpRequest `runDOM` domc
   burl <- asks baseUrl
   fixUp <- asks fixUpXhr
   performXhr xhr burl req fixUp `runDOM` domc
   resp <- toResponse domc xhr
 
   let status = statusCode (responseStatusCode resp)
-  unless (status >= 200 && status < 300) $
+  unless ((status >= 200 && status < 300) || status `elem` (statusCode <$> acceptStatuses)) $
         throwError $ mkFailureResponse burl req resp
 
   pure resp