Upgrade to purescript-aff v4

Author: owickstrom

bower.json

@@ -23,20 +23,20 @@
     "purescript-transformers": "^3.2.0",
     "purescript-node-http": "^4.0.0",
     "purescript-media-types": "^3.0.0",
-    "purescript-node-fs-aff": "^4.0.0",
+    "purescript-node-fs-aff": "^5.0.0",
     "purescript-generics-rep": "^5.0.0",
     "purescript-proxy": "^2.0.0",
     "purescript-argonaut": "^3.0.0",
     "purescript-arrays": "^4.0.1",
     "purescript-argonaut-codecs": "^3.0.0",
     "purescript-http-methods": "^3.0.0",
-    "purescript-indexed-monad": "^0.2.0",
+    "purescript-indexed-monad": "^0.3.0",
     "purescript-smolder": "^7.0.0",
-    "purescript-aff": "^3.1.0"
+    "purescript-aff": "^4.0.0"
   },
   "devDependencies": {
     "purescript-psci-support": "^3.0.0",
-    "purescript-spec": "^0.13.0",
-    "purescript-spec-discovery": "^0.5.0"
+    "purescript-spec": "^2.0.0",
+    "purescript-spec-discovery": "^2.0.0"
   }
 }

src/Hyper/Node/Server.purs

@@ -10,37 +10,38 @@ module Hyper.Node.Server
        ) where
 
 import Prelude
-import Data.HTTP.Method as Method
-import Data.Int as Int
-import Data.StrMap as StrMap
-import Node.Buffer as Buffer
-import Node.HTTP as HTTP
-import Node.Stream as Stream
+
 import Control.IxMonad (ipure, (:*>), (:>>=))
-import Control.Monad.Aff (Aff, launchAff, makeAff, runAff)
-import Control.Monad.Aff.AVar (putVar, takeVar, modifyVar, makeVar', AVAR, makeVar)
+import Control.Monad.Aff (Aff, launchAff, launchAff_, makeAff, nonCanceler, runAff_)
+import Control.Monad.Aff.AVar (AVAR, makeEmptyVar, makeVar, putVar, takeVar)
 import Control.Monad.Aff.Class (class MonadAff, liftAff)
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Class (class MonadEff, liftEff)
 import Control.Monad.Eff.Exception (EXCEPTION, catchException, error)
 import Control.Monad.Error.Class (throwError)
 import Data.Either (Either(..), either)
+import Data.HTTP.Method as Method
+import Data.Int as Int
 import Data.Lazy (defer)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (unwrap)
+import Data.StrMap as StrMap
 import Data.Tuple (Tuple(..))
 import Hyper.Conn (Conn)
 import Hyper.Middleware (Middleware, evalMiddleware, lift')
 import Hyper.Middleware.Class (getConn, modifyConn)
-import Hyper.Node.Server.Options as Hyper.Node.Server.Options
 import Hyper.Node.Server.Options (Options)
+import Hyper.Node.Server.Options as Hyper.Node.Server.Options
 import Hyper.Request (class ReadableBody, class Request, class StreamableBody, RequestData, parseUrl, readBody)
 import Hyper.Response (class ResponseWritable, class Response, ResponseEnded, StatusLineOpen)
 import Hyper.Status (Status(..))
 import Node.Buffer (BUFFER, Buffer)
+import Node.Buffer as Buffer
 import Node.Encoding (Encoding(..))
 import Node.HTTP (HTTP)
+import Node.HTTP as HTTP
 import Node.Stream (Stream, Writable)
+import Node.Stream as Stream
 
 
 data HttpRequest
@@ -62,15 +63,17 @@ newtype NodeResponse m e
 writeString :: forall m e. MonadAff e m => Encoding -> String -> NodeResponse m e
 writeString enc str = NodeResponse $ \w -> liftAff (makeAff (writeAsAff w))
   where
-    writeAsAff w fail succeed =
-      Stream.writeString w enc str (succeed unit) >>=
+    writeAsAff w k = do
+      Stream.writeString w enc str (k (pure unit)) >>=
       if _
-        then succeed unit
-        else fail (error "Failed to write string to response")
+        then k (pure unit)
+        else k (throwError (error "Failed to write string to response"))
+      pure nonCanceler
 
 write :: forall m e. MonadAff e m => Buffer -> NodeResponse m e
 write buffer = NodeResponse $ \w ->
-  liftAff (makeAff (\fail succeed -> void $ Stream.write w buffer (succeed unit)))
+  liftAff (makeAff (\k -> Stream.write w buffer (k (pure unit))
+                          *> pure nonCanceler))
 
 instance stringNodeResponse :: (MonadAff e m) => ResponseWritable (NodeResponse m e) m String where
   toResponse = ipure <<< writeString UTF8
@@ -92,8 +95,8 @@ readBodyAsBuffer
   -> Aff (http :: HTTP, avar :: AVAR, buffer :: BUFFER | e) Buffer
 readBodyAsBuffer (HttpRequest request _) = do
   let stream = HTTP.requestAsStream request
-  bodyResult <- makeVar
-  chunks <- makeVar' []
+  bodyResult <- makeEmptyVar
+  chunks <- makeVar []
   fillResult <- liftEff $
     catchException (pure <<< Left) (Right <$> fillBody stream chunks bodyResult)
   -- Await the body, or an error.
@@ -104,16 +107,19 @@ readBodyAsBuffer (HttpRequest request _) = do
     fillBody stream chunks bodyResult = do
       -- Append all chunks to the body buffer.
       Stream.onData stream \chunk ->
-        void (launchAff (modifyVar (_ <> [chunk]) chunks))
+        let modification = do
+              v <- takeVar chunks
+              putVar (v <> [chunk]) chunks
+        in void (launchAff modification)
       -- Complete with `Left` on error.
       Stream.onError stream $
-        void <<< launchAff <<< putVar bodyResult <<< Left
+        launchAff_ <<< flip putVar bodyResult <<< Left
       -- Complete with `Right` on successful "end" event.
       Stream.onEnd stream $ void $ launchAff $
         takeVar chunks
         >>= concat'
         >>= (pure <<< Right)
-        >>= putVar bodyResult
+        >>= flip putVar bodyResult
     concat' = liftEff <<< Buffer.concat
 
 instance readableBodyHttpRequestString :: (Monad m, MonadAff (http :: HTTP, avar :: AVAR, buffer :: BUFFER | e) m)
@@ -250,7 +256,14 @@ runServer' options components runM middleware = do
                  , response: HttpResponse response
                  , components: components
                  }
-      in conn # evalMiddleware middleware # runM # runAff options.onRequestError (const $ pure unit) # void
+          callback =
+            case _ of
+              Left err -> options.onRequestError err
+              Right _ -> pure unit
+      in conn
+         # evalMiddleware middleware
+         # runM
+         # runAff_ callback
 
 runServer
   :: forall e c c'.

src/Hyper/Node/Session/InMemory.purs

@@ -1,12 +1,13 @@
 module Hyper.Node.Session.InMemory where
 
 import Prelude
-import Data.Map as Map
+
 import Control.Monad.Aff (Aff)
-import Control.Monad.Aff.AVar (AVAR, AVar, makeVar', modifyVar, peekVar)
+import Control.Monad.Aff.AVar (AVAR, AVar, makeVar, putVar, readVar)
 import Control.Monad.Aff.Class (class MonadAff, liftAff)
 import Control.Monad.Aff.Console (CONSOLE, log)
 import Data.Map (Map)
+import Data.Map as Map
 import Data.Newtype (unwrap)
 import Hyper.Session (class SessionStore, SessionID(..))
 
@@ -25,19 +26,19 @@ instance sessionStoreInMemorySessionStore :: ( Monad m
   get (InMemorySessionStore var) id =
     liftAff do
       log ("Looking up session: " <> show (unwrap id))
-      Map.lookup id <$> peekVar var
+      Map.lookup id <$> readVar var
 
   put (InMemorySessionStore var) id session = do
     liftAff do
       log ("Saving session: " <> unwrap id)
-      modifyVar (Map.insert id session) var
+      Map.insert id session <$> readVar var >>= flip putVar var
 
   delete (InMemorySessionStore var) id = do
     liftAff do
       log ("Deleting session: " <> unwrap id)
-      modifyVar (Map.delete id) var
+      Map.delete id <$> readVar var >>= flip putVar var
 
 newInMemorySessionStore
   :: forall e session
    . Aff ( avar ∷ AVAR | e ) (InMemorySessionStore session)
-newInMemorySessionStore = InMemorySessionStore <$> makeVar' Map.empty
+newInMemorySessionStore = InMemorySessionStore <$> makeVar Map.empty