undone/undone/main.scm

(define-module (undone main)
  #:use-module (ice-9 format)
  #:use-module (ice-9 rdelim)
  #:export (main))

(define-syntax define-view
  (lambda (x)
    (syntax-case x (where)
      ((_ name doc fmt fields fields* ... where predicate)
       (with-syntax ((viewname
                      (datum->syntax
                       x (symbol-append (syntax->datum #'name) '-view))))
         #`(begin
             (define (viewname)
               doc
               (map (lambda (item)
                      (let (#,@(map (lambda (field)
                                      #`(#,field (cdr (assq (quote #,field) item))))
                                    #'(fields fields* ...)))
                        (if predicate
                            (format #t fmt
                                    #,@(map (lambda (field)
                                              field)
                                            #'(fields fields* ...))))))
                    todo-list))
             (set! view-list
                   (append view-list
                           (list (cons 'name viewname)))))))
      ((_ name doc fmt fields fields* ...)
       (with-syntax ((viewname
                      (datum->syntax
                       x (symbol-append (syntax->datum #'name) '-view))))
         #'(define-view name doc fmt fields fields* ... where #t))))))

(define todo-list-file "todo.scm")

(define rc-file
  (let* ((xdg (getenv "XDG_CONFIG_HOME"))
         (home (getenv "HOME"))
         (rc-file-name "undonerc.scm")
         (xdg-rc-file (string-append xdg "/undone/" rc-file-name))
         (home-rc-file (string-append home "/.undone/" rc-file-name)))
    (if (and xdg (file-exists? xdg-rc-file))
        xdg-rc-file
        home-rc-file)))

(define todo-list
  (if (file-exists? todo-list-file)
      (let* ((port (open-input-file todo-list-file))
             (result (read port)))
        (close-port port)
        result)
      '()))

(define view-list '())

(define (data-dir)
  "Get the location for data files."
  (let ((xdg (getenv "XDG_DATA_HOME")))
    (string-append (if xdg
                       (string-append xdg "/")
                       (string-append (getenv "HOME") "/."))
                   "undone")))

(define (config-dir)
  "Get the location for configuration files."
  (let ((xdg (getenv "XDG_CONFIG_HOME")))
    (string-append (if xdg
                       (string-append xdg "/")
                       (string-append (getenv "HOME") "/."))
                   "undone")))

(define (save)
  "Save the list."
  (let ((port (open-output-file todo-list-file)))
    (write todo-list port)
    (close-port port)))

(define (add args)
  "Add item to the list."
  (set! todo-list
        (append todo-list
                (list
                 (append
                  `((content . ,(read-delimited "")))
                  (map (lambda (arg)
                         (let ((pair (string-split arg #\=)))
                           (cons (string->symbol (car pair))
                                 (cadr pair))))
                       args))))))

(define-view default
  "Default todo-list view, show only the title."
  "~a" content)

(define (view args)
  "Show a list of todo items."
  (let* ((view-name (or (and (pair? args) (car args))
                        "default"))
         (view-symbol (string->symbol view-name))
         (view-cons (assq view-symbol view-list))
         (view-func (if view-cons (cdr view-cons) '())))
    (if (procedure? view-func)
        (apply view-func '()))))

(define (main args)
  (load rc-file)
  (if (> (length args) 1)
      (case (string->symbol (cadr args))
        ((add)
         (add (list-tail args 2))
         (save))
        ((view)
         (view (list-tail args 2)))
        ((views)
         (display "Defined views:")
         (newline)
         (map (lambda (view)
                (format #t "~a~20t~a~%"
                        (car view) (procedure-documentation (cdr view))))
              view-list)))))

(main (program-arguments))