From 08e1e58f1f07229eda581ee3d82648c03ffa5691 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Mon, 25 Apr 2011 20:06:08 +0200 Subject: [PATCH] add ?with=guile&without=gnu * 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. --- tekuti/page.scm | 38 ++++++++++++++++++++++++++------------ tekuti/request.scm | 12 +++++++++++- tekuti/web.scm | 3 +-- 3 files changed, 38 insertions(+), 15 deletions(-) diff --git a/tekuti/page.scm b/tekuti/page.scm index f59cae2..dd3cc97 100644 --- a/tekuti/page.scm +++ b/tekuti/page.scm @@ -1,5 +1,5 @@ ;; Tekuti -;; Copyright (C) 2008, 2010 Andy Wingo +;; Copyright (C) 2008, 2010, 2011 Andy Wingo ;; 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)))) diff --git a/tekuti/request.scm b/tekuti/request.scm index 0eaa7d8..514864e 100644 --- a/tekuti/request.scm +++ b/tekuti/request.scm @@ -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) diff --git a/tekuti/web.scm b/tekuti/web.scm index e1519d7..d88bb2f 100644 --- a/tekuti/web.scm +++ b/tekuti/web.scm @@ -1,5 +1,5 @@ ;; Tekuti -;; Copyright (C) 2008, 2010 Andy Wingo +;; Copyright (C) 2008, 2010, 2011 Andy Wingo ;; 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)