Add support for custom monad run function in server

owickstrom · owickstrom · commit 772fd1811f06 · 2017-02-22T16:10:08.000+01:00
diff --git a/docs/src/type-level-routing/Site1.purs b/docs/src/type-level-routing/Site1.purs
@@ -3,11 +3,10 @@ module Site1 where
 import Prelude
 import Control.IxMonad ((:*>))
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE, log)
+import Control.Monad.Eff.Console (CONSOLE)
 import Data.Maybe (maybe)
 import Data.MediaType.Common (textHTML)
 import Hyper.Node.Server (defaultOptions, runServer)
-import Hyper.Port (Port(Port))
 import Hyper.Response (contentType, respond, closeHeaders, writeStatus)
 import Hyper.Routing.ContentType.HTML (class EncodeHTML, HTML)
 import Hyper.Routing.Method (Get)
@@ -43,13 +42,8 @@ site1 = Proxy
 -- start snippet main
 main :: forall e. Eff (http :: HTTP, console :: CONSOLE, buffer :: BUFFER | e) Unit
 main =
-  runServer defaultOptions onListening onRequestError {} siteRouter
+  runServer defaultOptions {} siteRouter
   where
-    onListening (Port port) =
-      log ("Listening on http://localhost:" <> show port)
-
-    onRequestError err =
-      log ("Request failed: " <> show err)
 -- end snippet main
 
 -- start snippet router
diff --git a/docs/src/type-level-routing/Site2.purs b/docs/src/type-level-routing/Site2.purs
@@ -2,15 +2,14 @@ module Site2 where
 
 import Control.IxMonad ((:*>))
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (log, CONSOLE)
+import Control.Monad.Eff.Console (CONSOLE)
 import Control.Monad.Error.Class (throwError)
 import Control.Monad.Except (ExceptT)
 import Data.Array (find)
 import Data.Maybe (Maybe(..), maybe)
 import Data.MediaType.Common (textHTML)
 import Data.Traversable (traverse_)
 import Hyper.Node.Server (defaultOptions, runServer)
-import Hyper.Port (Port(..))
 import Hyper.Response (closeHeaders, contentType, respond, writeStatus)
 import Hyper.Routing (type (:/), type (:<|>), type (:>), Capture, (:<|>))
 import Hyper.Routing.ContentType.HTML (class EncodeHTML, HTML, linkTo)
@@ -110,11 +109,5 @@ main =
         :*> closeHeaders
         :*> respond (maybe "" id msg)
 
-      onListening (Port port) =
-        log ("Listening on http://localhost:" <> show port)
-
-      onRequestError err =
-        log ("Request failed: " <> show err)
-
-  in runServer defaultOptions onListening onRequestError {} otherSiteRouter
+  in runServer defaultOptions {} otherSiteRouter
 -- end snippet main
diff --git a/docs/src/type-level-routing/Site3.purs b/docs/src/type-level-routing/Site3.purs
@@ -2,7 +2,7 @@ module Site3 where
 
 import Control.IxMonad ((:*>))
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (log, CONSOLE)
+import Control.Monad.Eff.Console (CONSOLE)
 import Control.Monad.Error.Class (throwError)
 import Control.Monad.Except (ExceptT)
 import Data.Argonaut (class EncodeJson, encodeJson, fromArray, jsonEmptyObject, (:=), (~>))
@@ -11,7 +11,6 @@ import Data.Foldable (traverse_)
 import Data.Maybe (Maybe(..), maybe)
 import Data.MediaType.Common (textHTML)
 import Hyper.Node.Server (defaultOptions, runServer)
-import Hyper.Port (Port(..))
 import Hyper.Response (closeHeaders, contentType, respond, writeStatus)
 import Hyper.Routing (type (:/), type (:<|>), type (:>), Capture, (:<|>))
 import Hyper.Routing.ContentType.HTML (class EncodeHTML, HTML, linkTo)
@@ -115,10 +114,4 @@ main =
         :*> closeHeaders
         :*> respond (maybe "" id msg)
 
-      onListening (Port port) =
-        log ("Listening on http://localhost:" <> show port)
-
-      onRequestError err =
-        log ("Request failed: " <> show err)
-
-  in runServer defaultOptions onListening onRequestError {} site3Router
+  in runServer defaultOptions {} site3Router
diff --git a/examples/Authentication.purs b/examples/Authentication.purs
@@ -5,13 +5,12 @@ import Hyper.Node.BasicAuth as BasicAuth
 import Control.IxMonad ((:>>=), (:*>))
 import Control.Monad.Aff (Aff)
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (log, CONSOLE)
+import Control.Monad.Eff.Console (CONSOLE)
 import Data.Maybe (Maybe(Just, Nothing))
 import Data.MediaType.Common (textHTML)
 import Data.Tuple (Tuple(Tuple))
 import Hyper.Middleware.Class (getConn)
 import Hyper.Node.Server (runServer, defaultOptions)
-import Hyper.Port (Port(..))
 import Hyper.Response (closeHeaders, contentType, respond, writeStatus)
 import Hyper.Status (statusOK)
 import Node.Buffer (BUFFER)
@@ -32,9 +31,6 @@ userFromBasicAuth =
 main :: forall e. Eff (console :: CONSOLE, http ∷ HTTP, buffer :: BUFFER | e) Unit
 main =
   let
-    onListening (Port port) = log ("Listening on http://localhost:" <> show port)
-    onRequestError err = log ("Request failed: " <> show err)
-
     myProfilePage =
       getConn :>>= \conn ->
       case conn.components.authentication of
@@ -48,4 +44,4 @@ main =
       BasicAuth.withAuthentication userFromBasicAuth
       :*> BasicAuth.authenticated "Authentication Example" myProfilePage
     components = { authentication: unit }
-  in runServer defaultOptions onListening onRequestError components app
+  in runServer defaultOptions components app
diff --git a/examples/AuthenticationAndAuthorization.purs b/examples/AuthenticationAndAuthorization.purs
@@ -14,7 +14,7 @@ import Control.IxMonad ((:>>=), (:*>))
 import Control.Monad.Aff.AVar (AVAR)
 import Control.Monad.Aff.Class (class MonadAff)
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (log, CONSOLE)
+import Control.Monad.Eff.Console (CONSOLE)
 import Control.Monad.Eff.Exception (EXCEPTION)
 import Data.Either (Either(..))
 import Data.HTTP.Method (CustomMethod, Method(..))
@@ -27,7 +27,6 @@ import Hyper.Conn (Conn)
 import Hyper.Middleware (Middleware)
 import Hyper.Middleware.Class (getConn)
 import Hyper.Node.Server (defaultOptions, runServer)
-import Hyper.Port (Port(..))
 import Hyper.Response (class Response, class ResponseWriter, ResponseEnded, StatusLineOpen, closeHeaders, contentType, respond, writeStatus)
 import Hyper.Status (Status, statusNotFound, statusOK)
 import Node.Buffer (BUFFER)
@@ -196,9 +195,7 @@ app = BasicAuth.withAuthentication userFromBasicAuth :>>= \_ → router
 main :: forall e. Eff (http :: HTTP, console :: CONSOLE, err :: EXCEPTION, avar :: AVAR, buffer :: BUFFER | e) Unit
 main =
   let
-    onListening (Port port) = log ("Listening on http://localhost:" <> show port)
-    onRequestError err = log ("Request failed: " <> show err)
     components = { authentication: unit
                  , authorization: unit
                  }
-  in runServer defaultOptions onListening onRequestError components app
+  in runServer defaultOptions components app
diff --git a/examples/FileServer.purs b/examples/FileServer.purs
@@ -3,11 +3,10 @@ module Examples.FileServer where
 import Prelude
 import Control.IxMonad ((:*>))
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE, log)
+import Control.Monad.Eff.Console (CONSOLE)
 import Data.Tuple (Tuple(Tuple))
 import Hyper.Node.FileServer (fileServer)
 import Hyper.Node.Server (defaultOptions, runServer)
-import Hyper.Port (Port(..))
 import Hyper.Response (headers, respond, writeStatus)
 import Hyper.Status (statusNotFound)
 import Node.Buffer (BUFFER)
@@ -18,11 +17,9 @@ import Node.HTTP (HTTP)
 main :: forall e. Eff (console :: CONSOLE, http ∷ HTTP, fs :: FS, buffer :: BUFFER | e) Unit
 main =
   let
-    onListening (Port port) = log ("Serving files at http://localhost:" <> show port)
-    onRequestError err = log ("Request failed: " <> show err)
     notFound =
       writeStatus statusNotFound
       :*> headers []
       :*> respond (Tuple "<h1>Not Found</h1>" UTF8)
     app = fileServer "examples/FileServer" notFound
-  in runServer defaultOptions onListening onRequestError {} app
+  in runServer defaultOptions {} app
diff --git a/examples/FormParser.purs b/examples/FormParser.purs
@@ -17,7 +17,6 @@ import Data.Tuple (lookup)
 import Hyper.Form (Form(Form), parseForm)
 import Hyper.Middleware.Class (getConn)
 import Hyper.Node.Server (readBodyAsString, defaultOptions, runServer)
-import Hyper.Port (Port(..))
 import Hyper.Response (closeHeaders, contentType, respond, writeStatus)
 import Hyper.Status (statusBadRequest, statusMethodNotAllowed, statusOK)
 import Node.HTTP (HTTP)
@@ -89,10 +88,5 @@ main =
     -- handler.
     app = readBodyAsString :*> router
 
-    -- Some nice console printing when the server starts, and if a request
-    -- fails (in this case when the request body is unreadable for some reason).
-    onListening (Port port) = log ("Listening on http://localhost:" <> show port)
-    onRequestError err = log ("Request failed: " <> show err)
-
   -- Let's run it.
-  in runServer defaultOptions onListening onRequestError {} app
+  in runServer defaultOptions {} app
diff --git a/examples/HelloHyper.purs b/examples/HelloHyper.purs
@@ -3,20 +3,17 @@ module Examples.HelloHyper where
 import Prelude
 import Control.IxMonad ((:*>))
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE, log)
+import Control.Monad.Eff.Console (CONSOLE)
 import Hyper.Node.Server (defaultOptions, runServer)
-import Hyper.Port (Port(..))
 import Hyper.Response (closeHeaders, respond, writeStatus)
 import Hyper.Status (statusOK)
 import Node.HTTP (HTTP)
 
 main :: forall e. Eff (console :: CONSOLE, http :: HTTP | e) Unit
 main =
   let
-    onListening (Port port) = log ("Listening on http://localhost:" <> show port)
-    onRequestError err = log ("Request failed: " <> show err)
     app = do
       writeStatus statusOK
       :*> closeHeaders
       :*> respond "Hello, Hyper!"
-  in runServer defaultOptions onListening onRequestError {} app
+  in runServer defaultOptions {} app
diff --git a/examples/NodeStreamResponse.purs b/examples/NodeStreamResponse.purs
@@ -9,12 +9,11 @@ import Control.IxMonad ((:*>))
 import Control.Monad.Aff (later')
 import Control.Monad.Aff.Class (class MonadAff, liftAff)
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (CONSOLE, log)
+import Control.Monad.Eff.Console (CONSOLE)
 import Data.Traversable (traverse_)
 import Data.Tuple (Tuple(..))
 import Hyper.Middleware (Middleware, lift')
 import Hyper.Node.Server (defaultOptions, runServer, writeString)
-import Hyper.Port (Port(..))
 import Hyper.Response (closeHeaders, end, send, writeStatus)
 import Hyper.Status (statusOK)
 import Node.Encoding (Encoding(..))
@@ -26,9 +25,6 @@ delay n = lift' (liftAff (later' n (pure unit)))
 main :: forall e. Eff (console :: CONSOLE, http :: HTTP | e) Unit
 main =
   let
-    onListening (Port port) = log ("Listening on http://localhost:" <> show port)
-    onRequestError err = log ("Request failed: " <> show err)
-
     -- These messages are streamed one at a time, regardless of their individual
     -- delays, i.e. they're sequenced.
     streamMessages =
@@ -44,4 +40,4 @@ main =
       :*> closeHeaders
       :*> streamMessages
       :*> end
-  in runServer defaultOptions onListening onRequestError {} app
+  in runServer defaultOptions {} app
diff --git a/examples/Routing.purs b/examples/Routing.purs
@@ -5,7 +5,7 @@ import Control.IxMonad ((:*>))
 import Control.Monad.Aff (Aff)
 import Control.Monad.Aff.AVar (AVAR)
 import Control.Monad.Eff (Eff)
-import Control.Monad.Eff.Console (log, CONSOLE)
+import Control.Monad.Eff.Console (CONSOLE)
 import Control.Monad.Eff.Exception (EXCEPTION)
 import Control.Monad.Error.Class (throwError)
 import Control.Monad.Except (ExceptT)
@@ -16,7 +16,6 @@ import Data.Generic (class Generic)
 import Data.Maybe (Maybe(..), maybe)
 import Data.MediaType.Common (textHTML)
 import Hyper.Node.Server (defaultOptions, runServer)
-import Hyper.Port (Port(..))
 import Hyper.Response (closeHeaders, contentType, respond, writeStatus)
 import Hyper.Routing (type (:/), type (:<|>), type (:>), Capture, (:<|>))
 import Hyper.Routing.ContentType.HTML (class EncodeHTML, HTML, linkTo)
@@ -98,10 +97,8 @@ viewPost postId =
 
 main :: forall e. Eff (http :: HTTP, console :: CONSOLE, err :: EXCEPTION, avar :: AVAR | e) Unit
 main =
-  runServer defaultOptions onListening onRequestError {} siteRouter
+  runServer defaultOptions {} siteRouter
   where
-    onListening (Port port) = log ("Listening on http://localhost:" <> show port)
-    onRequestError err = log ("Request failed: " <> show err)
     siteRouter = router site (postsView :<|> viewPost) onRoutingError
     onRoutingError status msg = do
       writeStatus status
diff --git a/src/Hyper/Node/Server.purs b/src/Hyper/Node/Server.purs
