aliens/tekuti
1
0
Fork 0
Code Activity

add ?with=guile&without=gnu

Browse source 
* tekuti/page.scm (page-feed-atom): Reimplement Brian's thing with
  "with" and "without" query args, to allow for multiple tags to be
  included or excluded.

* tekuti/request.scm (request-query-ref-all): New helper.
This commit is contained in:
Andy Wingo 2011-04-25 20:06:08 +02:00
parent 26216a593a
commit 08e1e58f1f
3 changed files with 38 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
tekuti/page.scm
View file

@ -1,5 +1,5 @@
;; Tekuti
;; Copyright (C) 2008, 2010 Andy Wingo <wingo at pobox dot com>
;; Copyright (C) 2008, 2010, 2011 Andy Wingo <wingo at pobox dot com>
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@ -34,6 +34,7 @@
#:use-module (web request)
#:use-module (tekuti request)
#:use-module (tekuti page-helpers)
#:use-module ((srfi srfi-1) #:select (fold))
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-19)
#:export (page-admin
@ -55,7 +56,6 @@
page-debug
page-search
page-feed-atom
page-feed-atom-tag
page-debug
page-not-found))
@ -337,14 +337,28 @@
(atom-entry post))
posts)))))))
(define (page-feed-atom request body index)
(atom-feed-from-posts request body index (published-posts index 10)))
(define (page-feed-atom-tag request body index tag)
(let* ((tags (assq-ref index 'tags))
(posts (filter-mapn (lambda (key)
(post-from-key (assq-ref index 'master) key))
(hash-ref tags tag '())
10)))
(atom-feed-from-posts request body index posts)))
(let ((with (request-query-ref-all request "with"))
(without (request-query-ref-all request "without"))
(tags (assq-ref index 'tags))
(posts (assq-ref index 'posts))
(master (assq-ref index 'master)))
(atom-feed-from-posts
request body index
(filter-mapn (fold (lambda (tag cont)
(let ((posts (hash-ref tags tag '())))
(lambda (post)
(and (not (member (post-key post) posts))
(cont post)))))
(fold (lambda (tag cont)
(let ((posts (hash-ref tags tag '())))
(lambda (post)
(and (member (post-key post) posts)
(cont post)))))
(lambda (post)
(and (post-published? post)
post))
with)
without)
posts
10))))

12
tekuti/request.scm
View file

@ -25,7 +25,7 @@
;;; Code:
(define-module (tekuti request)
#:use-module ((srfi srfi-1) #:select (find-tail))
#:use-module ((srfi srfi-1) #:select (find-tail filter-map))
#:use-module (tekuti match-bind)
#:use-module (tekuti util)
#:use-module (web uri)
@ -38,6 +38,7 @@
#:export (request-relative-path
request-relative-path-str
request-query-ref
request-query-ref-all
request-path-case
request-authenticated?
request-form-data))
@ -68,6 +69,15 @@
((and q (assoc param (parse-www-form-urlencoded q))) => cdr)
(else default))))
(define (request-query-ref-all r param)
(let ((q (uri-query (request-uri r))))
(if q
(filter-map (lambda (pair)
(and (equal? (car pair) param)
(cdr pair)))
(parse-www-form-urlencoded q))
'())))
(define (decode-string bv charset)
(if (string-ci=? charset "utf-8")
(utf8->string bv)

3
tekuti/web.scm
View file

@ -1,5 +1,5 @@
;; Tekuti
;; Copyright (C) 2008, 2010 Andy Wingo <wingo at pobox dot com>
;; Copyright (C) 2008, 2010, 2011 Andy Wingo <wingo at pobox dot com>
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@ -54,7 +54,6 @@
((POST archives year! month! day! post!) page-new-comment)
((GET feed) page-feed-atom)
((GET feed atom) page-feed-atom)
((GET feed atom tag!) page-feed-atom-tag)
((POST search) page-search)
((GET tags) page-show-tags)
((GET tags tag!) page-show-tag)