Updates for PureScript 0.11 (#98)

* Update for PureScript 0.11 and API changes

Use Data.Time.Duration.Milliseconds type in RetryPolicy, to go with Control.Monad.Aff.delay. Recreate the removed Data.Foreign.parseJSON locally. Update constraint syntax and kinds.

* Update dependencies

* Use Argonaut's jsonParser to implement parseJSON

Removes the need for a foreign import.

* Update test script syntax for PureScript 0.11

* v4.0.0

* Changes in response to #96

* Restore original formatting of imports

* Bump versions in package.json

Author: Nicholas Scheel

bower.json

@@ -23,21 +23,21 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-aff": "^2.0.1",
-    "purescript-argonaut-core": "^2.0.1",
-    "purescript-arraybuffer-types": "^0.2.0",
-    "purescript-dom": "^3.1.0",
-    "purescript-foreign": "^3.0.0",
-    "purescript-form-urlencoded": "^2.0.0",
-    "purescript-http-methods": "^2.0.0",
-    "purescript-integers": "^2.0.0",
+    "purescript-aff": "^3.0.0",
+    "purescript-argonaut-core": "^3.0.0",
+    "purescript-arraybuffer-types": "^1.0.0",
+    "purescript-dom": "^4.0.0",
+    "purescript-foreign": "^4.0.0",
+    "purescript-form-urlencoded": "^3.0.0",
+    "purescript-http-methods": "^3.0.0",
+    "purescript-integers": "^3.0.0",
     "purescript-math": "^2.0.0",
-    "purescript-media-types": "^2.0.0",
-    "purescript-nullable": "^2.0.0",
-    "purescript-refs": "^2.0.0",
-    "purescript-unsafe-coerce": "^2.0.0"
+    "purescript-media-types": "^3.0.0",
+    "purescript-nullable": "^3.0.0",
+    "purescript-refs": "^3.0.0",
+    "purescript-unsafe-coerce": "^3.0.0"
   },
   "devDependencies": {
-    "purescript-console": "^2.0.0"
+    "purescript-console": "^3.0.0"
   }
 }

package.json

@@ -9,9 +9,9 @@
     "eslint": "^3.10.1",
     "body-parser": "^1.15.2",
     "express": "^4.14.0",
-    "pulp": "^9.0.1",
-    "purescript-psa": "^0.3.9",
-    "purescript": "^0.10.2",
+    "pulp": "^11.0.0",
+    "purescript-psa": "^0.5.0",
+    "purescript": "^0.11.0",
     "rimraf": "^2.5.4",
     "xhr2": "^0.1.3"
   }

src/Network/HTTP/Affjax.purs

@@ -19,26 +19,28 @@ module Network.HTTP.Affjax
 
 import Prelude hiding (max)
 
-import Control.Monad.Aff (Aff, makeAff, makeAff', Canceler(..), attempt, later', forkAff, cancel)
+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 (Eff)
+import Control.Monad.Eff (kind Effect, Eff)
 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 Data.Argonaut.Parser (jsonParser)
 import Data.Array as Arr
 import Data.Either (Either(..), either)
 import Data.Foldable (any)
-import Data.Foreign (Foreign, F, parseJSON, readString)
+import Data.Foreign (F, Foreign, ForeignError(JSONError), fail, readString, toForeign)
 import Data.Function (on)
 import Data.Function.Uncurried (Fn5, runFn5, Fn4, runFn4)
 import Data.HTTP.Method (Method(..), CustomMethod)
 import Data.HTTP.Method as Method
-import Data.Int (toNumber, round)
+import Data.Int (toNumber)
 import Data.Maybe (Maybe(..))
 import Data.MediaType (MediaType)
 import Data.Nullable (Nullable, toNullable)
+import Data.Time.Duration (Milliseconds(..))
 import Data.Tuple (Tuple(..), fst, snd)
 
 import Math (max, pow)
@@ -52,7 +54,7 @@ import Network.HTTP.ResponseHeader (ResponseHeader, responseHeader)
 import Network.HTTP.StatusCode (StatusCode(..))
 
 -- | The effect type for AJAX requests made with Affjax.
-foreign import data AJAX :: !
+foreign import data AJAX :: Effect
 
 -- | The type for Affjax requests.
 type Affjax e a = Aff (ajax :: AJAX | e) (AffjaxResponse a)
@@ -89,81 +91,81 @@ type AffjaxResponse a =
 type URL = String
 
 -- | Makes an `Affjax` request.
-affjax :: forall e a b. (Requestable a, Respondable b) => AffjaxRequest a -> Affjax e b
+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 :: forall e a. Respondable a => URL -> Affjax e a
 get u = affjax $ defaultRequest { url = u }
 
 -- | Makes a `POST` request to the specified URL, sending data.
-post :: forall e a b. (Requestable a, Respondable b) => URL -> a -> Affjax e b
+post :: forall e a b. Requestable a => Respondable b => URL -> a -> Affjax e b
 post u c = affjax $ defaultRequest { method = Left POST, url = u, content = Just c }
 
 -- | Makes a `POST` request to the specified URL with the option to send data.
-post' :: forall e a b. (Requestable a, Respondable b) => URL -> Maybe a -> Affjax e b
+post' :: forall e a b. Requestable a => Respondable b => URL -> Maybe a -> Affjax e b
 post' u c = affjax $ defaultRequest { method = Left POST, url = u, content = c }
 
 -- | Makes a `POST` request to the specified URL, sending data and ignoring the
 -- | response.
-post_ :: forall e a. (Requestable a) => URL -> a -> Affjax e Unit
+post_ :: forall e a. Requestable a => URL -> a -> Affjax e Unit
 post_ = post
 
 -- | Makes a `POST` request to the specified URL with the option to send data,
 -- | and ignores the response.
-post_' :: forall e a. (Requestable a) => URL -> Maybe a -> Affjax e Unit
+post_' :: forall e a. Requestable a => URL -> Maybe a -> Affjax e Unit
 post_' = post'
 
 -- | Makes a `PUT` request to the specified URL, sending data.
-put :: forall e a b. (Requestable a, Respondable b) => URL -> a -> Affjax e b
+put :: forall e a b. Requestable a => Respondable b => URL -> a -> Affjax e b
 put u c = affjax $ defaultRequest { method = Left PUT, url = u, content = Just c }
 
 -- | Makes a `PUT` request to the specified URL with the option to send data.
-put' :: forall e a b. (Requestable a, Respondable b) => URL -> Maybe a -> Affjax e b
+put' :: forall e a b. Requestable a => Respondable b => URL -> Maybe a -> Affjax e b
 put' u c = affjax $ defaultRequest { method = Left PUT, url = u, content = c }
 
 -- | Makes a `PUT` request to the specified URL, sending data and ignoring the
 -- | response.
-put_ :: forall e a. (Requestable a) => URL -> a -> Affjax e Unit
+put_ :: forall e a. Requestable a => URL -> a -> Affjax e Unit
 put_ = put
 
 -- | Makes a `PUT` request to the specified URL with the option to send data,
 -- | and ignores the response.
-put_' :: forall e a. (Requestable a) => URL -> Maybe a -> Affjax e Unit
+put_' :: forall e a. Requestable a => URL -> Maybe a -> Affjax e Unit
 put_' = put'
 
 -- | Makes a `DELETE` request to the specified URL.
-delete :: forall e a. (Respondable a) => URL -> Affjax e a
+delete :: forall e a. Respondable a => URL -> Affjax e a
 delete u = affjax $ defaultRequest { method = Left DELETE, url = u }
 
 -- | Makes a `DELETE` request to the specified URL and ignores the response.
 delete_ :: forall e. URL -> Affjax e Unit
 delete_ = delete
 
 -- | Makes a `PATCH` request to the specified URL, sending data.
-patch :: forall e a b. (Requestable a, Respondable b) => URL -> a -> Affjax e b
+patch :: forall e a b. Requestable a => Respondable b => URL -> a -> Affjax e b
 patch u c = affjax $ defaultRequest { method = Left PATCH, url = u, content = Just c }
 
 -- | Makes a `PATCH` request to the specified URL with the option to send data.
-patch' :: forall e a b. (Requestable a, Respondable b) => URL -> Maybe a -> Affjax e b
+patch' :: forall e a b. Requestable a => Respondable b => URL -> Maybe a -> Affjax e b
 patch' u c = affjax $ defaultRequest { method = Left PATCH, url = u, content = c }
 
 -- | Makes a `PATCH` request to the specified URL, sending data and ignoring the
 -- | response.
-patch_ :: forall e a. (Requestable a) => URL -> a -> Affjax e Unit
+patch_ :: forall e a. Requestable a => URL -> a -> Affjax e Unit
 patch_ = patch
 
 -- | Makes a `PATCH` request to the specified URL with the option to send data,
 -- | and ignores the response.
-patch_' :: forall e a. (Requestable a) => URL -> Maybe a -> Affjax e Unit
+patch_' :: forall e a. Requestable a => URL -> Maybe a -> Affjax e Unit
 patch_' = patch'
 
 -- | A sequence of retry delays, in milliseconds.
-type RetryDelayCurve = Int -> Int
+type RetryDelayCurve = Int -> Milliseconds
 
 -- | Expresses a policy for retrying Affjax requests with backoff.
 type RetryPolicy =
-  { timeout :: Maybe Int -- ^ the timeout in milliseconds, optional
+  { timeout :: Maybe Milliseconds -- ^ the timeout in milliseconds, optional
   , delayCurve :: RetryDelayCurve
   , shouldRetryWithStatusCode :: StatusCode -> Boolean -- ^ whether a non-200 status code should trigger a retry
   }
@@ -172,7 +174,7 @@ type RetryPolicy =
 defaultRetryPolicy :: RetryPolicy
 defaultRetryPolicy =
   { timeout : Nothing
-  , delayCurve : \n -> round $ max (30.0 * 1000.0) $ 100.0 * (pow 2.0 $ toNumber (n - 1))
+  , delayCurve : \n -> Milliseconds $ max (30.0 * 1000.0) $ 100.0 * (pow 2.0 $ toNumber (n - 1))
   , shouldRetryWithStatusCode : const false
   }
 
@@ -182,7 +184,7 @@ type RetryState e a = Either (Either e a) a
 -- | Retry a request using a `RetryPolicy`. After the timeout, the last received response is returned; if it was not possible to communicate with the server due to an error, then this is bubbled up.
 retry
   :: forall e a b
-   . (Requestable a)
+   . Requestable a
   => RetryPolicy
   -> (AffjaxRequest a -> Affjax (avar :: AVAR, ref :: REF | e) b)
   -> (AffjaxRequest a -> Affjax (avar :: AVAR, ref :: REF | e) b)
@@ -196,7 +198,8 @@ retry policy run req = do
       respVar <- makeVar
       loopHandle <- forkAff $ loop 1 >>= putVar respVar <<< Just
       timeoutHandle <-
-        forkAff <<< later' timeout $ do
+        forkAff $ do
+          delay timeout
           putVar respVar Nothing
           loopHandle `cancel` error "Cancel"
       result <- takeVar respVar
@@ -226,13 +229,15 @@ retry policy run req = do
       case result of
         Left err -> do
           liftEff $ writeRef failureRef $ Just err
-          later' (policy.delayCurve n) $ go failureRef (n + 1)
+          delay (policy.delayCurve n)
+          go failureRef (n + 1)
         Right resp -> pure resp
 
 -- | Run a request directly without using `Aff`.
 affjax'
   :: forall e a b
-   . (Requestable a, Respondable b)
+   . Requestable a
+  => Respondable b
   => AffjaxRequest a
   -> (Error -> Eff (ajax :: AJAX | e) Unit)
   -> (AffjaxResponse b -> Eff (ajax :: AJAX | e) Unit)
@@ -277,6 +282,9 @@ affjax' req eb cb =
     Left err -> eb $ error (show err)
     Right res' -> cb res'
 
+  parseJSON :: String -> F Foreign
+  parseJSON = either (fail <<< JSONError) (pure <<< toForeign) <<< jsonParser
+
   fromResponse' :: ResponseContent -> F b
   fromResponse' = case snd responseSettings of
     JSONResponse -> fromResponse <=< parseJSON <=< readString

src/Network/HTTP/Affjax/Request.purs

@@ -22,7 +22,7 @@ import Unsafe.Coerce as U
 
 -- | Type representing all content types that be sent via XHR (ArrayBufferView,
 -- | Blob, Document, String, FormData).
-foreign import data RequestContent :: *
+foreign import data RequestContent :: Type
 
 -- | A class for types that can be converted to values that can be sent with
 -- | XHR requests. An optional mime-type can be specified for a default

test/Main.purs

@@ -1,29 +1,27 @@
 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.AVar (AVAR)
-import Control.Monad.Aff.Console as A
 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 Data.Foreign (Foreign, unsafeFromForeign)
 import Data.Maybe (Maybe(..))
-
-import Network.HTTP.Affjax as AX
+import Data.Time.Duration (Milliseconds(..))
 import Network.HTTP.StatusCode (StatusCode(..))
 
 foreign import logAny :: forall e a. a -> Eff (console :: CONSOLE | e) Unit
 
 logAny' :: forall e a. a -> Assert e Unit
 logAny' = liftEff <<< logAny
 
-type Assert e a = Aff (err :: EXCEPTION, console :: CONSOLE, ajax :: AX.AJAX | e) a
+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)
@@ -42,7 +40,7 @@ assertLeft x = case x of
   Right y -> logAny' y >>= \_ -> assertFail "Expected a Left value"
   Left y -> pure y
 
-assertEq :: forall e a. (Eq a, Show a) => a -> a -> Assert e Unit
+assertEq :: forall e a. Eq a => Show a => a -> a -> Assert e Unit
 assertEq x y =
   when (x /= y) $ assertFail $ "Expected " <> show x <> ", got " <> show y
 
@@ -53,7 +51,7 @@ typeIs = const (pure unit)
 type MainEffects e =
   ( ref :: REF
   , avar :: AVAR
-  , err :: EXCEPTION
+  , exception :: EXCEPTION
   , console :: CONSOLE
   | e
   )
@@ -68,7 +66,7 @@ main = void $ runAff (\e -> logShow e >>= \_ -> throwException e) (const $ log "
   let mirror       = prefix "/mirror"
   let doesNotExist = prefix "/does-not-exist"
   let notJson      = prefix "/not-json"
-  let retryPolicy = AX.defaultRetryPolicy { timeout = Just 500, shouldRetryWithStatusCode = \_ -> true }
+  let retryPolicy = AX.defaultRetryPolicy { timeout = Just (Milliseconds 500.0), shouldRetryWithStatusCode = \_ -> true }
 
   A.log "GET /does-not-exist: should be 404 Not found after retries"
   (attempt $ AX.retry retryPolicy AX.affjax $ AX.defaultRequest { url = doesNotExist }) >>= assertRight >>= \res -> do
@@ -86,7 +84,7 @@ main = void $ runAff (\e -> logShow e >>= \_ -> throwException e) (const $ log "
     assertEq notFound404 res.status
 
   A.log "GET /not-json: invalid JSON with Foreign response should throw an error"
-  assertLeft =<< attempt (AX.get doesNotExist :: AX.Affjax (MainEffects ()) Foreign)
+  void $ assertLeft =<< attempt (AX.get doesNotExist :: AX.Affjax (MainEffects ()) Foreign)
 
   A.log "GET /not-json: invalid JSON with String response should be ok"
   (attempt $ AX.get notJson) >>= assertRight >>= \res -> do