(module result-parse mzscheme
(require (lib "contract.ss")
(lib "plt-match.ss")
(lib "string.ss")
(lib "time.ss" "srfi" "19"))
(require (planet "xml.ss" ("jim" "webit.plt" 1 5)))
(require (file "base.ss")
(file "result-struct.ss"))
(define (raise-parse-exn fragment)
(raise-exn exn:fail:delicious:parse
"Failed to parse XML fragment."
fragment))
(define (parse-result-element elem)
(xml-match elem
[(result code: ,message)
(if (equal? message "done")
(void)
(raise-exn exn:fail
(format "del.icio.us returned an error: ~s" message)))]
[,any (raise-parse-exn elem)]))
(define (parse-update-element elem)
(xml-match elem
[(update time: ,time)
(parse-long-date time)]
[,any (raise-parse-exn elem)]))
(define (parse-tags-element elem)
(xml-match elem
[(tags ,tags ...)
(map parse-tag-element tags)]
[,any (raise-parse-exn elem)]))
(define (parse-tag-element elem)
(xml-match elem
[(tag tag: ,tag
count: ,count)
(cons tag (parse-number count))]
[,any (raise-parse-exn elem)]))
(define (parse-posts-element elem)
(xml-match elem
[(posts user: [,user #f]
tag: [,tag #f]
dt: [,date #f]
update: [,update #f]
,posts ...)
(map parse-post-element posts)]
[,any (raise-parse-exn elem)]))
(define (parse-post-element elem)
(xml-match elem
[(post href: [,url #f]
description: [,description #f]
extended: [,extended #f]
tag: [,tag #f]
time: [,date #f]
others: [,others #f]
hash: [,hash #f]
,rest ...)
(printf "~a ~a ~a ~a ~a~n"
url
description
extended
(parse-list-of-strings tag)
(parse-long-date date))
(make-post url
description
extended
(parse-list-of-strings tag)
(parse-long-date date))]
[,any (error "Post not matched" elem)]))
(define (parse-dates-element elem)
(xml-match elem
[(dates user: [,user #f]
tag: [,tag #f]
,dates ...)
(map parse-date-element dates)]
[,any (raise-parse-exn elem)]))
(define (parse-date-element elem)
(xml-match elem
[(date date: ,date
count: ,count)
(cons (parse-short-date date)
(parse-number count))]
[,any (raise-parse-exn elem)]))
(define (parse-bundles-element elem)
(xml-match elem
[(bundles ,bundles ...)
(map parse-bundle-element bundles)]
[,any (raise-parse-exn elem)]))
(define (parse-bundle-element elem)
(xml-match elem
[(bundle name: ,name
tags: ,tags)
(list name (parse-list-of-strings tags))]
[,any (raise-parse-exn elem)]))
(define (parse-long-date str)
(string->date str long-date-format))
(define (parse-short-date str)
(string->date str short-date-format))
(define parse-number string->number)
(define (parse-list-of-strings str)
(regexp-split #rx" " str))
(define (parse-boolean str)
(if (equal? str "yes")
#t
#f))
(define sxml/c pair?)
(provide/contract
[parse-result-element (-> sxml/c void?)]
[parse-update-element (-> sxml/c srfi:date?)]
[parse-tags-element (-> sxml/c (listof (cons/c string? integer?)))]
[parse-posts-element (-> sxml/c (listof post?))]
[parse-dates-element (-> sxml/c (listof (cons/c srfi:date? integer?)))]
[parse-bundles-element (-> sxml/c (listof bundle?))])
)