Seperate view code and clarify the proof

This commit is contained in:
Tom Willemsen 2012-09-27 01:41:02 +02:00
parent 8463e3dec0
commit dcd44d1e93
3 changed files with 43 additions and 29 deletions

View file

@ -3,7 +3,7 @@ SITEDIR = $(shell pkg-config guile-2.0 --variable=sitedir \
--define-variable=prefix=$(DESTDIR))
COMPDIR = $(DESTDIR)/lib/guile/2.0/site-ccache
objects = main.scm main.go
objects = main.scm main.go view.scm view.go
install-objects = $(addprefix install-,$(objects))
uninstall-objects = $(addprefix uninstall-,$(objects))

View file

@ -2,6 +2,7 @@
#:use-module (ice-9 format)
#:use-module (ice-9 rdelim)
#:use-module (oop goops)
#:use-module (undone view)
#:export (main))
(define-syntax get-field
@ -161,31 +162,6 @@
(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)
@ -193,8 +169,13 @@
(define-method (filter-view (v <todo-view>))
(lambda (elm)
(let ((id (assq 'id elm)))
(and id (> (cdr id) 4)))))
(let ((state (assq 'state elm)))
(and state (not (string= (cdr state) "done"))))))
(define-method (print-item (v <todo-view>) item)
(format #t "~a ~a~%"
(cdr (assq 'state item))
(cdr (assq 'content item))))
(define-view default
"Default todo-list view, show only the title."
@ -241,4 +222,4 @@
(car view) (procedure-documentation (cdr view))))
view-list))))
(print-view (make <todo-view>)))
(print-view (make <todo-view> #:todo-list todo-list)))

33
undone/view.scm Normal file
View file

@ -0,0 +1,33 @@
(define-module (undone view)
#:use-module (oop goops)
#:export (<view> sort-view filter-view print-item get-list-for
print-view))
(define-generic sort-view)
(define-generic filter-view)
(define-generic print-item)
(define-generic get-list-for)
(define-generic print-view)
(define-class <view> ()
(todo-list #:init-value '() #:init-keyword #:todo-list))
(define-method (sort-view (v <view>) l) l)
(define-method (print-item (v <view>) item)
(format #t "~2d ~a~%"
(cdr (assq 'id item))
(cdr (assq 'content item))))
(define-method (filter-view (v <view>))
(lambda (elm)
(and (assq 'id elm) (assq 'content elm))))
(define-method (get-list-for (v <view>))
(filter (filter-view v)
(sort-view v (slot-ref v 'todo-list))))
(define-method (print-view (v <view>))
(for-each
(lambda (item) (print-item v item))
(get-list-for v)))