(declare (unit tick-create)) (module tick-create () (import scheme) (import (chicken base) (chicken io) (chicken string)) (import commands optimism simple-logger srfi-1 srfi-13) (import tick) (define (valid-statuses-for-create) (remove (lambda (st) (or (string=? st "reopened") (string=? st "closed"))) (valid-statuses))) (define-command 'create #<#EOF create [ Create a new ticket. If the required parameters are not provided on the command line, the program will interactively request them. : --summary|-S Ticket summary. --type|-t Valid types: #{(string-intersperse (valid-types) ", ")} : --interactive|-i Interactively prompt for all properties not explicitly specified on the command line, except reporter which is assumed to be the user creating the ticket and attachments. --body|-b Ticket body. This parameter and --body-from-file are mutually exclusive. If its value is `-', the body will be read from stdin. --body-from-file|-f Use ticket body from file . --component|-c Valid components: #{(string-intersperse (valid-components) ", ")} --difficulty|-d Valid difficulty: #{(string-intersperse (valid-difficulties) ", ")} --priority|-p Valid priorities: #{(string-intersperse (valid-priorities) ", ")} --owner|-o Check the output of "tick list users" for the list of owners. --version|-v Check the output of "tick list versions" for the list of versions. --milestone|-m Check the output of "tick list milestones" for the list of versions. --status|-s Valid statuses: #{(string-intersperse (valid-statuses-for-create) ", ")} --keywords|-k Arbitrary keywords for the ticket. --cc|-C Users/emails to add as Cc for the ticket. --attachment|-a Attach files to tickets. Can be provided multiple times. EOF ;; --this-is-here-just-to-fool-emacs-syntax-highlight| (lambda (args*) (let* ((args (parse-command-line args* `(((--interactive |-i|)) ((--summary -S) . summary) ((--type -t) . ,(validate-arg '--type valid-types)) ((--body -b) . body) ((--body-from-file -f) . file) ((--component -c) . ,(validate-arg '--component valid-components)) ((--difficulty -d) . ,(validate-arg '--difficulty valid-difficulties)) ((--priority -p) . ,(validate-arg '--priority valid-priorities)) ((--owner -o) . ,(validate-arg '--owner valid-users)) ((--version -v) . ,(validate-arg '--version valid-versions)) ((--milestone -m) . ,(validate-arg '--milestone valid-milestones)) ((--status -s) . ,(validate-arg '--status valid-statuses-for-create)) ((--cc -C) . cc) ((--keywords -k) . keywords) ((--attachment -a) . attachment)))) (interactive? (get-opt '(--interactive |-i|) args flag?: #t)) (summary (get-opt '(--summary -S) args)) (type (get-opt '(--type -t) args)) (body (get-opt '(--body -b) args)) (body-from-file (get-opt '(--body-from-file -f) args)) (component (get-opt '(--component -c) args)) (difficulty (get-opt '(--difficulty -d) args)) (priority (get-opt '(--priority -p) args)) (owner (get-opt '(--owner -o) args)) (version (get-opt '(--version -v) args)) (milestone (get-opt '(--milestone -m) args)) (status (or (get-opt '(--status -s) args) "new")) (cc (get-opt '(--cc -C) args)) (keywords (get-opt '(--keywords -k) args)) (attachments (get-opt '(--attachment -a) args multiple?: #t))) (when (and body body-from-file) (die! "--body and --body-from-file are mutually exclusive.")) (enforce-workflow (lambda () (ensure-create-workflow status owner))) (unless type (set! type (prompt "Ticket type" options: (valid-types)))) (unless (member type (valid-types)) (die! "Ticket type is missing or invalid. Valid types are: ~a." (string-intersperse (valid-types) ", "))) (when (or (not summary) (eof-object? summary)) (set! summary (prompt "Ticket summary"))) ;; Shortcut: when a ticket is created as accepted, automatically ;; set the owner to the user creating it. (when (and (equal? status "accepted") (not owner)) (set! owner (get-username))) (if body-from-file (set! body (string-trim-right (read-all body-from-file))) (set! body (string-trim-right (if body (if (string=? body "-") (read-string) body) (prompt-editor 'body))))) (when (and interactive? (not component)) (set! component (prompt "Component" options: (valid-components) allow-empty?: #t))) (when (and interactive? (not difficulty)) (set! difficulty (prompt "Estimated difficulty" options: (valid-difficulties) allow-empty?: #t))) (when (and interactive? (not priority)) (set! priority (prompt "Priority" options: (valid-priorities) allow-empty?: #t))) (when (and interactive? (not owner)) (set! owner (prompt "Owner" allow-empty?: #t))) (when (and interactive? (not version)) (set! version (prompt "Version" allow-empty?: #t))) (when (and interactive? (not milestone)) (set! milestone (prompt "Milestone" allow-empty?: #t))) (when (and interactive? (not status)) (set! status (prompt "Status" options: (valid-statuses-for-create) allow-empty?: #t))) (when (and interactive? (not keywords)) (set! keywords (prompt "Keywords" allow-empty?: #t))) (when (and interactive? (not cc)) (set! cc (prompt "Cc" allow-empty?: #t))) (let* ((ticket (make-ticket summary: summary type: type body: body reporter: (get-username) component: component difficulty: difficulty priority: priority owner: owner version: version milestone: milestone status: status cc: cc keywords: keywords time: (utc-useconds))) (thash (write-ticket ticket))) (db-add-ticket ticket) (unless (null? attachments) (add-ticket-attachments thash attachments #t)) (set-last-used-ticket-hash! thash) (print thash " created"))))) ) ;; end module