Options approach

Author: garyb

.gitignore

@@ -0,0 +1,6 @@
+/.*
+!/.gitignore
+/bower_components/
+/node_modules/
+/output/
+/tmp/

bower.json

@@ -0,0 +1,29 @@
+{
+  "name": "purescript-affjax",
+  "homepage": "https://github.com/slamdata/purescript-affjax",
+  "description": "An asynchronous AJAX library built using Aff.",
+  "keywords": [
+    "purescript",
+    "ajax"
+  ],
+  "license": "MIT",
+  "ignore": [
+    "**/.*",
+    "bower_components",
+    "node_modules",
+    "output",
+    "test",
+    "tmp",
+    "bower.json",
+    "gulpfile.js",
+    "package.json"
+  ],
+  "dependencies": {
+    "purescript-aff": "~0.7.0",
+    "purescript-arraybuffer-types": "~0.1.1",
+    "purescript-dom": "~0.1.2",
+    "purescript-foreign": "~0.4.1",
+    "purescript-integers": "~0.0.1",
+    "purescript-options": "~0.2.1"
+  }
+}

gulpfile.js

@@ -0,0 +1,35 @@
+"use strict";
+
+var gulp = require("gulp");
+var plumber = require("gulp-plumber");
+var purescript = require("gulp-purescript");
+var jsvalidate = require("gulp-jsvalidate");
+
+gulp.task("make", function() {
+  return gulp.src(["src/**/*.purs", "bower_components/purescript-*/src/**/*.purs"])
+    .pipe(plumber())
+    .pipe(purescript.pscMake());
+});
+
+gulp.task("make-test", function() {
+  return gulp.src(["src/**/*.purs", "test/**/*.purs", "bower_components/purescript-*/src/**/*.purs"])
+    .pipe(plumber())
+    .pipe(purescript.psc({ main: "Test.Main", output: "test.js" }))
+    .pipe(gulp.dest("tmp/"));
+});
+
+gulp.task("jsvalidate", ["make"], function () {
+  return gulp.src("output/**/*.js")
+    .pipe(plumber())
+    .pipe(jsvalidate());
+});
+
+gulp.task("docs", function () {
+  return gulp.src("src/**/*.purs")
+    .pipe(plumber())
+    .pipe(purescript.pscDocs())
+    .pipe(gulp.dest("README.md"));
+});
+
+// gulp.task("default", ["jsvalidate", "docs"]);
+gulp.task("default", ["make-test"]);

package.json

@@ -0,0 +1,9 @@
+{
+  "private": true,
+  "devDependencies": {
+    "gulp": "^3.8.11",
+    "gulp-jsvalidate": "^1.0.1",
+    "gulp-plumber": "^1.0.0",
+    "gulp-purescript": "^0.1.2"
+  }
+}

src/Data/Proxy.purs

@@ -0,0 +1,3 @@
+module Data.Proxy where
+
+data Proxy a = Proxy

src/Network/HTTP/Affjax.purs

@@ -0,0 +1,119 @@
+module Network.HTTP.Affjax
+  ( Ajax()
+  , AffjaxOptions()
+  , AffjaxResponse()
+  , url, method, content, headers, username, password
+  , affjax
+  , affjax'
+  ) where
+
+import Control.Monad.Aff (Aff(), makeAff)
+import Control.Monad.Eff (Eff())
+import Control.Monad.Eff.Exception (Error())
+import Data.Foreign (Foreign(..))
+import Data.Function (Fn4(), runFn4)
+import Data.Options (Option(), Options(), IsOption, options, (:=), opt)
+import Data.Proxy (Proxy(..))
+import Network.HTTP.Affjax.Request
+import Network.HTTP.Affjax.Response
+import Network.HTTP.Affjax.ResponseType
+import Network.HTTP.Method (Method())
+import Network.HTTP.RequestHeader (RequestHeader())
+import Network.HTTP.ResponseHeader (ResponseHeader(), responseHeader)
+import Network.HTTP.StatusCode (StatusCode())
+
+-- | The effect type for AJAX requests made with Affjax.
+foreign import data Ajax :: !
+
+-- | Options type for Affjax requests.
+foreign import data AffjaxOptions :: * -> *
+
+-- | The type of records that will be received as an Affjax response.
+type AffjaxResponse a =
+  { status :: StatusCode
+  , headers :: [ResponseHeader]
+  , response :: a
+  }
+
+-- | Sets the URL for a request.
+url :: forall a. Option (AffjaxOptions a) String
+url = opt "url"
+
+-- | Sets the HTTP method for a request.
+method :: forall a. Option (AffjaxOptions a) Method
+method = opt "method"
+
+-- | Sets the content to send in a request.
+content :: forall a. (Requestable a, IsOption a) => Option (AffjaxOptions a) a
+content = opt "content"
+
+-- | Sets the headers to send with a request.
+headers :: forall a. Option (AffjaxOptions a) [RequestHeader]
+headers = opt "headers"
+
+-- | Sets the HTTP auth username to send with a request.
+username :: forall a. Option (AffjaxOptions a) String
+username = opt "username"
+
+-- | Sets the HTTP auth password to send with a request.
+password :: forall a. Option (AffjaxOptions a) String
+password = opt "password"
+
+-- | Sets the expected response type for a request. This is not exposed outside
+-- | of the module as the `ResponseType` is set based on the `Responsable`
+-- | instance for the expected result content type.
+responseType = opt "responseType" :: forall a. Option (AffjaxOptions a) ResponseType
+
+-- | Runs a request.
+affjax :: forall e a b. (Requestable a, Responsable b) =>
+                        Options (AffjaxOptions a) ->
+                        Aff (ajax :: Ajax | e) (AffjaxResponse b)
+affjax = makeAff <<< affjax'
+
+-- | Runs a request directly in Eff.
+affjax' :: forall e a b. (Requestable a, Responsable b) =>
+                         Options (AffjaxOptions a) ->
+                         (Error -> Eff (ajax :: Ajax | e) Unit) ->
+                         (AffjaxResponse b -> Eff (ajax :: Ajax | e) Unit) ->
+                         Eff (ajax :: Ajax | e) Unit
+affjax' opts eb cb =
+  let opts' = opts <> responseType := toResponseType (Proxy :: Proxy b)
+  in runFn4 unsafeAjax responseHeader (options opts') eb cb
+
+foreign import unsafeAjax
+  """
+  function unsafeAjax (mkHeader, options, errback, callback) {
+    return function () {
+      var xhr = new XMLHttpRequest();
+      xhr.open(options.method || "GET", options.url || "/", true, options.username, options.password);
+      if (options.headers) {
+        for (var i = 0, header; header = options.headers[i]; i++) {
+          xhr.setRequestHeader(header.field, header.value);
+        }
+      }
+      xhr.onerror = function (err) {
+        errback(err)();
+      };
+      xhr.onload = function () {
+        callback({
+          status: xhr.status,
+          headers: xhr.getAllResponseHeaders().split("\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: xhr.response
+        })();
+      };
+      if (options.responseType) xhr.responseType = options.responseType;
+      xhr.send(options.content);
+    };
+  }
+  """ :: forall e a b. Fn4 (String -> String -> ResponseHeader)
+                       Foreign
+                       (Error -> Eff (ajax :: Ajax | e) Unit)
+                       (AffjaxResponse b -> Eff (ajax :: Ajax | e) Unit)
+                       (Eff (ajax :: Ajax | e) Unit)

src/Network/HTTP/Affjax/Request.purs

@@ -0,0 +1,84 @@
+module Network.HTTP.Affjax.Request
+  ( RequestContent()
+  , Requestable, toContent
+  ) where
+
+import Data.Options (Option(), Options(), IsOption, optionFn, (:=))
+import DOM (Document())
+import DOM.File (Blob())
+import DOM.XHR (FormData())
+import Network.HTTP.MimeType (MimeType())
+import qualified Data.ArrayBuffer.Types as A
+
+-- | Type representing all content types that be sent via XHR (ArrayBufferView,
+-- | Blob, Document, String, FormData).
+foreign import data RequestContent :: *
+
+instance isOptionRequestContent :: IsOption RequestContent where
+  (:=) = unsafeIsOption
+
+-- | A class for types that can be converted to values that can be sent with
+-- | XHR requests.
+class Requestable a where
+  toContent :: a -> RequestContent
+
+instance requestableAjaxRequestContent :: Requestable RequestContent where
+  toContent = id
+
+instance requestableInt8Array :: Requestable (A.ArrayView A.Int8) where
+  toContent = unsafeConversion
+
+instance requestableInt16Array :: Requestable (A.ArrayView A.Int16) where
+  toContent = unsafeConversion
+
+instance requestableInt32Array :: Requestable (A.ArrayView A.Int32) where
+  toContent = unsafeConversion
+
+instance requestableUint8Array :: Requestable (A.ArrayView A.Uint8) where
+  toContent = unsafeConversion
+
+instance requestableUint16Array :: Requestable (A.ArrayView A.Uint16) where
+  toContent = unsafeConversion
+
+instance requestableUint32Array :: Requestable (A.ArrayView A.Uint32) where
+  toContent = unsafeConversion
+
+instance requestableUint8ClampedArray :: Requestable (A.ArrayView A.Uint8Clamped) where
+  toContent = unsafeConversion
+
+instance requestableFloat32Array :: Requestable (A.ArrayView A.Float32) where
+  toContent = unsafeConversion
+
+instance requestableFloat64Array :: Requestable (A.ArrayView A.Float64) where
+  toContent = unsafeConversion
+
+instance requestableBlob :: Requestable Blob where
+  toContent = unsafeConversion
+
+instance requestableDocument :: Requestable Document where
+  toContent = unsafeConversion
+
+instance requestableString :: Requestable String where
+  toContent = unsafeConversion
+
+instance requestableFormData :: Requestable FormData where
+  toContent = unsafeConversion
+
+instance requestableUnit :: Requestable Unit where
+  toContent = unsafeConversion
+
+foreign import unsafeIsOption
+  """
+  function unsafeIsOption(k) {
+    return function (v) {
+      return [[k, v]];
+    };
+  }
+  """ :: forall b a. (Option b a) -> a -> (Options b)
+
+foreign import unsafeConversion
+  """
+  function unsafeConversion (x) {
+    return x;
+  }
+  """ :: forall a b. a -> b

src/Network/HTTP/Affjax/Response.purs

@@ -0,0 +1,91 @@
+module Network.HTTP.Affjax.Response
+  ( ResponseContent()
+  , Responsable, toResponseType, fromContent
+  ) where
+
+import Data.Either (Either(..))
+import Data.Foreign (Foreign(), ForeignError())
+import Data.Options (IsOption, optionFn, (:=))
+import Data.Proxy (Proxy())
+import DOM (Document())
+import DOM.File (Blob())
+import DOM.XHR (FormData())
+import Network.HTTP.Affjax.ResponseType
+import qualified Data.ArrayBuffer.Types as A
+
+-- | Type representing content types that be received from an XHR request
+-- | (ArrayBuffer, Blob, Document, JSON, String).
+type ResponseContent = Foreign
+
+-- | Class for types that converted from values returned from an XHR request.
+class Responsable a where
+  toResponseType :: Proxy a -> ResponseType
+  fromContent :: ResponseContent -> Either ForeignError a
+
+instance responsableUnit :: Responsable Unit where
+  toResponseType _ = StringResponse
+  fromContent _ = Right unit
+
+instance responsableInt8Array :: Responsable (A.ArrayView A.Int8) where
+  toResponseType _ = ArrayBufferResponse
+  fromContent = arrayBufferConversion
+
+instance responsableInt16Array :: Responsable (A.ArrayView A.Int16) where
+  toResponseType _ = ArrayBufferResponse
+  fromContent = arrayBufferConversion
+
+instance responsableInt32Array :: Responsable (A.ArrayView A.Int32) where
+  toResponseType _ = ArrayBufferResponse
+  fromContent = arrayBufferConversion
+
+instance responsableUint8Array :: Responsable (A.ArrayView A.Uint8) where
+  toResponseType _ = ArrayBufferResponse
+  fromContent = arrayBufferConversion
+
+instance responsableUint16Array :: Responsable (A.ArrayView A.Uint16) where
+  toResponseType _ = ArrayBufferResponse
+  fromContent = arrayBufferConversion
+
+instance responsableUint32Array :: Responsable (A.ArrayView A.Uint32) where
+  toResponseType _ = ArrayBufferResponse
+  fromContent = arrayBufferConversion
+
+instance responsableUint8ClampedArray :: Responsable (A.ArrayView A.Uint8Clamped) where
+  toResponseType _ = ArrayBufferResponse
+  fromContent = arrayBufferConversion
+
+instance responsableFloat32Array :: Responsable (A.ArrayView A.Float32) where
+  toResponseType _ = ArrayBufferResponse
+  fromContent = arrayBufferConversion
+
+instance responsableFloat64Array :: Responsable (A.ArrayView A.Float64) where
+  toResponseType _ = ArrayBufferResponse
+  fromContent = arrayBufferConversion
+
+instance responsableBlob :: Responsable Blob where
+  toResponseType _ = BlobResponse
+  fromContent = unsafeConversion
+
+instance responsableDocument :: Responsable Document where
+  toResponseType _ = DocumentResponse
+  fromContent = unsafeConversion
+
+instance responsableString :: Responsable String where
+  toResponseType _ = StringResponse
+  fromContent = Right <<< unsafeConversion
+
+-- TODO: this, properly
+foreign import arrayBufferConversion
+  """
+  function arrayBufferConversion (x) {
+    return x;
+  }
+  """ :: forall a b. a -> b
+
+-- TODO: not this either, at least use foreign to check the tag of returned values to ensure they are not null, etc.
+foreign import unsafeConversion
+  """
+  function unsafeConversion (x) {
+    return x;
+  }
+  """ :: forall a b. a -> b