Initial commit

Author: paf31

.gitignore

@@ -0,0 +1,5 @@
+/bower_components/
+/node_modules/
+/output/
+/.psci*
+/src/.webpack.js

LICENSE

@@ -0,0 +1,20 @@
+The MIT License (MIT)
+
+Copyright (c) 2015 DICOM Grid, Inc.
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+the Software, and to permit persons to whom the Software is furnished to do so,
+subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

bower.json

@@ -0,0 +1,21 @@
+{
+  "name": "purescript-node-http",
+  "version": "1.0.0",
+  "moduleType": [
+    "node"
+  ],
+  "ignore": [
+    "**/.*",
+    "node_modules",
+    "bower_components",
+    "output"
+  ],
+  "devDependencies": {
+    "purescript-console": "^0.1.0"
+  },
+  "dependencies": {
+    "purescript-maps": "~0.5.0",
+    "purescript-node-streams": "~0.1.0",
+    "purescript-unsafe-coerce": "~0.1.0"
+  }
+}

docs/Node/HTTP.md

@@ -0,0 +1,133 @@
+## Module Node.HTTP
+
+This module defines low-level bindings to the Node HTTP module.
+
+#### `Server`
+
+``` purescript
+data Server :: *
+```
+
+The type of a HTTP server object
+
+#### `Request`
+
+``` purescript
+data Request :: *
+```
+
+A HTTP request object
+
+#### `Response`
+
+``` purescript
+data Response :: *
+```
+
+A HTTP response object
+
+#### `HTTP`
+
+``` purescript
+data HTTP :: !
+```
+
+The effect associated with using the HTTP module.
+
+#### `createServer`
+
+``` purescript
+createServer :: forall eff. (Request -> Response -> Eff (http :: HTTP | eff) Unit) -> Eff (http :: HTTP | eff) Server
+```
+
+Create a HTTP server, given a function to be executed when a request is received.
+
+#### `listen`
+
+``` purescript
+listen :: forall eff. Server -> Int -> Eff (http :: HTTP | eff) Unit -> Eff (http :: HTTP | eff) Unit
+```
+
+Listen on the specified port. The specified callback will be run when setup is complete.
+
+#### `httpVersion`
+
+``` purescript
+httpVersion :: Request -> String
+```
+
+Get the request HTTP version
+
+#### `requestHeaders`
+
+``` purescript
+requestHeaders :: Request -> StrMap String
+```
+
+Get the request headers as a hash
+
+#### `requestMethod`
+
+``` purescript
+requestMethod :: Request -> String
+```
+
+Get the request method (GET, POST, etc.)
+
+#### `requestURL`
+
+``` purescript
+requestURL :: Request -> String
+```
+
+Get the request URL
+
+#### `requestAsStream`
+
+``` purescript
+requestAsStream :: forall eff a. Request -> Readable () (http :: HTTP | eff) a
+```
+
+Coerce the request object into a readable stream.
+
+#### `setHeader`
+
+``` purescript
+setHeader :: forall eff. Response -> String -> String -> Eff (http :: HTTP | eff) Unit
+```
+
+Set a header with a single value.
+
+#### `setHeaders`
+
+``` purescript
+setHeaders :: forall eff. Response -> String -> Array String -> Eff (http :: HTTP | eff) Unit
+```
+
+Set a header with multiple values.
+
+#### `setStatusCode`
+
+``` purescript
+setStatusCode :: forall eff. Response -> Int -> Eff (http :: HTTP | eff) Unit
+```
+
+Set the status code.
+
+#### `setStatusMessage`
+
+``` purescript
+setStatusMessage :: forall eff. Response -> String -> Eff (http :: HTTP | eff) Unit
+```
+
+Set the status message.
+
+#### `responseAsStream`
+
+``` purescript
+responseAsStream :: forall eff a. Response -> Writable () (http :: HTTP | eff) a
+```
+
+Coerce the response object into a writable stream.
+
+

src/Node/HTTP.js

@@ -0,0 +1,79 @@
+"use strict";
+
+// module Node.HTTP
+
+var http = require('http');
+
+exports.createServer = function(handleRequest) {
+  return function() {
+    return http.createServer(function(req, res) {
+      handleRequest(req)(res)();
+    });
+  };
+};
+
+exports.listen = function(server) {
+  return function(port) {
+    return function(done) {
+      return function() {
+        server.listen(port, function() {
+          done();
+        });
+      };
+    };
+  };
+};
+
+exports.writeString = function(res) {
+  return function(s) {
+    return function() {
+      res.write(s);
+    };
+  };
+};
+
+exports.setHeader = function(res) {
+  return function(key) {
+    return function(value) {
+      return function() {
+        res.setHeader(key, value);
+      };
+    };
+  };
+};
+
+exports.setHeaders = function(res) {
+  return function(key) {
+    return function(values) {
+      return function() {
+        res.setHeader(key, values);
+      };
+    };
+  };
+};
+
+exports.setStatusCode = function(res) {
+  return function(code) {
+    return function() {
+      res.statusCode = code;
+    };
+  };
+};
+
+exports.setStatusMessage = function(res) {
+  return function(message) {
+    return function() {
+      res.statusMessage = message;
+    };
+  };
+};
+
+exports.end = function(res) {
+  return function(done) {
+    return function() {
+      res.end(null, function() {
+        done();
+      });
+    };
+  };
+};

src/Node/HTTP.purs

@@ -0,0 +1,64 @@
+-- | This module defines low-level bindings to the Node HTTP module.
+
+module Node.HTTP where
+
+import Prelude
+
+import Data.StrMap
+import Control.Monad.Eff
+import Node.Stream
+import Unsafe.Coerce (unsafeCoerce)
+
+-- | The type of a HTTP server object
+foreign import data Server :: *
+
+-- | A HTTP request object
+foreign import data Request :: *
+
+-- | A HTTP response object
+foreign import data Response :: *
+
+-- | The effect associated with using the HTTP module.
+foreign import data HTTP :: !
+
+-- | Create a HTTP server, given a function to be executed when a request is received.
+foreign import createServer :: forall eff. (Request -> Response -> Eff (http :: HTTP | eff) Unit) -> Eff (http :: HTTP | eff) Server
+
+-- | Listen on the specified port. The specified callback will be run when setup is complete.
+foreign import listen :: forall eff. Server -> Int -> Eff (http :: HTTP | eff) Unit -> Eff (http :: HTTP | eff) Unit
+
+-- | Get the request HTTP version
+httpVersion :: Request -> String
+httpVersion = _.httpVersion <<< unsafeCoerce
+
+-- | Get the request headers as a hash
+requestHeaders :: Request -> StrMap String
+requestHeaders = _.headers <<< unsafeCoerce
+
+-- | Get the request method (GET, POST, etc.)
+requestMethod :: Request -> String
+requestMethod = _.method <<< unsafeCoerce
+
+-- | Get the request URL
+requestURL :: Request -> String
+requestURL = _.url <<< unsafeCoerce
+
+-- | Coerce the request object into a readable stream.
+requestAsStream :: forall eff a. Request -> Readable () (http :: HTTP | eff) a
+requestAsStream = unsafeCoerce
+
+-- | Set a header with a single value.
+foreign import setHeader :: forall eff. Response -> String -> String -> Eff (http :: HTTP | eff) Unit
+
+-- | Set a header with multiple values.
+foreign import setHeaders :: forall eff. Response -> String -> Array String -> Eff (http :: HTTP | eff) Unit
+
+-- | Set the status code.
+foreign import setStatusCode :: forall eff. Response -> Int -> Eff (http :: HTTP | eff) Unit
+
+-- | Set the status message.
+foreign import setStatusMessage :: forall eff. Response -> String -> Eff (http :: HTTP | eff) Unit
+
+-- | Coerce the response object into a writable stream.
+responseAsStream :: forall eff a. Response -> Writable () (http :: HTTP | eff) a
+responseAsStream = unsafeCoerce

test/Main.purs

@@ -0,0 +1,30 @@
+module Test.Main where
+
+import Prelude
+
+import Control.Monad.Eff.Console
+
+import Node.HTTP
+import Node.Stream
+import Node.Encoding
+
+main = do
+  server <- createServer respond
+  listen server 8080 do
+    log "Listening on port 8080."
+  where
+  respond req res = do
+    setStatusCode res 200
+    let inputStream  = requestAsStream req
+        outputStream = responseAsStream res
+    log (requestMethod req <> " " <> requestURL req)
+    case requestMethod req of
+      "GET" -> do
+        let html = "<form method='POST' action='/'>"
+                <> "  <input name='text' type='text'>"
+                <> "  <input type='submit'>"
+                <> "</form>"
+        setHeader res "Content-Type" "text/html"
+        writeString outputStream UTF8 html(return unit)
+        end outputStream (return unit)
+      "POST" -> void $ pipe inputStream outputStream