(declare (unit tick-list))

(module tick-list ()

(import scheme)
(import (chicken base)
        (chicken condition)
        (chicken errno)
        (chicken format)
        (chicken sort))
(import commands optimism simple-logger)
(import tick tick-params)

(define-command 'list
  (sprintf "\
list [<what> | [[--format|-f <listing-format>] | [--named-listing|-L <listing>]] [--sort-by <sorter>]
  List tickets, bug tracker metadata and named queries.  If <what> is not
  provided, list tickets, otherwise list the values of <what>.

  ~a

  --sort-by|-s <named-sorter>
    Use <named-sorter> instead of the default sorter, which orders tickets by
    creation time (newer ones first).  <named-sorter> are identifiers of
    sorters in the `named-sorters' parameter.

  <what>:
    * commands
    * components
    * difficulties
    * milestones
    * priorities
    * resolutions
    * statuses
    * types
    * users
    * versions
    * named-queries
    * named-sorters"
           +format-option-help+)
  (lambda (args*)
    (let* ((args (parse-command-line
                  args*
                  `(((--format -f) . format)
                    ((--named-listing -L) . ,string->symbol)
                    ((--sort-by -s) . sorter)
                    ((--) . what))))
           (format (get-opt '(--format -f) args))
           (named-listing (get-opt '(--named-listing -L) args))
           (sort-by (get-opt '(--sort-by -s) args))
           (what (let ((rest (get-opt '(--) args)))
                   (if format
                       (if (null? rest)
                           #f
                           (die! "--format|-f can only be used when listing tickets."))
                       (and (not (null? rest))
                            (string->symbol (car rest)))))))
      (when (and format named-listing)
        (die! "--format|-f and --named-listing|-L are mutually exclusive."))
      (with-output-to-pager
       (lambda ()
         (if what
             (begin
               (cond
                ((eq? what 'commands)
                 (for-each
                  (lambda (command)
                    (print (car command)))
                  (commands)))
                ((eq? what 'named-queries)
                 (for-each
                  (lambda (named-query)
                    (printf "~a: ~S\n" (car named-query) (cdr named-query)))
                  (named-queries)))
                ((eq? what 'named-sorters)
                 (for-each
                  (lambda (named-sorter)
                    (printf "~a\n" (car named-sorter)))
                  (named-sorters)))
                ((memq what valid-global-data)
                 (let ((file (db-file what)))
                   (handle-exceptions exn
                     (if (eq? (get-condition-property exn 'exn 'errno)
                              errno/noent)
                         (die! "~a does not exist." file)
                         (signal exn))
                     (for-each print (with-input-from-file file read)))))
                (else
                 (die! "Invalid <what>: ~a" what)))
               (exit))
             (let ((formatter
                    (if named-listing
                        (or (alist-ref named-listing (named-listings))
                            (die! "Invalid named listing: ~a" named-listing))
                        (begin
                          (when format
                            (customize-listing-format format))
                          (listing-format))))
                   (sorter
                    (if sort-by
                        (or (and-let* ((s (alist-ref (string->symbol sort-by)
                                                     (named-sorters))))
                              s)
                            (die! "--sort-by: No such named sorter: ~a"
                                  sort-by))
                        sort-tickets-by-creation-time)))
               (for-each formatter
                         (sorter (map (lambda (thash)
                                        (read-ticket thash metadata-only?: #t))
                                      (db-ticket-ids)))))))))))
) ;; end module