Merge branch 'development'

Author: bklaric

src/Node/Http/IncomingMessage.purs

@@ -44,6 +44,10 @@ foreign import defaultDestroy
 destroy_ :: forall message. IncomingMessage message => message -> Effect Unit
 destroy_ = destroy undefined
 
+error :: forall message. IncomingMessage message =>
+    Event message (Error -> Effect Unit)
+error = Event "error"
+
 aborted :: forall message. IncomingMessage message =>
     Event message (Effect Unit)
 aborted = Event "aborted"

src/Node/Http/Server.js

@@ -2,7 +2,7 @@
 
 var http = require("http")
 
-exports.create = function (requestListener) {
+exports.createImpl = function (requestListener) {
     return function () {
         return http.createServer(function (request, response) {
             requestListener(request)(response)()

src/Node/Http/Server.purs

@@ -1,28 +1,43 @@
 module Node.Http.Server
     ( HttpServer
-    , Request
-    , Response
     , create
     ) where
 
 import Prelude
 
 import Effect (Effect)
+import Node.Errors (Error)
+import Node.Events.EventEmitter (class EventEmitter, on)
 import Node.Events.EventEmitter as EventEmitter
-import Node.Events.EventEmitter (class EventEmitter)
-import Node.Http.ServerRequest (ServerRequest)
-import Node.Http.ServerResponse (ServerResponse)
+import Node.Events.EventListener (toEventListener)
+import Node.Http.IncomingMessage as IncomingMessage
+import Node.Http.Server.Request (Request)
+import Node.Http.Server.Response (Response)
+import Node.Http.Server.Response as Response
 import Node.Server (class Server, defaultListen)
 
 foreign import data HttpServer :: Type
 
-type Request = ServerRequest
-
-type Response = ServerResponse
-
-foreign import create ::
+foreign import createImpl ::
     (Request -> Response -> Effect Unit) -> Effect HttpServer
 
+create
+    :: (Error -> Effect Unit)
+    -> (Error -> Effect Unit)
+    -> (Request -> Response -> Effect Unit)
+    -> Effect HttpServer
+create requestErrorListener responseErrorListener callback =
+    createImpl \request response -> let
+        requestErrorListener' = toEventListener requestErrorListener
+        responseErrorListener' = toEventListener responseErrorListener
+        in do
+        request # on IncomingMessage.error requestErrorListener' # void
+        response # on Response.error responseErrorListener' # void
+        callback request response
+
+create_ :: (Request -> Response -> Effect Unit) -> Effect HttpServer
+create_ callback = create (const $ pure unit) (const $ pure unit) callback
+
 instance eventEmitterHttpServer :: EventEmitter HttpServer where
     on                  = EventEmitter.defaultOn
     once                = EventEmitter.defaultOnce

src/Node/Http/ServerRequest.js src/Node/Http/Server/Request.js

@@ -1,4 +1,4 @@
-module Node.Http.ServerRequest where
+module Node.Http.Server.Request where
 
 import Node.Events.EventEmitter (class EventEmitter)
 import Node.Events.EventEmitter as EventEmitter
@@ -7,9 +7,9 @@ import Node.Http.IncomingMessage as IncomingMessage
 import Node.Stream.Readable (class Readable)
 import Node.Stream.Readable as Readable
 
-foreign import data ServerRequest :: Type
+foreign import data Request :: Type
 
-instance eventEmitterServerResponse :: EventEmitter ServerRequest where
+instance eventEmitterServerResponse :: EventEmitter Request where
     on                  = EventEmitter.defaultOn
     once                = EventEmitter.defaultOnce
     prependListener     = EventEmitter.defaultPrependListener
@@ -23,7 +23,7 @@ instance eventEmitterServerResponse :: EventEmitter ServerRequest where
     setMaxListeners     = EventEmitter.defaultSetMaxListeners
     eventNames          = EventEmitter.defaultEventNames
 
-instance readableServerRequest :: Readable ServerRequest where
+instance readableRequest :: Readable Request where
     readableHighWaterMark = Readable.defaultReadableHighWaterMark
     readableLength        = Readable.defaultReadableLength
     isPaused              = Readable.defaultIsPaused
@@ -36,14 +36,14 @@ instance readableServerRequest :: Readable ServerRequest where
     unshift               = Readable.defaultUnshift
     destroy               = Readable.defaultDestroy
 
-instance incomingMessageServerRequest :: IncomingMessage ServerRequest where
+instance incomingMessageRequest :: IncomingMessage Request where
     httpVersion = IncomingMessage.defaultHttpVersion
     rawHeaders  = IncomingMessage.defaultRawHeaders
     headers     = IncomingMessage.defaultHeaders
     trailers    = IncomingMessage.defaultTrailers
     setTimeout  = IncomingMessage.defaultSetTimeout
     destroy     = IncomingMessage.defaultDestroy
 
-foreign import method :: ServerRequest -> String
+foreign import method :: Request -> String
 
-foreign import url :: ServerRequest -> String
+foreign import url :: Request -> String

src/Node/Http/ServerRequest.purs src/Node/Http/Server/Request.purs

@@ -1,10 +1,11 @@
-module Node.Http.ServerResponse where
+module Node.Http.Server.Response where
 
 import Prelude
 
 import Data.Foreign (Foreign)
 import Data.Nullable (Nullable)
 import Effect (Effect)
+import Node.Errors (Error)
 import Node.Events.Event (Event(..))
 import Node.Events.EventEmitter (class EventEmitter)
 import Node.Events.EventEmitter as EventEmitter
@@ -13,9 +14,9 @@ import Node.Stream.Writable as Writable
 import Undefined (undefined)
 import Unsafe.Coerce (unsafeCoerce)
 
-foreign import data ServerResponse :: Type
+foreign import data Response :: Type
 
-instance eventEmitterServerResponse :: EventEmitter ServerResponse where
+instance eventEmitterResponse :: EventEmitter Response where
     on                  = EventEmitter.defaultOn
     once                = EventEmitter.defaultOnce
     prependListener     = EventEmitter.defaultPrependListener
@@ -29,7 +30,7 @@ instance eventEmitterServerResponse :: EventEmitter ServerResponse where
     setMaxListeners     = EventEmitter.defaultSetMaxListeners
     eventNames          = EventEmitter.defaultEventNames
 
-instance writableServerResponse :: Writable ServerResponse where
+instance writableResponse :: Writable Response where
     writableHighWaterMark   = Writable.defaultWritableHighWaterMark
     writableLength          = Writable.defaultWritableLength
     cork                    = Writable.defaultCork
@@ -39,76 +40,79 @@ instance writableServerResponse :: Writable ServerResponse where
     destroy                 = Writable.defaultDestroy
 
 foreign import addTrailers ::
-    Foreign -> ServerResponse -> Effect Unit
+    Foreign -> Response -> Effect Unit
 
 foreign import finished ::
-    ServerResponse -> Effect Boolean
+    Response -> Effect Boolean
 
 foreign import getHeader ::
-    String -> ServerResponse -> Effect String
+    String -> Response -> Effect String
 
 foreign import getHeaderNames ::
-    ServerResponse -> Effect (Array String)
+    Response -> Effect (Array String)
 
 foreign import getHeaders ::
-    ServerResponse -> Effect Foreign
+    Response -> Effect Foreign
 
 foreign import hasHeader ::
-    String -> ServerResponse -> Effect Boolean
+    String -> Response -> Effect Boolean
 
 foreign import headersSent ::
-    ServerResponse -> Effect Boolean
+    Response -> Effect Boolean
 
 foreign import removeHeader ::
-    String -> ServerResponse -> Effect Unit
+    String -> Response -> Effect Unit
 
 foreign import getSendDate ::
-    ServerResponse -> Effect Boolean
+    Response -> Effect Boolean
 
 foreign import setSendDate ::
-    Boolean -> ServerResponse -> Effect Unit
+    Boolean -> Response -> Effect Unit
 
 foreign import setHeader ::
-    String -> String -> ServerResponse -> Effect Unit
+    String -> String -> Response -> Effect Unit
 
 foreign import setHeader' ::
-    String -> Array String -> ServerResponse -> Effect Unit
+    String -> Array String -> Response -> Effect Unit
 
 foreign import defaultSetTimeout ::
-    Int -> Effect Unit -> ServerResponse -> Effect ServerResponse
+    Int -> Effect Unit -> Response -> Effect Response
 
 foreign import getStatusCode ::
-    ServerResponse -> Effect Int
+    Response -> Effect Int
 
 foreign import setStatusCode ::
-    Int -> ServerResponse -> Effect Unit
+    Int -> Response -> Effect Unit
 
 foreign import getStatusMessage ::
-    ServerResponse -> Effect (Nullable String)
+    Response -> Effect (Nullable String)
 
 foreign import setStatusMessage ::
-    String -> ServerResponse -> Effect Unit
+    String -> Response -> Effect Unit
 
 foreign import writeContinue ::
-    ServerResponse -> Effect Unit
+    Response -> Effect Unit
 
 foreign import writeHead ::
-    Int -> String -> Foreign -> ServerResponse -> Effect Unit
+    Int -> String -> Foreign -> Response -> Effect Unit
 
-writeHead_ :: Int -> Foreign -> ServerResponse -> Effect Unit
+writeHead_ :: Int -> Foreign -> Response -> Effect Unit
 writeHead_ statusCode headers =
     writeHead statusCode (unsafeCoerce headers) undefined
 
-writeHead_' :: Int -> String -> ServerResponse -> Effect Unit
+writeHead_' :: Int -> String -> Response -> Effect Unit
 writeHead_' statusCode statusMessage =
     writeHead statusCode statusMessage undefined
 
-writeHead__ :: Int -> ServerResponse -> Effect Unit
+writeHead__ :: Int -> Response -> Effect Unit
 writeHead__ statusCode =
     writeHead statusCode undefined undefined
 
-close :: Event ServerResponse (Effect Unit)
+error :: Event Response (Error -> Effect Unit)
+error = Event "error"
+
+close :: Event Response (Effect Unit)
 close = Event "close"
 
-finish :: Event ServerResponse (Effect Unit)
+finish :: Event Response (Effect Unit)
 finish = Event "finish"