Shiro(2007/04/22 20:10:07 PDT): Inspired by an entry of Lisp movies ( http://homepage.mac.com/svc/LispMovies/index.html ) episode 2: (Re)writing Reddit in Lisp is 20 minutes and 100 lines, I tried the same thing in Scheme.
Here I use Kahua, a continuation-based web app framework built on top of a Scheme implementation Gauche.
This is minimal - no style, no input validation, no user registration, no comments. It does have a persistent storage. The class <entry> uses Kahua's persistent object feature. (Inheriting from <kahua-persistent-base> and adding :allocation :persistent makes objects persistent automagically.)
I got an impression that the point comes down to frameworks, not languages, after all.
;; -*- coding: utf-8 ; mode: scheme-*-
(use gauche.collection)
(define-class <entry> (<kahua-persistent-base>)
((url :init-keyword :url :allocation :persistent)
(title :init-keyword :title :allocation :persistent)
(score :init-value 1 :allocation :persistent)))
(define (main-page)
(define (show-urls)
(node-list->node-set
(map (lambda (e)
(tr:
(td: (a: (@: (href (ref e 'url))) (ref e 'title))
(format "(~a points)" (ref e 'score))
(a/cont: (@@: (cont (lambda () (inc! (ref e 'score)) (show))))
"[up]")
(a/cont: (@@: (cont (lambda () (dec! (ref e 'score)) (show))))
"[down]"))))
(sort (coerce-to <list> (make-kahua-collection <entry>))
(lambda (a b) (> (ref a 'score) (ref b 'score)))))))
(define commit-url
(entry-lambda (:keyword url title)
(make <entry> :url url :title title)
(show)))
(define submit-form
(entry-lambda ()
(node-set:
(html:
(head: (title: "Reddit-modoki"))
(body: (h1: "Submit URL")
(form/cont:
(@@: (cont commit-url '(url) '(title)))
(table:
(tr: (th: "URL")
(td: (input: (@: (type "text") (name "url") (value "")))))
(tr: (th: "Title")
(td: (input: (@: (type "text") (name "title") (value "")))))
(tr: (th:)
(td: (input: (@: (type "submit") (name "submit") (value "submit"))))))
))))))
(define (show)
(node-set:
(html:
(head: (title: "Reddit-modoki"))
(body:
(h1: "Reddit-modoki")
(div: (@: (style "text-align: right"))
(a/cont: (@@: (cont submit-form)) "[Submit URL]"))
(table: (show-urls))))))
(show))
(initialize-main-proc main-page)
び(2007/05/23 16:40:20 PDT): I rewrote shiro's code in new fashion ;-)
;; -*- coding: utf-8; mode: kahua -*-
(use gauche.collection)
(define page-template
(kahua:make-xml-template
(kahua-template-path "bookmarks/page.xml")))
(define-class <bookmark-entry> (<kahua-persistent-base>)
((url :init-keyword :url :allocation :persistent :index :unique)
(title :init-keyword :title :allocation :persistent :index :any)
(score :init-value 1 :allocation :persistent)
(count :init-value 0 :allocation :persistent)))
(define-entry (index)
(define (bookmark-list/)
(table/
(tr/ (th/ (a/cont/ (@@/ (cont new)) "[new]")) (th/ "count") (th/ "score"))
(map/ (lambda (bm)
(tr/ (th/ (a/cont/ (@@/ (cont (cut go/countup bm))) (ref bm 'title)))
(td/ (@/ (class "numeric")) (ref bm 'count))
(td/ (@/ (class "numeric")) (ref bm 'score))
(td/ (a/cont/ "[up]"
(@@/ (cont (lambda ()
(inc! (ref bm 'score))
(redirect/cont (cont index))))))
(a/cont/ "[down]"
(@@/ (cont (lambda ()
(dec! (ref bm 'score))
(redirect/cont (cont index)))))))))
(sort! (coerce-to <list> (make-kahua-collection <bookmark-entry>))
(lambda (a b) (> (ref a 'score) (ref b 'score)))))))
(kahua:xml-template->sxml
page-template
:title (title/ "Reddit modoki revised")
:body (bookmark-list/)))
(define (go/countup bm)
(inc! (ref bm 'count))
(html/
(extra-header/ (@/ (name "Status") (value "302 Found")))
(extra-header/ (@/ (name "Location") (value (ref bm 'url))))))
(define-entry (new)
(define (submit-url-form/)
(form/cont/ (@@/ (cont (entry-lambda (:keyword url title)
(make <bookmark-entry> :title title :url url)
(redirect/cont (cont index)))))
(table/
(tr/ (th/ "Title: ") (td/ (input/ (@/ (name "url")))))
(tr/ (th/ "URL: ") (td/ (input/ (@/ (name "title")))))
(tr/ (th/) (td/ (input/ (@/ (type "submit") (value "Submit"))))))))
(kahua:xml-template->sxml
page-template
:title (title/ "Submit URL")
:body (submit-url-form/)))
(initialize-main-proc index)