Adapt writeString to aff-4.0.0

Author: paluh

src/Hyper/Node/Server.purs

@@ -71,30 +71,24 @@ derive instance newtypeNodeResponse ∷ Newtype (NodeResponse m e) _
 
 writeString :: forall m e. MonadAff e m => Encoding -> String -> NodeResponse m e
 writeString enc str =
-  NodeResponse $ \w -> liftAff (makeAff (writeChunk w 0))
+  NodeResponse $ \w -> liftAff (writeString' w 0)
   where
-    -- We operate on a (Array Char), instead of the String, to slice
-    -- it into chunks:
     chars = String.toCharArray str
     totalLength = Array.length chars
-    -- This function writes a chunk at the given offset, and recurses
-    -- if there are more chunks to be written.
-    writeChunk w offset fail succeed = do
-      -- We ignore the result of write as we cannot access the 'drain'
-      -- event anyway:
-      void $
-        Stream.writeString w enc (String.fromCharArray chunk) $
-        -- In the callback from `writeString`, we succeed the Aff
-        -- value if we have just written the last chunk, otherwise we
-        -- keep on writing chunks.
-        if isLastChunk
-          then succeed unit
-          else writeChunk w nextOffset fail succeed
-      where
-        chunkSize = 1024 * 8
+    chunkSize = 1024 * 8
+
+    writeString' w offset = do
+      let
         nextOffset = min totalLength (offset + chunkSize)
         isLastChunk = nextOffset == totalLength
         chunk = Array.slice offset nextOffset chars
+      writeChunk w chunk
+      if isLastChunk
+        then pure unit
+        else writeString' w nextOffset
+
+    writeChunk w chunk = makeAff (\k → do
+        Stream.writeString w enc (String.fromCharArray chunk) (k (Right unit)) *> pure nonCanceler)
 
 write :: forall m e. MonadAff e m => Buffer -> NodeResponse m e
 write buffer = NodeResponse $ \w ->

test/Hyper/Node/ServerSpec.js

@@ -7,7 +7,7 @@ var stream = require('stream'),
 function MemoryWritableStream(writeDelay, options) {
   if (!(this instanceof MemoryWritableStream))
     return new MemoryWritableStream(options);
-  this.writeDelay = 500;
+  this.writeDelay = writeDelay;
   this.output = new buffer.Buffer([]);
   stream.Writable.call(this, options);
 }
@@ -16,7 +16,8 @@ util.inherits(MemoryWritableStream, stream.Writable);
 MemoryWritableStream.prototype._write = function(chunk, encoding, cb) {
   var that = this;
   setTimeout(function() {
-    that.output.concat([chunk]);
+    that.output = Buffer.concat([that.output, chunk]);
+    cb();
   }, this.writeDelay);
 };
 

test/Hyper/Node/ServerSpec.purs

@@ -35,8 +35,8 @@ foreign import streamBufferImpl ∷ ∀ eff. EffFn1 eff (WritableStream eff) Buf
 streamBuffer ∷ ∀ eff. WritableStream eff → Eff eff Buffer
 streamBuffer = runEffFn1 streamBufferImpl
 
-testString :: forall eff. Int -> Aff eff String
-testString totalLength = do
+buildTestString :: forall eff. Int -> Aff eff String
+buildTestString totalLength = do
   let
     str = go "a" 1
   length str `shouldEqual` totalLength
@@ -51,18 +51,18 @@ spec =
   describe "Hyper.Node.Server" do
     describe "writeString" do
       it "handles empty string" do
-        output ← liftEff $ memoryWritableStream 100
+        output ← liftEff $ memoryWritableStream 10
         let writer = unwrap $ writeString UTF8 ""
         writer (toWritable output)
 
       it "handles short (< 16 KB) string" do
-        output ← liftEff $ memoryWritableStream 100
-        str ← testString 3000
+        output ← liftEff $ memoryWritableStream 10
+        str ← buildTestString 3000
         let writer = unwrap $ writeString UTF8 str
         writer (toWritable output)
 
       it "handles long (> 64 KB) string" do
-        str ← testString 65000
-        output ← liftEff $ memoryWritableStream 100
+        str ← buildTestString 65000
+        output ← liftEff $ memoryWritableStream 10
         let writer = unwrap $ writeString UTF8 str
         writer (toWritable output)