fixedpoint.jp

#!/usr/bin/env gosh
;; -*- conding: utf-8 -*-

(use gauche.charconv)
(use srfi-1)
(use sxml.ssax)
(use sxml.sxpath)

(define *rtm-output-encoding* "EUC-JP")
(define *rtm-namespace*
  '((atom  . "http://www.w3.org/2005/Atom")
    (xhtml . "http://www.w3.org/1999/xhtml")))

(define (entry->title entry)
  (and-let* ((t (assq 'atom:title (cdr entry))))
    (third t)))
(define entry->items (compose cdr third (lambda (entry) (assq 'atom:content (cdr entry)))))
(define (entry->due entry)
  (and-let* ((item (find (lambda (item) (string=? "rtm_due" (item->class item))) (entry->items entry))))
    (rxmatch-if (#/(\d+)[年\/-](\d+)[月\/-](\d+)[日\/-]/ (item->value item))
        (#f y m d)
      (apply format #f "~4,'0d-~2,'0d-~2,'0d" (map x->integer (list y m d)))
      #f)))
(define (find-tags items)
  (call/cc
   (lambda (cont)
     (for-each
      (lambda (item)
        (and-let* ((class (item->class item))
                   ((string=? "rtm_tags" class))
                   (v (item->value item)))
          (if (string=? v "なし")
              (cont #f)
              (cont (string-split v ", ")))))
      items)
     #f)))
(define entry->tags (compose find-tags entry->items))
(define item->class (compose second second second))
(define item->title (compose third third))
(define item->value (compose third fourth))

(define (entry->memo entry oport)
  (define (f str . params)
    (apply format oport (string-append str "\n") params))
  (let* ((title (entry->title entry))
         (due (entry->due entry))
         (tags (entry->tags entry))
         (cloud (if tags (format #f "[~a] " (string-join tags ",")) "")))
    (if due
        (f "[~a]@ ~a~a" due cloud title)
        (f "= ~a~a" cloud title))
    ))

(define (xml->howm iport oport)
  (let* ((proc (sxpath '(// atom:entry)))
         (tree (ssax:xml->sxml iport *rtm-namespace*))
         (entries (proc tree)))
    (for-each (cut entry->memo <> oport) entries)
    ))

(define (main args)
  (call-with-input-conversion (current-input-port)
    (lambda (iport)
      (call-with-output-conversion (current-output-port)
        (lambda (oport)
          (xml->howm iport oport))
        :encoding *rtm-output-encoding*))
    :encoding "*JP")
  0)