Seperate view code and clarify the proof
This commit is contained in:
parent
8463e3dec0
commit
dcd44d1e93
3 changed files with 43 additions and 29 deletions
|
@ -3,7 +3,7 @@ SITEDIR = $(shell pkg-config guile-2.0 --variable=sitedir \
|
||||||
--define-variable=prefix=$(DESTDIR))
|
--define-variable=prefix=$(DESTDIR))
|
||||||
COMPDIR = $(DESTDIR)/lib/guile/2.0/site-ccache
|
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))
|
install-objects = $(addprefix install-,$(objects))
|
||||||
uninstall-objects = $(addprefix uninstall-,$(objects))
|
uninstall-objects = $(addprefix uninstall-,$(objects))
|
||||||
|
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
#:use-module (oop goops)
|
#:use-module (oop goops)
|
||||||
|
#:use-module (undone view)
|
||||||
#:export (main))
|
#:export (main))
|
||||||
|
|
||||||
(define-syntax get-field
|
(define-syntax get-field
|
||||||
|
@ -161,31 +162,6 @@
|
||||||
(string->number (car args)))))
|
(string->number (car args)))))
|
||||||
todo-list)))
|
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-class <todo-view> (<view>))
|
||||||
|
|
||||||
(define-method (sort-view (v <todo-view>) l)
|
(define-method (sort-view (v <todo-view>) l)
|
||||||
|
@ -193,8 +169,13 @@
|
||||||
|
|
||||||
(define-method (filter-view (v <todo-view>))
|
(define-method (filter-view (v <todo-view>))
|
||||||
(lambda (elm)
|
(lambda (elm)
|
||||||
(let ((id (assq 'id elm)))
|
(let ((state (assq 'state elm)))
|
||||||
(and id (> (cdr id) 4)))))
|
(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
|
(define-view default
|
||||||
"Default todo-list view, show only the title."
|
"Default todo-list view, show only the title."
|
||||||
|
@ -241,4 +222,4 @@
|
||||||
(car view) (procedure-documentation (cdr view))))
|
(car view) (procedure-documentation (cdr view))))
|
||||||
view-list))))
|
view-list))))
|
||||||
|
|
||||||
(print-view (make <todo-view>)))
|
(print-view (make <todo-view> #:todo-list todo-list)))
|
||||||
|
|
33
undone/view.scm
Normal file
33
undone/view.scm
Normal 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)))
|
Loading…
Reference in a new issue