Make ResponseM async (#71)

bower.json

@@ -27,6 +27,7 @@
   "devDependencies": {
     "purescript-psci-support": "^3.0.0",
     "purescript-spec": "^1.0.0",
-    "purescript-unsafe-coerce": "^3.0.0"
+    "purescript-unsafe-coerce": "^3.0.0",
+    "purescript-node-fs-aff": "^4.0.0"
   }
 }

docs/Examples/AsyncResponse/Hello

@@ -0,0 +1 @@
+hello world!

docs/Examples/AsyncResponse/Main.purs

@@ -0,0 +1,35 @@
+module AsyncResponse where
+
+import Prelude
+
+import Control.Monad.Eff.Console as Console
+import HTTPure as HTTPure
+import Node.Encoding as Encoding
+import Node.FS as FS
+import Node.FS.Aff as FSAff
+
+-- | Serve the example server on this port
+port :: Int
+port = 8088
+
+-- | Shortcut for `show port`
+portS :: String
+portS = show port
+
+-- | The path to the file containing the response to send
+filePath :: String
+filePath = "./docs/Examples/AsyncResponse/Hello"
+
+-- | Say 'hello world!' when run
+sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM (fs :: FS.FS | e)
+sayHello _ = FSAff.readTextFile Encoding.UTF8 filePath >>= HTTPure.ok
+
+-- | Boot up the server
+main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE, fs :: FS.FS | e)
+main = HTTPure.serve port sayHello do
+  Console.log $ " ┌────────────────────────────────────────────┐"
+  Console.log $ " │ Server now up on port " <> portS <> "                 │"
+  Console.log $ " │                                            │"
+  Console.log $ " │ To test, run:                              │"
+  Console.log $ " │  > curl localhost:" <> portS <> "   # => hello world! │"
+  Console.log $ " └────────────────────────────────────────────┘"

docs/Examples/AsyncResponse/Readme.md

@@ -0,0 +1,12 @@
+# Async Response Example
+
+This is a basic 'hello world' example, that responds by asynchronously reading a
+file off the filesystem. It simply returns 'hello world!' when making any
+request, but the 'hello world!' text is fetched by reading the contents of the
+file [Hello](./Hello).
+
+To run the example server, run:
+
+```bash
+make example EXAMPLE=AsyncResponse
+```

src/HTTPure/Body.purs

@@ -13,14 +13,14 @@ import Node.Encoding as Encoding
 import Node.HTTP as HTTP
 import Node.Stream as Stream
 
-import HTTPure.HTTPureM as HTTPureM
+import HTTPure.HTTPureEffects as HTTPureEffects
 
 -- | The `Body` type is just sugar for a `String`, that will be sent or received
 -- | in the HTTP body.
 type Body = String
 
 -- | Extract the contents of the body of the HTTP `Request`.
-read :: forall e. HTTP.Request -> Aff.Aff (HTTPureM.HTTPureEffects e) Body
+read :: forall e. HTTP.Request -> Aff.Aff (HTTPureEffects.HTTPureEffects e) Body
 read request = Aff.makeAff \_ success -> do
   let stream = HTTP.requestAsStream request
   buf <- ST.newSTRef ""

src/HTTPure/HTTPureEffects.purs

@@ -0,0 +1,15 @@
+module HTTPure.HTTPureEffects
+  ( HTTPureEffects
+  ) where
+
+import Control.Monad.Eff.Exception as Exception
+import Control.Monad.ST as ST
+import Node.HTTP as HTTP
+
+-- | A row of types that are used by an HTTPure server.
+type HTTPureEffects e =
+  ( http :: HTTP.HTTP
+  , st :: ST.ST String
+  , exception :: Exception.EXCEPTION
+  | e
+  )

src/HTTPure/Request.purs

@@ -10,7 +10,7 @@ import Node.HTTP as HTTP
 
 import HTTPure.Body as Body
 import HTTPure.Headers as Headers
-import HTTPure.HTTPureM as HTTPureM
+import HTTPure.HTTPureEffects as HTTPureEffects
 import HTTPure.Method as Method
 import HTTPure.Path as Path
 import HTTPure.Query as Query
@@ -29,7 +29,7 @@ type Request =
 -- | `Request` object.
 fromHTTPRequest :: forall e.
                    HTTP.Request ->
-                   Aff.Aff (HTTPureM.HTTPureEffects e) Request
+                   Aff.Aff (HTTPureEffects.HTTPureEffects e) Request
 fromHTTPRequest request = do
   body <- Body.read request
   pure $

src/HTTPure/Response.purs

@@ -77,25 +77,30 @@ module HTTPure.Response
 
 import Prelude
 
+import Control.Monad.Eff as Eff
+import Control.Monad.Aff as Aff
 import Node.HTTP as HTTP
 
 import HTTPure.Body as Body
 import HTTPure.Headers as Headers
-import HTTPure.HTTPureM as HTTPureM
+import HTTPure.HTTPureEffects as HTTPureEffects
 import HTTPure.Status as Status
 
 -- | The `ResponseM` type simply conveniently wraps up an HTTPure monad that
 -- | returns a response. This type is the return type of all router/route
 -- | methods.
-type ResponseM e = HTTPureM.HTTPureM e Response
+type ResponseM e = Aff.Aff (HTTPureEffects.HTTPureEffects e) Response
 
 -- | A `Response` is a status code, headers, and a body.
 data Response = Response Status.Status Headers.Headers Body.Body
 
 -- | Given an HTTP `Response` and a HTTPure `Response`, this method will return
 -- | a monad encapsulating writing the HTTPure `Response` to the HTTP `Response`
 -- | and closing the HTTP `Response`.
-send :: forall e. HTTP.Response -> Response -> HTTPureM.HTTPureM e Unit
+send :: forall e.
+        HTTP.Response ->
+        Response ->
+        Eff.Eff (HTTPureEffects.HTTPureEffects e) Unit
 send httpresponse (Response status headers body) = do
   Status.write httpresponse $ status
   Headers.write httpresponse $ headers

src/HTTPure/Server.purs

@@ -8,6 +8,7 @@ module HTTPure.Server
 import Prelude
 
 import Control.Monad.Aff as Aff
+import Control.Monad.Eff as Eff
 import Control.Monad.Eff.Class as EffClass
 import Data.Maybe as Maybe
 import Data.Options ((:=))
@@ -17,14 +18,14 @@ import Node.FS.Sync as FSSync
 import Node.HTTP as HTTP
 import Node.HTTP.Secure as HTTPS
 
-import HTTPure.HTTPureM as HTTPureM
+import HTTPure.HTTPureEffects as HTTPureEffects
 import HTTPure.Request as Request
 import HTTPure.Response as Response
 
 -- | The `ServerM` type simply conveniently wraps up an HTTPure monad that
 -- | returns a `Unit`. This type is the return type of the HTTPure serve and
 -- | related methods.
-type ServerM e = HTTPureM.HTTPureM e Unit
+type ServerM e = Eff.Eff (HTTPureEffects.HTTPureEffects e) Unit
 
 -- | The `SecureServerM` type is the same as the `ServerM` type, but it includes
 -- | effects for working with the filesystem (to load the key and certificate).
@@ -42,11 +43,11 @@ handleRequest :: forall e.
 handleRequest router request response =
   void $ Aff.runAff (\_ -> pure unit) (\_ -> pure unit) do
     req <- Request.fromHTTPRequest request
-    EffClass.liftEff $ router req >>= Response.send response
+    router req >>= Response.send response >>> EffClass.liftEff
 
 -- | Given a `ListenOptions` object, a function mapping `Request` to
--- | `ResponseM`, and an `HTTPureM` containing effects to run on boot, creates
--- | and runs a HTTPure server without SSL.
+-- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and
+-- | runs a HTTPure server without SSL.
 bootHTTP :: forall e.
             HTTP.ListenOptions ->
             (Request.Request -> Response.ResponseM e) ->
@@ -57,9 +58,9 @@ bootHTTP options router onStarted =
     HTTP.listen server options onStarted
 
 -- | Given a `ListenOptions` object, a path to a cert file, a path to a private
--- | key file, a function mapping `Request` to `ResponseM`, and an `HTTPureM`
--- | containing effects to run on boot, creates and runs a HTTPure server with
--- | SSL.
+-- | key file, a function mapping `Request` to `ResponseM`, and a
+-- | `SecureServerM` containing effects to run on boot, creates and runs a
+-- | HTTPure server with SSL.
 bootHTTPS :: forall e.
              HTTP.ListenOptions ->
              String ->
@@ -87,8 +88,8 @@ listenOptions port =
 
 -- | Create and start a server. This is the main entry point for HTTPure. Takes
 -- | a port number on which to listen, a function mapping `Request` to
--- | `ResponseM`, and an `HTTPureM` containing effects to run after the server
--- | has booted (usually logging). Returns an `HTTPureM` containing the server's
+-- | `ResponseM`, and a `ServerM` containing effects to run after the server has
+-- | booted (usually logging). Returns an `ServerM` containing the server's
 -- | effects.
 serve :: forall e.
          Int ->

test/HTTPure/HTTPureEffectsSpec.purs

@@ -0,0 +1,11 @@
+module HTTPure.HTTPureEffectsSpec where
+
+import Prelude
+
+import Test.Spec as Spec
+
+import HTTPure.SpecHelpers as SpecHelpers
+
+httpureEffectsSpec :: SpecHelpers.Test
+httpureEffectsSpec = Spec.describe "HTTPureEffects" do
+  pure unit

test/HTTPure/IntegrationSpec.purs

@@ -9,6 +9,7 @@ import Test.Spec as Spec
 import HTTPure.SpecHelpers as SpecHelpers
 import HTTPure.SpecHelpers ((?=))
 
+import AsyncResponse as AsyncResponse
 import Headers as Headers
 import HelloWorld as HelloWorld
 import MultiRoute as MultiRoute
@@ -17,6 +18,13 @@ import QueryParameters as QueryParameters
 import Post as Post
 import SSL as SSL
 
+asyncResponseSpec :: SpecHelpers.Test
+asyncResponseSpec = Spec.it "runs the async response example" do
+  EffClass.liftEff AsyncResponse.main
+  response <- SpecHelpers.get port StrMap.empty "/"
+  response ?= "hello world!"
+  where port = AsyncResponse.port
+
 headersSpec :: SpecHelpers.Test
 headersSpec = Spec.it "runs the headers example" do
   EffClass.liftEff Headers.main
@@ -80,6 +88,7 @@ sslSpec = Spec.it "runs the ssl example" do
 
 integrationSpec :: SpecHelpers.Test
 integrationSpec = Spec.describe "Integration" do
+  asyncResponseSpec
   headersSpec
   helloWorldSpec
   multiRouteSpec

test/HTTPure/ResponseSpec.purs

@@ -50,7 +50,7 @@ responseFunctionSpec = Spec.describe "response" do
     case resp of (Response.Response _ _ body) -> body ?= "test"
   where
     mockHeaders = Headers.headers [ Tuple.Tuple "Test" "test" ]
-    mockResponse = EffClass.liftEff $ Response.response 123 mockHeaders "test"
+    mockResponse = Response.response 123 mockHeaders "test"
 
 response'Spec :: SpecHelpers.Test
 response'Spec = Spec.describe "response'" do
@@ -65,7 +65,7 @@ response'Spec = Spec.describe "response'" do
     case resp of (Response.Response _ _ body) -> body ?= ""
   where
     mockHeaders = Headers.headers [ Tuple.Tuple "Test" "test" ]
-    mockResponse = EffClass.liftEff $ Response.response' 123 mockHeaders
+    mockResponse = Response.response' 123 mockHeaders
 
 responseSpec :: SpecHelpers.Test
 responseSpec = Spec.describe "Response" do

test/HTTPureSpec.purs

@@ -8,7 +8,7 @@ import Test.Spec.Runner as Runner
 
 import HTTPure.BodySpec as BodySpec
 import HTTPure.HeadersSpec as HeadersSpec
-import HTTPure.HTTPureMSpec as HTTPureMSpec
+import HTTPure.HTTPureEffectsSpec as HTTPureEffectsSpec
 import HTTPure.LookupSpec as LookupSpec
 import HTTPure.MethodSpec as MethodSpec
 import HTTPure.PathSpec as PathSpec
@@ -25,7 +25,7 @@ main :: SpecHelpers.TestSuite
 main = Runner.run [ Reporter.specReporter ] $ Spec.describe "HTTPure" do
   BodySpec.bodySpec
   HeadersSpec.headersSpec
-  HTTPureMSpec.httpureMSpec
+  HTTPureEffectsSpec.httpureEffectsSpec
   LookupSpec.lookupSpec
   MethodSpec.methodSpec
   PathSpec.pathSpec