(declare (unit tick-edit))

(module tick-edit ()

(import scheme)
(import (chicken base)
        (chicken file)
        (chicken format)
        (chicken io)
        (chicken pathname)
        (chicken port)
        (chicken sort)
        (chicken string))
(import commands optimism simple-logger srfi-1 srfi-13)
(import tick)

(define (get-user-comments thash time)
  ;; Return a list (<change-file> . <comment>)
  (let ((change-files
         (sort
          (glob (make-pathname
                 (ticket-changes-dir thash)
                 ;; Users can only edit their own comments
                 (string-append time "*" (get-username) ".wiki")))
          string<)))
    (filter-map
     (lambda (change-file)
       (receive (summary comment)
           (with-input-from-file change-file
             (lambda ()
               (let ((summary (read-line))
                     (comment
                      (let loop ()
                        (let ((text (read-line)))
                          (cond ((eof-object? text)
                                 "")
                                ((string=? "" (string-trim-both text))
                                 (loop))
                                (else text))))))
                 (values summary comment))))
         (and (string-suffix? "wrote:" summary)
              (cons change-file
                    ;; Drop heading markup ("=== <summary>")
                    (sprintf "~a ~a"
                             (substring summary 4)
                             (if (> (string-length comment) 62)
                                 (string-append (substring comment 0 62) " ...")
                                 comment))))))
     change-files)))

(define (edit-comment thash comment-file)
  (let* ((tmp-comment-file (create-temporary-file))
         (heading #f) ;; will be set when reading the comment file
         (cur-comment-text
          ;; Drop the heading line and get only the comment body
          (with-output-to-string
            (lambda ()
              (with-input-from-file comment-file
                (lambda ()
                  (set! heading (read-line)) ;; Drop heading
                  (let loop ()
                    (let ((line (read-line)))
                      (unless (eof-object? line)
                        (print line)
                        (loop))))))))))
    (set! cur-comment-text (string-trim-both cur-comment-text))
    (with-output-to-file tmp-comment-file
      (cut display (string-trim-both cur-comment-text)))
    (let ((new-comment-text
           (prompt-editor 'comment file: tmp-comment-file)))
      (delete-file tmp-comment-file)
      (cond ((equal? cur-comment-text new-comment-text)
             (print "Comment has not been modified.")
             (exit))
            ((or (eof-object? new-comment-text)
                 (string=? "" (string-trim-both new-comment-text)))
             (die! "Comment cannot be empty."))
            (else
             (with-output-to-file comment-file
               (lambda ()
                 (print heading)
                 (print new-comment-text)))
             (let ((orig-comment-date
                    (get-date/time-from-comment-heading heading)))
               (write-ticket-change
                thash
                (sprintf "modified the comment made on ~a"
                         orig-comment-date))
               (db-add-change thash
                              (sprintf "Change comment made on ~a"
                                       orig-comment-date))
               ))))))

(define-command 'edit #<#EOF
edit <options>
  Edit body (description) and comments of tickets.

  <options>:
    --body
      Edit ticket body.

    --comment|-c [<time>|*]
      Edit comment made at <time> (YYYY-MM-DD_hh-mm-ss).  <time> might be
      partially provided (e.g., YYYY-MM-DD).  You can also specify * for
      all comments (you probably need to quote it in the shell to prevent
      it from being expanded).  In case of multiple matches, the command
      will prompt for a comment to edit and the selected one will be opened
      in the configured text editor.
EOF
  ;; --this-is-here-just-to-fool-emacs-syntax-highlight|
  (lambda (args*)
    (let* ((args (parse-command-line
                  args*
                  `(((--body -b))
                    ((--comment -c) . comment-time))))
           (body (get-opt '(--body -b) args))
           (comment-time (get-opt '(--comment -c) args))
           (thash (let ((rest (get-opt '(--) args)))
                    (if (or (null? rest) (not (null? (cdr rest))))
                        (show-command-help 'edit 1)
                        (ensure-ticket (car rest)))))
           (ticket (read-ticket thash)))

      (set-last-used-ticket-hash! thash)

      (when (and comment-time body)
        (die! "--comment and --body are mutually exclusive."))

      (when body
        (let ((new-body (prompt-editor 'body file: (ticket-file thash))))
          (cond ((or (eof-object? new-body)
                     (string=? "" (string-trim-both new-body)))
                 (die! "Ticket body cannot be empty."))
              (else
               (ticket-body-set! ticket new-body)
               (write-ticket-change thash "modified the description")
               (db-add-change thash "Change ticket description")))))

      (when comment-time
        (let ((options (get-user-comments thash comment-time)))
          (if (null? options)
              (die! "No comment from ~a to edit." (get-username))
              (if (null? (cdr options))
                  (edit-comment thash (caar options))
                  (let ((num-options (length options)))
                    (let loop ()
                      (for-each (lambda (idx option)
                                  (printf "[~a] ~a\n" idx (cdr option)))
                                (iota num-options)
                                options)
                      (display "Select index of the option to edit (C-c to abort): ")
                      (flush-output)
                      (let ((answer (read)))
                        (cond ((or (not (number? answer))
                                   (< answer 0)
                                   (eof-object? answer)
                                   (>= answer num-options))
                               (printf "Invalid selection: ~a\n" answer)
                               (loop))
                              (else
                               (edit-comment
                                thash
                                (car (list-ref options answer))))))))))))
      )))
) ;; end module