(module test-edit mzscheme
  (require (planet "test.ss" ("schematics" "schemeunit.plt" 2 8))
           (planet "text-ui.ss" ("schematics" "schemeunit.plt" 2 8))
           "cursor.ss"
           "struct.ss")
  
  (define (test)
    (test/text-ui test-edit))
  
  (provide test-edit)
  
  (define test-edit
    (test-suite
     "test-edit.ss"
     
     
     (test-case
      "inserting before a sentinel should raise error 1"
      (let ([cursor (make-toplevel-cursor (list))])
        (check-exn exn:fail?
                   (lambda ()
                     (insert-before cursor (new-atom "hello"))))))
     
     
     (test-case
      "inserting before a sentinel should raise error 2"
      (let ([cursor (make-toplevel-cursor (list (new-atom "something")))])
        (check-exn exn:fail?
                   (lambda ()
                     (insert-before cursor (new-atom "hello"))))))
     
     
     (test-case
      "inserting a single atom before."
      (let ([cursor (focus-older
                     (make-toplevel-cursor (list (new-atom "world"))))])
        (let ([new-cursor
               (insert-before cursor (new-atom "hello"))])
          (check-equal? (cursor-dstx new-cursor)
                        (new-atom "hello"))
          (check-equal? (cursor-dstx
                         (focus-older/snap new-cursor))
                        (new-atom "world")))))
     
     
     (test-case
      "inserting a single atom after."
      (let ([cursor (focus-older
                     (make-toplevel-cursor (list (new-atom "greetings"))))])
        (let ([new-cursor
               (insert-after cursor (new-atom "earthling"))])
          (check-equal? (cursor-dstx new-cursor)
                        (new-atom "earthling"))
          (check-equal? (cursor-dstx
                         (focus-younger/snap new-cursor))
                        (new-atom "greetings")))))
     
     
     (test-case
      "insert-before-and-after"
      (let ([a-cursor (make-toplevel-cursor '())])
        (let ([new-cursor
               (insert-after
                (insert-before
                 (insert-after a-cursor (new-atom "a"))
                 (new-atom "b"))
                (new-atom "c"))])
          (check-equal? (cursor-toplevel-dstxs new-cursor)
                        (list a-sentinel-space
                              (new-atom "b")
                              (new-atom "c")
                              (new-atom "a"))))))
     
     (test-case
      "inserting from an empty toplevel"
      (let* ([a-cursor (make-toplevel-cursor '())]
             [a-cursor (insert-after a-cursor (new-atom "hello"))]
             [a-cursor (insert-after a-cursor (new-atom "this"))]
             [a-cursor (insert-after a-cursor (new-atom "is"))]
             [a-cursor (insert-after a-cursor (new-fusion "("
                                                          (list (new-atom "a") (new-atom "test"))
                                                          ")"))])
        (check-equal? (cursor-dstx a-cursor)
                      (new-fusion "("
                                  (list (new-atom "a") (new-atom "test"))
                                  ")"))
        (check-equal? (cursor-dstx (focus-younger/snap a-cursor))
                      (new-atom "is"))))
     
     (test-case
      "inserting into a fusion"
      (let* ([a-cursor (focus-older (make-toplevel-cursor (list (new-fusion "(" '() ")"))))]
             [a-cursor (focus-in a-cursor)]
             [a-cursor (insert-after a-cursor (new-atom "inside"))])
        (check-equal? (cursor-dstx a-cursor) (new-atom "inside"))
        (check-equal? (cursor-dstx (focus-out a-cursor))
                      (new-fusion "(" (list (new-atom "inside")) ")"))))
     
     (test-case
      "setting a property"
      (let ([cursor (focus-older (make-toplevel-cursor (list (new-atom "answer"))))])
        (check-equal? (dstx-property-names (cursor-dstx cursor)) '())
        (let ([new-cursor
               (property-set cursor 'value 42)])
          (check-equal? (dstx-property-names (cursor-dstx new-cursor)) '(value))
          (check-equal? (atom-content (cursor-dstx new-cursor)) "answer")
          (check-equal? (dstx-property-ref (cursor-dstx new-cursor) 'value)
                        42))))
     
     (test-case
      "setting a property twice"
      (let ([cursor (focus-older (make-toplevel-cursor (list (new-atom "answer"))))])
        (check-equal? (dstx-property-names (cursor-dstx cursor)) '())
        (let* ([new-cursor
                (property-set cursor 'value 42)]
               [new-cursor
                (property-set new-cursor 'value
                                          (add1 (dstx-property-ref (cursor-dstx new-cursor) 'value)))])
          (check-equal? (dstx-property-names (cursor-dstx new-cursor)) '(value))
          (check-equal? (atom-content (cursor-dstx new-cursor)) "answer")
          (check-equal? (dstx-property-ref (cursor-dstx new-cursor) 'value)
                        43))))
     
     
     (test-case
      "deleting the empty toplevel should raise an exception"
      (let ([a-cursor (make-toplevel-cursor (list))])
        (check-exn exn:fail? (lambda () (delete a-cursor)))))
     
     (test-case
      "deleting a single toplevel atom should bring us back to the sentinel."
      (let ([a-cursor (focus-older
                       (make-toplevel-cursor (list (new-atom "DELETED!"))))])
        (check-equal? (delete a-cursor)
                      (make-toplevel-cursor (list)))
        (check-eq? (cursor-dstx (delete a-cursor))
                   a-sentinel-space)))
     
     (test-case
      "deleting from two toplevel atoms"
      (let ([a-cursor (focus-older
                       (make-toplevel-cursor (list (new-atom "x")
                                                   (new-atom "y"))))])
        (check-equal? (delete a-cursor)
                      (focus-older
                       (make-toplevel-cursor (list (new-atom "y")))))))
     
     (test-case
      "deleting from second of the two toplevel atoms"
      (let* ([a-cursor (focus-older
                        (make-toplevel-cursor (list (new-atom "x")
                                                    (new-atom "y"))))]
             [a-cursor (focus-successor/snap a-cursor)])
        (check-equal? (delete a-cursor)
                      (focus-older
                       (make-toplevel-cursor (list (new-atom "x")))))))
     
     (test-case
      "deleting from inside a fusion (removing y)"
      (let* ([a-cursor (focus-older
                        (make-toplevel-cursor
                         (list (new-atom "x")
                               (new-fusion "[" (list (new-atom "y")
                                                     (new-atom "z"))
                                           "]"))))]
             [a-cursor (focus-successor/snap a-cursor)]
             [a-cursor (focus-in/snap a-cursor)])
        ;; check that the focus moved to z
        (check-equal? (cursor-dstx (delete a-cursor))
                      (new-atom "z"))
        ;; and check content.
        (check-equal? (focus-toplevel (delete a-cursor))
                      (make-toplevel-cursor
                       (list (new-atom "x")
                             (new-fusion "[" (list (new-atom "z"))
                                         "]"))))))
     
     
     (test-case
      "deleting from inside a fusion (removing z)"
      (let* ([a-cursor (focus-older
                        (make-toplevel-cursor
                         (list (new-atom "x")
                               (new-fusion "[" (list (new-atom "y")
                                                     (new-atom "z"))
                                           "]"))))]
             [a-cursor (focus-successor/snap a-cursor)]
             [a-cursor (focus-successor/snap a-cursor)]
             [a-cursor (focus-successor/snap a-cursor)])
        ;; check the new focus...
        (check-equal? (cursor-dstx (delete a-cursor))
                      (new-atom "y"))
        ;; and check the content.
        (check-equal? (focus-toplevel (delete a-cursor))
                      (make-toplevel-cursor
                       (list (new-atom "x")
                             (new-fusion "[" (list (new-atom "y"))
                                         "]")))))))))