#lang racket/base
;; For legal info, see file "info.rkt".

(require racket/file
         syntax/parse
         syntax/srcloc
         (planet neil/overeasy:2)
         "progedit.rkt")

(test-section 'progedit

  (test-section 'sanity-check-positions

    (test 'source-location-position
          (source-location-position (read-syntax 'foo (open-input-string "(aaa)")))
          1)

    (test 'file-position
          (let ((p (open-input-string "(aaa)"))) (port-count-lines! p) (read-char p) (file-position p))
          1))

  (test-section 'jane

    (define (%define-name-as-jane in-str)
      (let ((in (open-input-string in-str)))
        (let loop ((name-stx #f))
          (let ((stx (read-syntax 'my-source in)))
            (if (eof-object? stx)
                (let-values (((inserts replaces)
                              (if name-stx
                                  (values '()
                                          `((,name-stx ,#'"Jane")))
                                  (values `((#f #\newline
                                                ,#'(define name "Jane")
                                                #\newline))
                                          '())))
                             ((out) (open-output-string)))
                  (progedit (open-input-string in-str)
                            out
                            #:inserts  inserts
                            #:replaces replaces)
                  (get-output-string out))
                (syntax-parse stx
                  (((~datum define) (~datum name) VAL)
                   (if name-stx
                       (raise-syntax-error
                        '%define-name-as-jane
                        "(define name VAL) occurred multiple times"
                        stx
                        #f
                        (list name-stx))
                       (loop #'VAL)))
                  (_ (loop name-stx))))))))

    (test 'name-is-defined
          (%define-name-as-jane
           "(define honorific \"Dr.\")\n;; House.\n\n(define name \"John\")\n\n(define age 29)\n")
          "(define honorific \"Dr.\")\n;; House.\n\n(define name \"Jane\")\n\n(define age 29)\n")

    (test 'name-is-not-defined
          (%define-name-as-jane
           "(define honorific \"Dr.\")\n;; House.\n\n(define age 29)\n")
          "(define honorific \"Dr.\")\n;; House.\n\n(define age 29)\n\n(define name \"Jane\")\n"))

  (test-section 'tricky-ordering

    (define (%aaa-bbb-ccc proc)
      (let ((in-str "(aaa bbb ccc)"))
        (let ((stx (read-syntax 'my-source (open-input-string in-str))))
          (syntax-parse stx
            ((A B C)
             (let ((out (open-output-string)))
               (proc (open-input-string in-str) out #'A #'B #'C)
               (get-output-string out)))))))

    (test 'insert-after-replace
          (%aaa-bbb-ccc
           (lambda (in out a-stx b-stx c-stx)
             (progedit in
                       out
                       #:inserts  `(((after ,b-stx) " After"))
                       #:replaces `((,b-stx "Bee")))))
          "(aaa Bee After ccc)")

    (test 'insert-before-replace
          (%aaa-bbb-ccc
           (lambda (in out a-stx b-stx c-stx)
             (progedit in
                       out
                       #:inserts  `(((before ,b-stx) "Before "))
                       #:replaces `((,b-stx "Bee")))))
          "(aaa Before Bee ccc)")

    (test 'inserts-before-after-delete
          (%aaa-bbb-ccc
           (lambda (in out a-stx b-stx c-stx)
             (progedit in
                       out
                       #:deletes `(,b-stx)
                       #:inserts `(((before ,b-stx) "Before ")
                                   ((after  ,b-stx) "After")))))
          "(aaa Before After ccc)")

    (test 'inserts-after-before-delete
          (%aaa-bbb-ccc
           (lambda (in out a-stx b-stx c-stx)
             (progedit in
                       out
                       #:deletes `(,b-stx)
                       #:inserts `(((after  ,b-stx) "After")
                                   ((before ,b-stx) "Before ")))))
          "(aaa Before After ccc)"))

  (test-section 'progedit-file

    (test 'basic
          (let ((actual-path "temporary-progedit-test-1")
                (backup-path "temporary-progedit-test-1-backup"))
            (dynamic-wind
              void
              (lambda ()
                (display-to-file ";; Comment\n(aaa bbb ccc)\n" actual-path #:exists 'replace)
                (with-handlers ((exn:fail? void)) (delete-file backup-path))
                (let ((result (progedit-file
                               actual-path
                               #:read
                               (lambda (in)
                                 (syntax-parse (read-syntax 'my-source in)
                                   ((A B C)
                                    (let ((out (open-output-string)))
                                      (values #'A #'B #'C)))))
                               #:write
                               (lambda (in out a-stx b-stx c-stx)
                                 (progedit in
                                           out
                                           #:inserts  `(((after  ,b-stx) " After")
                                                        ((before ,b-stx) "Before ")
                                                        (1 "#lang foo" #\newline #\newline)
                                                        (#f "\n;; EOF\n"))
                                           #:replaces `((,b-stx "Replaced")))

                                 42)
                               #:backup (lambda args backup-path))))
                  (values result
                          (file->string actual-path))))
              (lambda ()
                (with-handlers ((exn:fail? void)) (delete-file actual-path))
                (with-handlers ((exn:fail? void)) (delete-file backup-path)))))
          (values 42
                  "#lang foo\n\n;; Comment\n(aaa Before Replaced After ccc)\n\n;; EOF\n"))

    (test 'aborted-without-writing
          (let ((actual-path "temporary-progedit-test-1")
                (backup-path "temporary-progedit-test-1-backup"))
            (dynamic-wind
              void
              (lambda ()
                (display-to-file "original" actual-path #:exists 'replace)
                (let ((identity-before (file-or-directory-identity actual-path)))
                  (with-handlers ((exn:fail? void)) (delete-file backup-path))
                  (let/ec abort-the-progedit-ec
                    (progedit-file actual-path
                                   #:read
                                   (lambda (in)
                                     (abort-the-progedit-ec))
                                   #:write
                                   (lambda (in out . args)
                                     (display "stomped" out #:exists 'replace)
                                     (flush-output out))
                                   #:backup
                                   (lambda args backup-path)))
                  (values (if (equal? (file-or-directory-identity actual-path)
                                      identity-before)
                              'identity-same
                              'identity-changed)
                          (file->string actual-path))))
              (lambda ()
                (with-handlers ((exn:fail? void)) (delete-file actual-path))
                (with-handlers ((exn:fail? void)) (delete-file backup-path)))))
          (values 'identity-same
                  "original"))

  ;; TODO: Test the error handling, like restoring original file when
  ;; different kinds of errors happen, and detecting file changed since
  ;; started reading.

  ))

;; TODO: Test that replace works with (position . position).

;;   (test-section 'resolve-orders
;;
;;     (test (syntax-parse (read-syntax 'foo (open-input-string "(aaa bbb ccc ddd eee)"))
;;             ((A B C D E)
;;              (%progedit:resolve-orders #:deletes  (list (syntax D))
;;                                        #:inserts  `(((before . ,(syntax A)) "xxx "))
;;                                        #:replaces `((,(syntax C) "seeseesee")))))
;;           (values '((14 . 17) (10 . 13))
;;                   '((2 "xxx ") (10 "seeseesee")))))

;;   (test-section 'some-of-everything
;;
;;     (test (let*-values (((source-str)
;;                          "(aaa bbb ccc ddd eee)")
;;                         ((deletes inserts replaces resolved-deletes resolved-inserts)
;;                          (syntax-parse (read-syntax 'foo (open-input-string source-str))
;;                            ((A B C D E)
;;                             (let ((deletes  (list (syntax D)))
;;                                   (inserts  `(((before . ,(syntax A)) . "xxx ")))
;;                                   (replaces `((,(syntax C) . "seeseesee"))))
;;                               (let-values (((resolved-deletes resolved-inserts)
;;                                             (%progedit:resolve-orders #:deletes  deletes
;;                                                                       #:inserts  inserts
;;                                                                       #:replaces replaces)))
;;                                 (values deletes
;;                                         inserts
;;                                         replaces
;;                                         resolved-deletes
;;                                         resolved-inserts))))))
;;                         ((sorted-orders)
;;                          (%progedit:sort-resolved-orders
;;                           #:resolved-deletes resolved-deletes
;;                           #:resolved-inserts resolved-inserts))
;;                         ((instructions)
;;                          (%progedit:sorted-orders->instructions-debug-dump
;;                           #:sorted-orders sorted-orders))
;;                         ((result)
;;                          (let ((in  (open-input-string source-str))
;;                                (out (open-output-string)))
;;                            (progedit in
;;                                            out
;;                                            #:deletes  deletes
;;                                            #:inserts  inserts
;;                                            #:replaces replaces)
;;                            (get-output-string out))))
;;             (list ':resolved-deletes resolved-deletes
;;                   ':resolved-inserts resolved-inserts
;;                   ':sorted-orders    sorted-orders
;;                   ':instructions     instructions
;;                   ':result           result))
;;           (list ':resolved-deletes '((14 . 17) (10 . 13))
;;                 ':resolved-inserts '((2 . "xxx ") (10 . "seeseesee"))
;;                 ':sorted-orders    '((2 . "xxx ") (10 . "seeseesee") (10 . 13)  (14 . 17))
;;                 ':instructions     '((copy 1) ; copy "("
;;                                      (write "xxx ")
;;                                      (copy 8) ; copy "aaa bbb "
;;                                      (write "seeseesee")
;;                                      (skip 3) ; skip "ccc"
;;                                      (copy 1) ; copy " " between ccc and ddd
;;                                      (skip 3) ; skip "ddd"
;;                                      (copy #f))
;;                 ':result           "(xxx aaa bbb seeseesee  eee)")))