From d50be71fdcab0144b361a8e389795d52c5658859 Mon Sep 17 00:00:00 2001
From: Connor Prussin <connor@prussin.net>
Date: Wed, 27 Sep 2017 06:55:36 -0700
Subject: [PATCH] Make ResponseM async (#71)

---
 bower.json                            |  3 ++-
 docs/Examples/AsyncResponse/Hello     |  1 +
 docs/Examples/AsyncResponse/Main.purs | 35 +++++++++++++++++++++++++++
 docs/Examples/AsyncResponse/Readme.md | 12 +++++++++
 src/HTTPure/Body.purs                 |  4 +--
 src/HTTPure/HTTPureEffects.purs       | 15 ++++++++++++
 src/HTTPure/HTTPureM.purs             | 22 -----------------
 src/HTTPure/Request.purs              |  4 +--
 src/HTTPure/Response.purs             | 11 ++++++---
 src/HTTPure/Server.purs               | 21 ++++++++--------
 test/HTTPure/HTTPureEffectsSpec.purs  | 11 +++++++++
 test/HTTPure/HTTPureMSpec.purs        | 11 ---------
 test/HTTPure/IntegrationSpec.purs     |  9 +++++++
 test/HTTPure/ResponseSpec.purs        |  4 +--
 test/HTTPureSpec.purs                 |  4 +--
 15 files changed, 112 insertions(+), 55 deletions(-)
 create mode 100644 docs/Examples/AsyncResponse/Hello
 create mode 100644 docs/Examples/AsyncResponse/Main.purs
 create mode 100644 docs/Examples/AsyncResponse/Readme.md
 create mode 100644 src/HTTPure/HTTPureEffects.purs
 delete mode 100644 src/HTTPure/HTTPureM.purs
 create mode 100644 test/HTTPure/HTTPureEffectsSpec.purs
 delete mode 100644 test/HTTPure/HTTPureMSpec.purs

diff --git a/bower.json b/bower.json
index 550ee40..9058831 100644
--- a/bower.json
+++ b/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"
   }
 }
diff --git a/docs/Examples/AsyncResponse/Hello b/docs/Examples/AsyncResponse/Hello
new file mode 100644
index 0000000..bc7774a
--- /dev/null
+++ b/docs/Examples/AsyncResponse/Hello
@@ -0,0 +1 @@
+hello world!
\ No newline at end of file
diff --git a/docs/Examples/AsyncResponse/Main.purs b/docs/Examples/AsyncResponse/Main.purs
new file mode 100644
index 0000000..2274b86
--- /dev/null
+++ b/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 $ " └────────────────────────────────────────────┘"
diff --git a/docs/Examples/AsyncResponse/Readme.md b/docs/Examples/AsyncResponse/Readme.md
new file mode 100644
index 0000000..80bc1f3
--- /dev/null
+++ b/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
+```
diff --git a/src/HTTPure/Body.purs b/src/HTTPure/Body.purs
index fb3d9c9..a6c98b6 100644
--- a/src/HTTPure/Body.purs
+++ b/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 ""
diff --git a/src/HTTPure/HTTPureEffects.purs b/src/HTTPure/HTTPureEffects.purs
new file mode 100644
index 0000000..ced8f09
--- /dev/null
+++ b/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
+  )
diff --git a/src/HTTPure/HTTPureM.purs b/src/HTTPure/HTTPureM.purs
deleted file mode 100644
index 3ebad0c..0000000
--- a/src/HTTPure/HTTPureM.purs
+++ /dev/null
@@ -1,22 +0,0 @@
-module HTTPure.HTTPureM
-  ( HTTPureM
-  , HTTPureEffects
-  ) where
-
-import Control.Monad.Eff as Eff
-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
-  )
-
--- | The `HTTPureM` monad represents effects run by an HTTPure server. It takes
--- | an effects row parameter which enumerates all other side-effects performed
--- | while carrying out the server actions.
-type HTTPureM e t = Eff.Eff (HTTPureEffects e) t
diff --git a/src/HTTPure/Request.purs b/src/HTTPure/Request.purs
index 5fa7812..763b9e3 100644
--- a/src/HTTPure/Request.purs
+++ b/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 $
diff --git a/src/HTTPure/Response.purs b/src/HTTPure/Response.purs
index 9805df5..e174fc3 100644
--- a/src/HTTPure/Response.purs
+++ b/src/HTTPure/Response.purs
@@ -77,17 +77,19 @@ 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
@@ -95,7 +97,10 @@ 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
diff --git a/src/HTTPure/Server.purs b/src/HTTPure/Server.purs
index 8b376d6..6c52fa8 100644
--- a/src/HTTPure/Server.purs
+++ b/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 ->
diff --git a/test/HTTPure/HTTPureEffectsSpec.purs b/test/HTTPure/HTTPureEffectsSpec.purs
new file mode 100644
index 0000000..62cb2f4
--- /dev/null
+++ b/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
diff --git a/test/HTTPure/HTTPureMSpec.purs b/test/HTTPure/HTTPureMSpec.purs
deleted file mode 100644
index 986c421..0000000
--- a/test/HTTPure/HTTPureMSpec.purs
+++ /dev/null
@@ -1,11 +0,0 @@
-module HTTPure.HTTPureMSpec where
-
-import Prelude
-
-import Test.Spec as Spec
-
-import HTTPure.SpecHelpers as SpecHelpers
-
-httpureMSpec :: SpecHelpers.Test
-httpureMSpec = Spec.describe "HTTPureM" do
-  pure unit
diff --git a/test/HTTPure/IntegrationSpec.purs b/test/HTTPure/IntegrationSpec.purs
index 55fa592..9d1ba37 100644
--- a/test/HTTPure/IntegrationSpec.purs
+++ b/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
diff --git a/test/HTTPure/ResponseSpec.purs b/test/HTTPure/ResponseSpec.purs
index 475ec4b..1ea76fa 100644
--- a/test/HTTPure/ResponseSpec.purs
+++ b/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
diff --git a/test/HTTPureSpec.purs b/test/HTTPureSpec.purs
index 1f888b7..d015f88 100644
--- a/test/HTTPureSpec.purs
+++ b/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