post: Add posts/group-by-tag.
* haunt/post.scm (group-by-tag): New procedure.
This commit is contained in:
		@@ -23,6 +23,7 @@
 | 
				
			|||||||
;;; Code:
 | 
					;;; Code:
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-module (haunt post)
 | 
					(define-module (haunt post)
 | 
				
			||||||
 | 
					  #:use-module (srfi srfi-1)
 | 
				
			||||||
  #:use-module (srfi srfi-9)
 | 
					  #:use-module (srfi srfi-9)
 | 
				
			||||||
  #:use-module (srfi srfi-19)
 | 
					  #:use-module (srfi srfi-19)
 | 
				
			||||||
  #:use-module (haunt utils)
 | 
					  #:use-module (haunt utils)
 | 
				
			||||||
@@ -34,6 +35,7 @@
 | 
				
			|||||||
            post-ref
 | 
					            post-ref
 | 
				
			||||||
            post-slug
 | 
					            post-slug
 | 
				
			||||||
            posts/reverse-chronological
 | 
					            posts/reverse-chronological
 | 
				
			||||||
 | 
					            posts/group-by-tag
 | 
				
			||||||
 | 
					
 | 
				
			||||||
            register-metdata-parser!
 | 
					            register-metdata-parser!
 | 
				
			||||||
            parse-metadata))
 | 
					            parse-metadata))
 | 
				
			||||||
@@ -66,6 +68,19 @@
 | 
				
			|||||||
        (lambda (a b)
 | 
					        (lambda (a b)
 | 
				
			||||||
          (time>? (post->time a) (post->time b)))))
 | 
					          (time>? (post->time a) (post->time b)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define (posts/group-by-tag posts)
 | 
				
			||||||
 | 
					  "Return an alist of tags mapped to the posts that used them."
 | 
				
			||||||
 | 
					  (let ((table (make-hash-table)))
 | 
				
			||||||
 | 
					    (for-each (lambda (post)
 | 
				
			||||||
 | 
					                (for-each (lambda (tag)
 | 
				
			||||||
 | 
					                            (let ((current (hash-ref table tag)))
 | 
				
			||||||
 | 
					                              (if current
 | 
				
			||||||
 | 
					                                  (hash-set! table tag (cons post current))
 | 
				
			||||||
 | 
					                                  (hash-set! table tag (list post)))))
 | 
				
			||||||
 | 
					                          (or (post-ref post 'tags) '())))
 | 
				
			||||||
 | 
					              posts)
 | 
				
			||||||
 | 
					    (hash-fold alist-cons '() table)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
;;;
 | 
					;;;
 | 
				
			||||||
;;; Metadata
 | 
					;;; Metadata
 | 
				
			||||||
;;;
 | 
					;;;
 | 
				
			||||||
 
 | 
				
			|||||||
		Reference in New Issue
	
	Block a user