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.

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 <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))))
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 <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)