This code is part of a blog program.
It's purpose is to reformat a list from a sequential list sorted by date
to a list on the form:
Result format: ((year (month (date title url) ...) ...) ...)
(defun make-navigate-list (item-list name)
(let (last-year last-month year-list month-list result-list)
(iter (for item in (reverse item-list))
(let* ((date-string (getf item :pub_time))
(year (extract-year date-string))
(month (extract-month date-string)))
(when (or (not last-year)
(< year last-year))
(setf last-year year)
(setf last-month nil)
(when month-list (push (reverse month-list) year-list))
(setf month-list nil)
(when year-list (push (reverse year-list) result-list))
(setf year-list (list (format nil "~D" year))))
(when (or (not last-month)
(< month last-month))
(setf last-month month)
(when month-list (push (reverse month-list) year-list))
(setf month-list (list (get-month-string month))))
(push
(list
(subseq (getf item :pub_time) 0 10)
(or (getf item :title) "")
(format nil "~A?id=~D" name (getf item :id)))
month-list)))
(when month-list (push (reverse month-list) year-list))
(when year-list (push (reverse year-list) result-list))
(reverse result-list)))
It works, but it is ugly. Any idea of how to improve it?
In article <·················@pandora.upc.no>,
"John Thingstad" <··············@chello.no> wrote:
> This code is part of a blog program.
> It's purpose is to reformat a list from a sequential list sorted by date
> to a list on the form:
> Result format: ((year (month (date title url) ...) ...) ...)
>
> (defun make-navigate-list (item-list name)
> (let (last-year last-month year-list month-list result-list)
> (iter (for item in (reverse item-list))
> (let* ((date-string (getf item :pub_time))
> (year (extract-year date-string))
> (month (extract-month date-string)))
>
> (when (or (not last-year)
> (< year last-year))
> (setf last-year year)
> (setf last-month nil)
> (when month-list (push (reverse month-list) year-list))
> (setf month-list nil)
> (when year-list (push (reverse year-list) result-list))
> (setf year-list (list (format nil "~D" year))))
>
> (when (or (not last-month)
> (< month last-month))
> (setf last-month month)
> (when month-list (push (reverse month-list) year-list))
> (setf month-list (list (get-month-string month))))
>
> (push
> (list
> (subseq (getf item :pub_time) 0 10)
> (or (getf item :title) "")
> (format nil "~A?id=~D" name (getf item :id)))
> month-list)))
> (when month-list (push (reverse month-list) year-list))
> (when year-list (push (reverse year-list) result-list))
>
> (reverse result-list)))
>
> It works, but it is ugly. Any idea of how to improve it?
You could move away from ad-hoc data structures to
slightly less ad-hoc data-structures.
Use defstruct, possibly with the type list, to define
constructors, accessors, ...
If you write it that way, suddenly the code looks different.
--
http://lispm.dyndns.org
P� Thu, 26 Jul 2007 19:32:54 +0200, skrev Rainer Joswig <······@lisp.de>:
>
> You could move away from ad-hoc data structures to
> slightly less ad-hoc data-structures.
>
> Use defstruct, possibly with the type list, to define
> constructors, accessors, ...
>
> If you write it that way, suddenly the code looks different.
>
I can understand why you think that given my information.
I realize I need to say a bit more.
This is the routine I use to map from CLSQL AV-LIST
(defun to-plist (column titles)
(mapcan (lambda (item title)
(list (intern (string-upcase title) "KEYWORD")
item))
column titles))
So basically I take a data table from the from:
(select [*] :from [blog_header] :where [= [name] "john"])
((7 "john" "John's blog" "My personal blog" "John Thingstad"))
("id" "name" "title" "description" "author")
(multiple-value-bind (column titles) (to-plist column titles)...)
((:id 7) (:name "john") ...)
...)
So you see it depends on the statement. There is no general structure.
And creating one for this would just clutter things up.
"John Thingstad" <··············@chello.no> writes:
> [...]
> (select [*] :from [blog_header] :where [= [name] "john"])
> ((7 "john" "John's blog" "My personal blog" "John Thingstad"))
> ("id" "name" "title" "description" "author")
> [...]
> So you see it depends on the statement. There is no general structure.
> And creating one for this would just clutter things up.
(defstruct (blog-entry (:type list)) id name title description author)
Ok, this assumes a given order. You can ensure the order is correct with:
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *blog-entry-columns*
'(id name title description author)))
(defstruct (blog-entry (:type list))
. #.*blog-entry-columns*)
(defun compile-order (src dst)
"Takes two lists containing the same elements in a different order,
and returns the corresponding permutation vector.
eg. (compile-order '(one two three four) '(four one two three))
--> #(3 0 1 2)
so we can use it to reorder fields as:
(loop with order = (compile-order src-order target-order)
for i from 0 below (length fields)
collect (elt (aref order i) fields))
"
;; Implementation left as an exercise for the reader.
;; It's funny to implement, but I don't have my sources at
;; hand to copy and paste it and I'm too lazy to re-do it now.
)
So you can write:
(defun rows-to-structures (rows column-titles)
(let ((order (compile-order column-titles *blog-entry-columns*)))
(mapcar (lambda (row)
(loop for i from 0 below (length row)
collect (elt (aref order i) row)))
rows)))
to convert from select output to the above blog-entry "structures".
It may be worthwhile to cache the result of compile-order since it
probably won't change, and one could test for the trivial identity
permutation...
--
__Pascal Bourguignon__ http://www.informatimago.com/
"Debugging? Klingons do not debug! Our software does not coddle the
weak."