#lang racket

(require rackunit
         "spec-ast.rkt"
         "parser.rkt"
         "match.rkt")

(require/expose "match.rkt"
                (find-switch
                 invoke-cmd-fn
                 match-command
                 snoc))

(provide match-tests)

(define add-function
  (lambda (#:start-date [start-date #f]
           #:due-date [due-date #f]
           #:note [note #f]
           #:edit-note [edit-note #f]
           #:url [url #f]
           . summary)
    `(add (start-date ,start-date)
          (due-date ,due-date)
          (note ,note)
          (edit-note ,edit-note)
          (url ,url)
          (summary ,summary))))

(define list-function
  (lambda (#:show-completed [show-completed #f]
           #:show-future [show-future #f])
    `(list (show-completed ,show-completed)
           (show-future ,show-future))))

(define show-function
  (lambda (id
           id2
           #:single-arg [single-arg #f]
           #:multi-arg [multi-arg #f])
    `(show (id ,id)
           (id2 ,id2)
           (single-arg ,single-arg)
           (multi-arg ,multi-arg))))

(define complete-function
  (lambda (id)
    `(complete (id ,id))))

(define update-function
  (lambda (id #:summary [summary #f]
              #:start-date [start-date #f]
              #:due-date [due-date #f]
              #:note [note #f]
              #:edit-note [edit-note #f]
              #:url [url #f]
              #:incomplete [incomplete #f])
    `(update (id ,id)
             (summary ,summary)
             (start-date ,start-date)
             (due-date ,due-date)
             (note ,note)
             (edit-note ,edit-note)
             (url ,url)
             (incomplete ,incomplete))))

(define test-command-spec
  (parse-spec
   `(tasks "Task management System"
           [add "Add a new task"
                "Long add help"
                summary
                #:once-each
                [("-s" "--start-date") #:start-date
                 "Date on which task begins"
                 date]
                [("-d" "--due-date") #:due-date
                 "Task's due date"
                 date]
                #:once-any
                [("-n" "--note") #:note
                 "Name of file containing note for task"
                 filename]
                [("-e" "--edit-note") #:edit-note
                 "Bring up $EDITOR for task's note"]
                #:once-each
                [("-u" "--url") #:url
                 "Associate a URL with the task"
                 url]
                ,add-function]
           [list "List existing tasks"
                 "Long LIST help"
                 ()
                 #:once-each
                 [("-c" "--show-completed") #:show-completed
                  "Show completed as well as pending tasks"]
                 [("-f" "--show-future") #:show-future
                  "Show tasks not yet started as well as normal tasks"]
                 ,list-function]
           [show "Show detailed information about a specific task"
                 "long SHOW help"
                 (id id2)
                 #:multi
                 [("-s" "--single-arg") #:single-arg "single arg multi switch"
                  arg]
                 [("-m" "--multi-arg") #:multi-arg "multiple arg multi switch"
                  arg1 arg2]
                 ,show-function]
           [complete "Mark task as completed"
                     "long COMPLETE help"
                     (id)
                     ,complete-function]
           [update "Updates a task"
                   "long UPDATE help"
                   (id)
                   #:once-each
                   [("-m" "--summary") #:summary
                    "Update summary"
                    summary-text]
                   [("-s" "--start-date") #:start-date
                    "Update start date"
                    start-date]
                   [("-d" "--due-date") #:due-date
                    "Update due date"
                    due-date]
                   #:once-any
                   [("-n" "--note") #:note
                    "Replace the task's note with the contents of a file"
                    filename]
                   [("-e" "--edit-note") #:edit-note
                    "Load the task's note into $EDITOR"]
                   #:once-each
                   [("-u" "--url") #:url
                    "Replace the task's URL"
                    url]
                   [("-i" "--incomplete") #:incomplete
                     "Remove the task's \"completed\" marking"]
                   ,update-function])))

(define match-spec-tests
  (test-suite "match-spec"
    (test-equal? "add"
      (match-spec test-command-spec
                  '("add" "summary text" "-s" "2011-01-30"
                          "-d" "2011-03-01" "-e"
                          "-u" "http://www.example.com/"))
      '(add (start-date ("2011-01-30"))
            (due-date ("2011-03-01"))
            (note #f)
            (edit-note ())
            (url ("http://www.example.com/"))
            (summary ("summary text"))))
    (test-exn "help request"
      exn:fc:help-request?
      (lambda ()
        (match-spec test-command-spec '("help"))))
    (test-exn "help request for specific command"
      exn:fc:help-request?
      (lambda ()
        (match-spec test-command-spec '("help" "add"))))
    (test-exn "help request for bad command"
      exn:fc:bad-command?
      (lambda ()
        (match-spec test-command-spec '("help" "foo"))))
    (test-exn "switch instead of command"
      exn:fc:bad-command?
      (lambda ()
        (match-spec test-command-spec '("--start-date" "2011-02-02"))))
    (test-exn "bad command name"
      exn:fc:bad-command?
      (lambda ()
        (match-spec test-command-spec
                    '("foo" "bar" "baz" "-s" "quux"))))))

(define match-command-tests
  (let ([add-command (find-command test-command-spec "add")]
        [list-command (find-command test-command-spec "list")]
        [show-command (find-command test-command-spec "show")])
    (test-suite "match-command"
      (test-equal? "add, only positional"
        (match-command add-command '("foo" "bar"))
        '(add (start-date #f)
              (due-date #f)
              (note #f)
              (edit-note #f)
              (url #f)
              (summary ("foo" "bar"))))
      (test-equal? "add, no positional args"
        (match-command add-command null)
        '(add (start-date #f)
              (due-date #f)
              (note #f)
              (edit-note #f)
              (url #f)
              (summary ())))
      (test-equal? "once-each args"
        (match-command add-command '("-s" "today" "-d" "tomorrow"))
        `(add (start-date ("today"))
              (due-date ("tomorrow"))
              (note #f)
              (edit-note #f)
              (url #f)
              (summary ())))
      (test-equal? "once-any args"
        (match-command add-command '("-n" "note-file.txt"))
        `(add (start-date #f)
              (due-date #f)
              (note ("note-file.txt"))
              (edit-note #f)
              (url #f)
              (summary ())))
      (test-exn "duplicate once-each args (add)"
        exn:fc:duplicate-switch?
        (lambda ()
          (match-command add-command
                         '("task" "summary" "-s" "today" "-d" "tomorrow"
                           "-d" "2011-03-15"))))
      (test-exn "multiple once-any args (add)"
        exn:fc:multiple-group-members?
        (lambda ()
          (match-command add-command '("-n" "note-file.txt" "-e"))))
      (test-equal? "show, only positional"
        (match-command show-command '("3" "4"))
        '(show (id "3") (id2 "4") (single-arg #f) (multi-arg #f)))
      (test-equal? "show, full multi args"
        (match-command show-command
                    '("arg1" "-s" "s1" "-m" "m1,1" "m1,2"
                      "arg2" "-m" "m2,1" "m2,2" "-s" "s2"))
        '(show (id "arg1")
               (id2 "arg2")
               (single-arg (("s1" "s2")))
               (multi-arg (("m1,1" "m2,1") ("m1,2" "m2,2")))))
      (test-exn "list, extra positional"
        exn:fc:extra-argument?
        (lambda () (match-command list-command '("x" "y" "z"))))
      (test-exn "missing positional (show)"
        exn:fc:missing-argument?
        (lambda () (match-command show-command '("arg1" "-s" "foo"))))
      (test-exn "missing argument to switch (show)"
        exn:fc:missing-argument?
        (lambda () (match-command show-command '("arg1" "arg2" "-s"))))
      (test-exn "bogus switch (show)"
        exn:fc:bad-switch?
        (lambda () (match-command show-command '("arg1" "arg2" "-q")))))))

(define find-switch-tests
  (let ([add-flags (command-flags (find-command test-command-spec "add"))]
        [show-flags (command-flags (find-command test-command-spec "show"))])
  (test-suite "find-switch"
    (test-equal? "optional flag, no group"
      (find-switch "-s" add-flags)
      (optional-flag (set "-s" "--start-date")
                     '#:start-date
                     '("Date on which task begins")
                     '(date)))
    (test-equal? "multi flag"
      (find-switch "--single-arg" show-flags)
      (multi-flag (set "-s" "--single-arg")
                  '#:single-arg
                  '("single arg multi switch")
                  '(arg)))
    (test-equal? "optional flag, in group"
      (find-switch "--note" add-flags)
      (let ([s (optional-flag (set "-n" "--note")
                              '#:note
                              '("Name of file containing note for task")
                              '(filename))])
        (cons s
              (group (list s
                           (optional-flag (set "-e" "--edit-note")
                                          '#:edit-note
                                          '("Bring up $EDITOR for task's note")
                                          null))))))
    (test-false "flag not found"
      (find-switch "--no-such-flag" add-flags)))))

(define invoke-cmd-fn-tests
  (test-suite "invoke-cmd-fn"
    (test-equal? "add-function, no kw args"
                 (invoke-cmd-fn add-function
                                null
                                '("x" "y" "z")
                                (hasheq))
                 '(add (start-date #f)
                       (due-date #f)
                       (note #f)
                       (edit-note #f)
                       (url #f)
                       (summary ("x" "y" "z"))))
    (test-equal? "add-function, kw args"
                 (invoke-cmd-fn add-function
                                null
                                '("x" "y" "z")
                                (hasheq '#:start-date '("s")
                                        '#:edit-note '("foo")))
                 '(add (start-date ("s"))
                       (due-date #f)
                       (note #f)
                       (edit-note ("foo"))
                       (url #f)
                       (summary ("x" "y" "z"))))
    (test-equal? "show function w/ multi args"
                 (invoke-cmd-fn show-function
                                '("42" "56")
                                null
                                (hasheq
                                 '#:single-arg '(("x" "y"))
                                 '#:multi-arg '(("a" "c") ("b" "d"))))
                 '(show (id "42")
                        (id2 "56")
                        (single-arg (("x" "y")))
                        (multi-arg (("a" "c") ("b" "d")))))))

(define snoc-tests
  (test-suite "snoc"
    (test-equal? "second arg empty"
                 (snoc 'x null)
                 '(x))
    (test-equal? "second arg non-empty"
                 (snoc 'z '(x y))
                 '(x y z))))

(define match-tests
  (test-suite "Test of command-line matcher"
    match-spec-tests
    match-command-tests
    find-switch-tests
    invoke-cmd-fn-tests
    snoc-tests))