Merge pull request #106 from natefaubion/aff-updates

Updates for Aff 4.0

Author: natefaubion

bower.json

@@ -23,7 +23,7 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-aff": "^3.0.0",
+    "purescript-aff": "^4.0.0",
     "purescript-argonaut-core": "^3.0.0",
     "purescript-arraybuffer-types": "^1.0.0",
     "purescript-dom": "^4.0.0",

package.json

@@ -2,7 +2,7 @@
   "private": true,
   "scripts": {
     "clean": "rimraf output && rimraf .pulp-cache",
-    "build": "eslint src && pulp build --censor-lib --strict",
+    "build": "eslint src && pulp build -- --censor-lib --strict",
     "test": "eslint src && pulp test"
   },
   "devDependencies": {

src/Network/HTTP/Affjax.js

@@ -4,10 +4,7 @@
 /* global process */
 "use strict";
 
-// module Network.HTTP.Affjax
-
-// jshint maxparams: 5
-exports._ajax = function (mkHeader, options, canceler, errback, callback) {
+exports._ajax = function () {
   var platformSpecific = { };
   if (typeof module !== "undefined" && module.require && !(typeof process !== "undefined" && process.versions["electron"])) {
     // We are on node.js
@@ -42,49 +39,52 @@ exports._ajax = function (mkHeader, options, canceler, errback, callback) {
     };
   }
 
-  return function () {
-    var xhr = platformSpecific.newXHR();
-    var fixedUrl = platformSpecific.fixupUrl(options.url);
-    xhr.open(options.method || "GET", fixedUrl, true, options.username, options.password);
-    if (options.headers) {
-      try {
-        for (var i = 0, header; (header = options.headers[i]) != null; i++) {
-          xhr.setRequestHeader(header.field, header.value);
+  return function (mkHeader, options) {
+    return function (errback, callback) {
+      var xhr = platformSpecific.newXHR();
+      var fixedUrl = platformSpecific.fixupUrl(options.url);
+      xhr.open(options.method || "GET", fixedUrl, true, options.username, options.password);
+      if (options.headers) {
+        try {
+          for (var i = 0, header; (header = options.headers[i]) != null; i++) {
+            xhr.setRequestHeader(header.field, header.value);
+          }
+        } catch (e) {
+          errback(e);
         }
       }
-      catch (e) {
-        errback(e)();
-      }
-    }
-    xhr.onerror = function () {
-      errback(new Error("AJAX request failed: " + options.method + " " + options.url))();
-    };
-    xhr.onload = function () {
-      callback({
-        status: xhr.status,
-        headers: xhr.getAllResponseHeaders().split("\r\n")
-          .filter(function (header) {
-            return header.length > 0;
-          })
-          .map(function (header) {
-            var i = header.indexOf(":");
-            return mkHeader(header.substring(0, i))(header.substring(i + 2));
-          }),
-        response: platformSpecific.getResponse(xhr)
-      })();
-    };
-    xhr.responseType = options.responseType;
-    xhr.withCredentials = options.withCredentials;
-    xhr.send(options.content);
-    return canceler(xhr);
-  };
-};
+      xhr.onerror = function () {
+        errback(new Error("AJAX request failed: " + options.method + " " + options.url));
+      };
+      xhr.onload = function () {
+        callback({
+          status: xhr.status,
+          headers: xhr.getAllResponseHeaders().split("\r\n")
+            .filter(function (header) {
+              return header.length > 0;
+            })
+            .map(function (header) {
+              var i = header.indexOf(":");
+              return mkHeader(header.substring(0, i))(header.substring(i + 2));
+            }),
+          response: platformSpecific.getResponse(xhr)
+        });
+      };
+      xhr.responseType = options.responseType;
+      xhr.withCredentials = options.withCredentials;
+      xhr.send(options.content);
 
-// jshint maxparams: 4
-exports._cancelAjax = function (xhr, cancelError, errback, callback) {
-  return function () {
-    try { xhr.abort(); } catch (e) { return callback(false)(); }
-    return callback(true)();
+      return function (/* error */) {
+        return function (cancelErrback, cancelCallback) {
+          try {
+            xhr.abort();
+          } catch (e) {
+            return cancelErrback(e);
+          }
+          return cancelCallback();
+        };
+      };
+    };
   };
-};
+}();
 

src/Network/HTTP/Affjax.purs

@@ -5,7 +5,6 @@ module Network.HTTP.Affjax
   , AffjaxResponse
   , URL
   , affjax
-  , affjax'
   , get
   , post, post_, post', post_'
   , put, put_, put', put_'
@@ -19,21 +18,22 @@ module Network.HTTP.Affjax
 
 import Prelude hiding (max)
 
-import Control.Monad.Aff (Aff, makeAff, makeAff', Canceler(..), attempt, delay, forkAff, cancel)
-import Control.Monad.Aff.AVar (AVAR, makeVar, takeVar, putVar)
-import Control.Monad.Eff (kind Effect, Eff)
+import Control.Monad.Aff (Aff, try, delay)
+import Control.Monad.Aff.Compat as AC
+import Control.Monad.Eff (kind Effect)
 import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Eff.Exception (Error, error)
 import Control.Monad.Eff.Ref (REF, newRef, readRef, writeRef)
 import Control.Monad.Except (runExcept, throwError)
+import Control.Parallel (parOneOf)
 
 import Data.Argonaut.Parser (jsonParser)
 import Data.Array as Arr
 import Data.Either (Either(..), either)
 import Data.Foldable (any)
 import Data.Foreign (F, Foreign, ForeignError(JSONError), fail, readString, toForeign)
 import Data.Function (on)
-import Data.Function.Uncurried (Fn5, runFn5, Fn4, runFn4)
+import Data.Function.Uncurried (Fn2, runFn2)
 import Data.HTTP.Method (Method(..), CustomMethod)
 import Data.HTTP.Method as Method
 import Data.Int (toNumber)
@@ -45,8 +45,6 @@ import Data.Tuple (Tuple(..), fst, snd)
 
 import Math (max, pow)
 
-import DOM.XHR.Types (XMLHttpRequest)
-
 import Network.HTTP.Affjax.Request (class Requestable, RequestContent, toRequest)
 import Network.HTTP.Affjax.Response (class Respondable, ResponseContent, ResponseType(..), fromResponse, responseType, responseTypeToString)
 import Network.HTTP.RequestHeader (RequestHeader(..), requestHeaderName, requestHeaderValue)
@@ -90,10 +88,6 @@ type AffjaxResponse a =
 -- | Type alias for URL strings to aid readability of types.
 type URL = String
 
--- | Makes an `Affjax` request.
-affjax :: forall e a b. Requestable a => Respondable b => AffjaxRequest a -> Affjax e b
-affjax = makeAff' <<< affjax'
-
 -- | Makes a `GET` request to the specified URL.
 get :: forall e a. Respondable a => URL -> Affjax e a
 get u = affjax $ defaultRequest { url = u }
@@ -186,23 +180,16 @@ retry
   :: forall e a b
    . Requestable a
   => RetryPolicy
-  -> (AffjaxRequest a -> Affjax (avar :: AVAR, ref :: REF | e) b)
-  -> (AffjaxRequest a -> Affjax (avar :: AVAR, ref :: REF | e) b)
+  -> (AffjaxRequest a -> Affjax (ref :: REF | e) b)
+  -> (AffjaxRequest a -> Affjax (ref :: REF | e) b)
 retry policy run req = do
   -- failureRef is either an exception or a failed request
   failureRef <- liftEff $ newRef Nothing
   let loop = go failureRef
   case policy.timeout of
     Nothing -> loop 1
     Just timeout -> do
-      respVar <- makeVar
-      loopHandle <- forkAff $ loop 1 >>= putVar respVar <<< Just
-      timeoutHandle <-
-        forkAff $ do
-          delay timeout
-          putVar respVar Nothing
-          loopHandle `cancel` error "Cancel"
-      result <- takeVar respVar
+      result <- parOneOf [ Just <$> loop 1, Nothing <$ delay timeout ]
       case result of
         Nothing -> do
           failure <- liftEff $ readRef failureRef
@@ -225,25 +212,26 @@ retry policy run req = do
             Right resp
 
     go failureRef n = do
-      result <- retryState <$> attempt (run req)
+      result <- retryState <$> try (run req)
       case result of
         Left err -> do
           liftEff $ writeRef failureRef $ Just err
           delay (policy.delayCurve n)
           go failureRef (n + 1)
         Right resp -> pure resp
 
--- | Run a request directly without using `Aff`.
-affjax'
+-- | Makes an `Affjax` request.
+affjax
   :: forall e a b
    . Requestable a
   => Respondable b
   => AffjaxRequest a
-  -> (Error -> Eff (ajax :: AJAX | e) Unit)
-  -> (AffjaxResponse b -> Eff (ajax :: AJAX | e) Unit)
-  -> Eff (ajax :: AJAX | e) (Canceler (ajax :: AJAX | e))
-affjax' req eb cb =
-  runFn5 _ajax responseHeader req' cancelAjax eb cb'
+  -> Affjax e b
+affjax req = do
+  res <- AC.fromEffFnAff $ runFn2 _ajax responseHeader req'
+  case res { response = _  } <$> runExcept (fromResponse' res.response) of
+    Left err -> throwError $ error (show err)
+    Right res' -> pure res'
   where
 
   req' :: AjaxRequest
@@ -277,11 +265,6 @@ affjax' req eb cb =
     Just h | not $ any (on eq requestHeaderName h) hs -> hs `Arr.snoc` h
     _ -> hs
 
-  cb' :: AffjaxResponse ResponseContent -> Eff (ajax :: AJAX | e) Unit
-  cb' res = case res { response = _  } <$> runExcept (fromResponse' res.response) of
-    Left err -> eb $ error (show err)
-    Right res' -> cb res'
-
   parseJSON :: String -> F Foreign
   parseJSON = either (fail <<< JSONError) (pure <<< toForeign) <<< jsonParser
 
@@ -301,20 +284,4 @@ type AjaxRequest =
   , withCredentials :: Boolean
   }
 
-foreign import _ajax
-  :: forall e. Fn5 (String -> String -> ResponseHeader)
-               AjaxRequest
-               (XMLHttpRequest -> Canceler (ajax :: AJAX | e))
-               (Error -> Eff (ajax :: AJAX | e) Unit)
-               (AffjaxResponse Foreign -> Eff (ajax :: AJAX | e) Unit)
-               (Eff (ajax :: AJAX | e) (Canceler (ajax :: AJAX | e)))
-
-cancelAjax :: forall e. XMLHttpRequest -> Canceler (ajax :: AJAX | e)
-cancelAjax xhr = Canceler \err -> makeAff (\eb cb -> runFn4 _cancelAjax xhr err eb cb)
-
-foreign import _cancelAjax
-  :: forall e. Fn4 XMLHttpRequest
-                   Error
-                   (Error -> Eff (ajax :: AJAX | e) Unit)
-                   (Boolean -> Eff (ajax :: AJAX | e) Unit)
-                   (Eff (ajax :: AJAX | e) Unit)
+foreign import _ajax :: forall e. Fn2 (String -> String -> ResponseHeader) AjaxRequest (AC.EffFnAff (ajax :: AJAX | e) (AffjaxResponse Foreign))

test/Main.purs

@@ -3,14 +3,15 @@ module Test.Main where
 import Prelude
 import Control.Monad.Aff.Console as A
 import Network.HTTP.Affjax as AX
-import Control.Monad.Aff (Aff, cancel, forkAff, attempt, runAff, makeAff)
+import Control.Monad.Aff (Aff, forkAff, attempt, runAff, killFiber)
 import Control.Monad.Aff.AVar (AVAR)
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Class (liftEff)
 import Control.Monad.Eff.Console (CONSOLE, log, logShow)
 import Control.Monad.Eff.Exception (EXCEPTION, error, throwException)
 import Control.Monad.Eff.Ref (REF)
-import Data.Either (Either(..))
+import Control.Monad.Error.Class (throwError)
+import Data.Either (Either(..), either)
 import Data.Foreign (Foreign, unsafeFromForeign)
 import Data.Maybe (Maybe(..))
 import Data.Time.Duration (Milliseconds(..))
@@ -24,7 +25,7 @@ logAny' = liftEff <<< logAny
 type Assert e a = Aff (exception :: EXCEPTION, console :: CONSOLE, ajax :: AX.AJAX | e) a
 
 assertFail :: forall e a. String -> Assert e a
-assertFail msg = makeAff \errback _ -> errback (error msg)
+assertFail = throwError <<< error
 
 assertMsg :: forall e. String -> Boolean -> Assert e Unit
 assertMsg _ true = pure unit
@@ -57,7 +58,7 @@ type MainEffects e =
   )
 
 main :: Eff (MainEffects (ajax :: AX.AJAX)) Unit
-main = void $ runAff (\e -> logShow e >>= \_ -> throwException e) (const $ log "affjax: All good!") $ do
+main = void $ runAff (either (\e -> logShow e *> throwException e) (const $ log "affjax: All good!")) do
   let ok200 = StatusCode 200
   let notFound404 = StatusCode 404
 
@@ -112,6 +113,5 @@ main = void $ runAff (\e -> logShow e >>= \_ -> throwException e) (const $ log "
     -- assertEq (Just "test=test") (lookupHeader "Set-Cookie" res.headers)
 
   A.log "Testing cancellation"
-  canceler <- forkAff (AX.post_ mirror "do it now")
-  canceled <- canceler `cancel` error "Pull the cord!"
-  assertMsg "Should have been canceled" canceled
+  forkAff (AX.post_ mirror "do it now") >>= killFiber (error "Pull the cord!")
+  assertMsg "Should have been canceled" true