(use abnf abnf-charlist (srfi 1 14))


(define priority (bind (lambda (c) `((prio ,@(string->symbol (list->string c)))))
                       (:: (:! (:s "("))
                           (set (char-set->list char-set:upper-case))
                           (:! (:s ") ")))))
(define date  (:: (repetition-n 4 (set (char-set->list char-set:digit)))
                  (:c #\-) (repetition-n 2 (set (char-set->list char-set:digit)))
                  (:c #\-) (repetition-n 2 (set (char-set->list char-set:digit)))))

(define date-added (bind (lambda (c) `((added ,(list->string (reverse c)))))
                         date))
(define date-completed (bind (lambda (c) `((completed-at ,(list->string (reverse c)))))
                         date))
(define context (bind (lambda (c) `((context ,(list->string (reverse c)))))
                      (:: (:! (:c #\@)) (:+ (set (char-set->list char-set:graphic))))))
(define project (bind (lambda (p) `((project ,(list->string (reverse p)))))
                      (:: (:! (:c #\+)) (:+ (set (char-set->list char-set:graphic))))))
(define word (bind (lambda (w) (list (list->string (reverse w))))
                   (:: (:+ (set (char-set->list char-set:graphic))))))

(define done (bind (lambda (c) `((done ,@c))) (:: (:! (:s "x ")) (:? date-completed))))

(define todo-line (bind reverse
                        (:: (:? done)
                            (:? priority)
                            (:? date)
                            (:! (:* wsp))
                            (:+ (:: (alternatives context project word)
                                    (:! (:* (alternatives cr lf crlf wsp))))))))
(define (unify-descriptions todo)
  (let loop ((t todo)
             (r '())
             (desc '()))
    (if (null? t)
        (cons `(todo ,(string-intersperse (reverse desc) " ")) r)
        (if (pair? (car t))
            (loop (cdr t) (cons (car t) r) desc)
            (loop (cdr t) r (cons (car t) desc))))))

(define (parser line)
  (todo-line (lambda (l) (unless (null? l)
                                 (pp (unify-descriptions (car l))))) error `(() ,(string->list line))))

replace date with date-added in the todo line

(use abnf abnf-charlist (srfi 1 14))


(define priority (bind (lambda (c) `((prio ,@(string->symbol (list->string c)))))
                       (:: (:! (:s "("))
                           (set (char-set->list char-set:upper-case))
                           (:! (:s ") ")))))

(define date (:: (repetition-n 4 (set (char-set->list char-set:digit)))
                 (:c #\-) (repetition-n 2 (set (char-set->list char-set:digit)))
                 (:c #\-) (repetition-n 2 (set (char-set->list char-set:digit)))))

(define date-added (bind (lambda (c) `((added ,(list->string (reverse c)))))
                         date))

(define date-completed (bind (lambda (c) `((completed-at ,(list->string (reverse c)))))
                         date))

(define context (bind (lambda (c) `((context ,(list->string (reverse c)))))
                      (:: (:! (:c #\@)) (:+ (set (char-set->list char-set:graphic))))))

(define project (bind (lambda (p) `((project ,(list->string (reverse p)))))
                      (:: (:! (:c #\+)) (:+ (set (char-set->list char-set:graphic))))))

(define word (bind (lambda (w) (list (list->string (reverse w))))
                   (:: (:+ (set (char-set->list char-set:graphic))))))

(define done (bind (lambda (c) `((done ,@c))) (:: (:! (:s "x ")) (:? date-completed) (:! wsp))))

(define todo-line (bind reverse
                        (:: (:? done)
                            (:? priority)
                            (:? date-added)
                            (:! (:* wsp))
                            (:+ (:: (alternatives context project word)
                                    (:! (:* (alternatives cr lf crlf wsp))))))))
(define (unify-descriptions todo)
  (let loop ((t todo)
             (r '())
             (desc '()))
    (if (null? t)
        (cons `(todo ,(string-intersperse (reverse desc) " ")) r)
        (if (pair? (car t))
            (loop (cdr t) (cons (car t) r) desc)
            (loop (cdr t) r (cons (car t) desc))))))

(define (parser line)
  (todo-line (lambda (l) (unless (null? l)
                                 (pp (unify-descriptions (car l))))) error `(() ,(string->list line))))