From 6159d4a5ffaa39b2420b002e8f98d27efb906182 Mon Sep 17 00:00:00 2001
From: Eitaro Fukamachi <e.arrows@gmail.com>
Date: Tue, 27 Sep 2016 12:35:57 +0900
Subject: [PATCH] Add lack.util.writer-stream for treating delayed responding
 writer as a stream.

---
 lack-util-writer-stream.asd | 12 +++++++++
 src/util/writer-stream.lisp | 50 +++++++++++++++++++++++++++++++++++++
 t/util/writer-stream.lisp   | 28 +++++++++++++++++++++
 3 files changed, 90 insertions(+)
 create mode 100644 lack-util-writer-stream.asd
 create mode 100644 src/util/writer-stream.lisp
 create mode 100644 t/util/writer-stream.lisp

diff --git a/lack-util-writer-stream.asd b/lack-util-writer-stream.asd
new file mode 100644
index 0000000..5224ce7
--- /dev/null
+++ b/lack-util-writer-stream.asd
@@ -0,0 +1,12 @@
+(in-package :cl-user)
+(defpackage :lack-util-writer-stream-asd
+  (:use :cl :asdf))
+(in-package :lack-util-writer-stream-asd)
+
+(defsystem lack-util-writer-stream
+  :version "0.1"
+  :author "Eitaro Fukamachi"
+  :license "LLGPL"
+  :depends-on (:trivial-gray-streams
+               :babel)
+  :components ((:file "src/util/writer-stream")))
diff --git a/src/util/writer-stream.lisp b/src/util/writer-stream.lisp
new file mode 100644
index 0000000..3aa24a1
--- /dev/null
+++ b/src/util/writer-stream.lisp
@@ -0,0 +1,50 @@
+(in-package :cl-user)
+(defpackage lack.util.writer-stream
+  (:use :cl)
+  (:import-from :trivial-gray-streams
+                :fundamental-output-stream
+                :stream-write-byte
+                :stream-write-sequence
+                :stream-write-char
+                :stream-write-string
+                :stream-finish-output
+                :open-stream-p)
+  (:import-from :babel
+                :string-to-octets)
+  (:export :writer-stream
+           :make-writer-stream))
+(in-package :lack.util.writer-stream)
+
+(defclass writer-stream (fundamental-output-stream)
+  ((writer :type function
+           :initarg :writer
+           :accessor writer-stream-writer)
+   (closed-p :type boolean
+             :initform nil
+             :accessor writer-stream-closed-p)))
+
+(defun make-writer-stream (writer)
+  (check-type writer function)
+  (make-instance 'writer-stream :writer writer))
+
+(defmethod stream-write-byte ((stream writer-stream) byte)
+  (funcall (writer-stream-writer stream)
+           (make-array 1 :element-type '(unsigned-byte 8) :initial-contents (list byte))))
+
+(defmethod stream-write-sequence ((stream writer-stream) sequence start end &key)
+  (funcall (writer-stream-writer stream) sequence :start start :end end))
+
+(defmethod stream-write-char ((stream writer-stream) char)
+  (let ((string (make-string 1 :initial-element char)))
+    (funcall (writer-stream-writer stream) (babel:string-to-octets string))))
+
+(defmethod stream-write-string ((stream writer-stream) string &optional (start 0) (end (length string)))
+  (funcall (writer-stream-writer stream) (babel:string-to-octets string :start start :end end)))
+
+(defmethod stream-finish-output ((stream writer-stream))
+  (funcall (writer-stream-writer stream) nil :close t)
+  (setf (writer-stream-closed-p stream) t)
+  nil)
+
+(defmethod open-stream-p ((stream writer-stream))
+  (not (writer-stream-closed-p stream)))
diff --git a/t/util/writer-stream.lisp b/t/util/writer-stream.lisp
new file mode 100644
index 0000000..cfaa742
--- /dev/null
+++ b/t/util/writer-stream.lisp
@@ -0,0 +1,28 @@
+(in-package :cl-user)
+(defpackage t-lack.util.writer-stream
+  (:use :cl
+        :lack.util.writer-stream
+        :prove))
+(in-package :t-lack.util.writer-stream)
+
+(plan 6)
+
+(let* ((bodies '())
+       (writer
+         (lambda (body &key &allow-other-keys)
+           (push body bodies)))
+       (stream (make-writer-stream writer)))
+  (is-type stream 'writer-stream)
+  (ok (open-stream-p stream))
+  (write-sequence #(72 101 108 108 111) stream)
+  (write-string "World" stream)
+  (is bodies '(#(87 111 114 108 100) #(72 101 108 108 111))
+      :test #'equalp)
+  (write-char #\! stream)
+  (is bodies '(#(33) #(87 111 114 108 100) #(72 101 108 108 111))
+      :test #'equalp)
+  (ok (open-stream-p stream))
+  (finish-output stream)
+  (ok (not (open-stream-p stream))))
+
+(finalize)