(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 ((view-name
                      (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 (view-name)
               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 view-name)))))))
      ((_ 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 (stored-file xdg-env file)
  "Try to get FILE stored either in XDG-ENV or the home directory."
  (let ((xdg (getenv xdg-env))
        (home (getenv "HOME"))
        (result #f))
    (cond
     (xdg
      (let ((xdg-stored-file (string-append xdg "/undone/" file)))
        (when (file-exists? xdg-stored-file)
          (set! result xdg-stored-file))))
     (home
      (let ((home-stored-file (string-append home "/.undone/" file)))
        (when (file-exists? home-stored-file)
          (set! result home-stored-file)))))
    result))

(define (config-file file)
  "Try to get FILE from the configuration file location."
  (stored-file "XDG_CONFIG_HOME" file))

(define (data-file file)
  "Try to get FILE from the data file location."
  (stored-file "XDG_DATA_HOME" file))

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

(define rc-file
  (config-file "undonerc.scm"))

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

(define view-list '())

(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 (delete args)
  "Delete the specified element."
  (set! todo-list
        (filter (lambda (elm)
                  (not (eq? (get-field-value id elm)
                            (string->number (car args)))))
                todo-list)))

(define-view default
  "Default todo-list view, show only the title."
  "~2d ~a~%" id 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 (load-rc-file)
  "Load the RC file containing custom views and such."
  ;; Ugly hack, can't thinkg of a better way right now, though...
  (save-module-excursion
   (lambda ()
     (set-current-module (resolve-module '(undone main)))
     (load rc-file))))

(define (main args)
  (when (and rc-file (file-exists? rc-file))
    (load-rc-file))

  (if (> (length args) 1)
      (case (string->symbol (cadr args))
        ((add)
         (add (list-tail args 2))
         (save))
        ((delete)
         (delete (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)))))