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

(define-syntax get-field
  (lambda (x)
    (syntax-case x ()
      ((_ key alist)
       #'(assq (quote key) alist)))))

(define-syntax get-field-value
  (lambda (x)
    (syntax-case x ()
      ((_ key alist default)
       #'(let ((field (get-field key alist)))
           (if field
               (cdr field)
               default)))
      ((_ key alist)
       #'(get-field-value key alist #f)))))

(define-syntax define-view
  (lambda (x)
    (syntax-case x (where sort-by)
      ((_ name doc fmt fields fields* ...
          where predicate
          sort-by sort-predicate sort-field)
       (with-syntax ((viewname
                      (datum->syntax
                       x (symbol-append (syntax->datum #'name) '-view)))
                     (filtered-list
                      #`(filter (lambda (elm)
                                  (and #,@(map
                                           (lambda (field)
                                             #`(get-field #,field elm))
                                           #'(fields fields* ...))))
                                todo-list)))
         #`(begin
             (define (viewname)
               doc
               (for-each
                (lambda (item)
                  (let (#,@(map
                            (lambda (field)
                              #`(#,field (get-field-value #,field item)))
                            #'(fields fields* ...)))
                    (if predicate
                        (format #t fmt
                                #,@(map (lambda (field)
                                          field)
                                        #'(fields fields* ...))))))
                #,(if (syntax->datum #'sort-predicate)
                      #`(stable-sort
                         filtered-list
                         (lambda (a b)
                           (sort-predicate
                            (get-field-value sort-field a)
                            (get-field-value sort-field b))))
                      #'filtered-list)))
             (set! view-list
                   (append view-list
                           (list (cons 'name viewname)))))))
      ((_ name doc fmt fields fields* ...
          sort-by sort-predicate sort-field)
       #'(define-view name doc fmt fields fields* ...
           where #t
           sort-by sort-predicate sort-field))
      ((_ name doc fmt fields fields* ...
          where predicate)
       #'(define-view name doc fmt fields fields* ...
           where predicate
           sort-by #f nil))
      ((_ name doc fmt fields fields* ...)
       #'(define-view name doc fmt fields fields* ...
           where #t
           sort-by #f nil)))))

(define todo-list-file
  (let* ((xdg (getenv "XDG_DATA_HOME"))
         (home (getenv "HOME"))
         (todo-file-name "todo.scm")
         (xdg-todo-file (string-append xdg "/undone/" todo-file-name))
         (home-todo-file (string-append xdg "/.undone/" todo-file-name)))
    (if (and xdg (not (file-exists? home-todo-file)))
        xdg-todo-file
        home-todo-file)))

(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 (mkdirs path)
  (let ((parent (dirname path)))
    (if (not (file-exists? parent))
        (mkdirs parent)))

  (if (not (file-exists? path))
      (mkdir path)))

(define (save)

  "Save the list."
  (mkdirs (dirname todo-list-file))

  (let ((port (open-output-file todo-list-file)))
    (write todo-list port)
    (close-port port)))

(define (next-id)
  "Look through all known todo items and get the next id."
  (1+ (apply max (map (lambda (elm)
                        (get-field-value id elm 0))
                      todo-list))))

(define (add args)
  "Add item to the list."
  (set! todo-list
        (append todo-list
                (list
                 (append
                  `((id . ,(next-id))
                    (content . ,(string-trim-right (read-delimited ""))))
                  (map (lambda (arg)
                         (let* ((pair (string-split arg #\=))
                                (var (string->symbol (car pair)))
                                (val (cadr pair)))
                           (if (char=? (string-ref val 0) #\,)
                               (set! val (string-split
                                          (substring val 1) #\,)))

                           (cons var val)))
                       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)
  ;; Ugly hack, can't think of a better way right now...
  (save-module-excursion
   (lambda ()
     (set-current-module (resolve-module '(undone main)))
     (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)))))