1 files changed, 39 insertions, 0 deletions
diff --git a/monad/writer.scm b/monad/writer.scm
new file mode 100644
index 0000000..8be72c2
--- /dev/null
+++ b/monad/writer.scm
@@ -0,0 +1,39 @@
+(define-module (monad writer)
+  #:use-module (oop goops)
+  #:use-module (ice-9 match)
+  #:use-module (monad monoid) ; ?
+  #:use-module (monad)
+  #:export (writer return-writer))
+
+(read-enable 'curly-infix)
+
+(define-class <writer> ()
+  (value #:init-keyword #:value)
+  (monoid #:init-keyword #:monoid))
+
+(define (writer value context)
+  (make <writer>
+    #:value value
+    #:monoid context))
+
+(define-method (>>= (this <writer>)
+                    (proc <procedure>))
+  (match this (($ <writer> value monoid)
+               (match (proc value)
+                 (($ <writer> nval ncontext)
+                  (writer nval { monoid <> ncontext }))))))
+
+(define-method (>> (a <writer>)
+                   (b <writer>))
+  (match a (($ <writer> _ monoid-a)
+            (match b (($ <writer> val monoid-b)
+                      (writer val (<> monoid-a monoid-b))
+                      )))))
+
+;;; TODO replace this
+(define (return-writer val)
+  (writer val ""))
+
+(define-method (write (this <writer>) port)
+  (match this (($ <writer> value monoid)
+               (format port "[Writer ~s, ~s]" value monoid))))