From 40566cee5b3f89cfc3275b7bf7d3a1e0d3b2007a Mon Sep 17 00:00:00 2001
From: Tom Willemsen <tom@ryuslash.org>
Date: Wed, 26 Sep 2012 01:05:41 +0200
Subject: [PATCH] GOOPS "Proof of concept"

Doesn't actually do anything yet, but shows where to start.
---
 undone/main.scm | 40 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 39 insertions(+), 1 deletion(-)

diff --git a/undone/main.scm b/undone/main.scm
index e34450c..cac9581 100644
--- a/undone/main.scm
+++ b/undone/main.scm
@@ -1,6 +1,7 @@
 (define-module (undone main)
   #:use-module (ice-9 format)
   #:use-module (ice-9 rdelim)
+  #:use-module (oop goops)
   #:export (main))
 
 (define-syntax get-field
@@ -165,6 +166,41 @@
                             (string->number (car args)))))
                 todo-list)))
 
+(define-class <view> ())
+
+(define-generic print-view)
+(define-generic sort-view)
+(define-generic filter-view)
+
+(define-method (sort-view (v <view>) l)
+  l)
+
+(define-method (filter-view (v <view>))
+  (lambda (elm)
+    (and (assq 'id elm) (assq 'content elm))))
+
+(define-method (print-view (v <view>))
+  (for-each
+   (lambda (item)
+     (let ((id (let ((field (assq 'id item)))
+                 (and field (cdr field))))
+           (content
+            (let ((field (assq 'content item)))
+              (and field (cdr field)))))
+       (if #t (format #t "~2d ~a~%" id content))))
+   (filter (filter-view v)
+           (sort-view v todo-list))))
+
+(define-class <todo-view> (<view>))
+
+(define-method (sort-view (v <todo-view>) l)
+  (reverse l))
+
+(define-method (filter-view (v <todo-view>))
+  (lambda (elm)
+    (let ((id (assq 'id elm)))
+    (and id (> (cdr id) 4)))))
+
 (define-view default
   "Default todo-list view, show only the title."
   "~2d ~a~%" id content)
@@ -208,4 +244,6 @@
           (lambda (view)
             (format #t "~a~20t~a~%"
                     (car view) (procedure-documentation (cdr view))))
-          view-list)))))
+          view-list))))
+
+  (print-view (make <todo-view>)))