(in-package #:lime.test)
(in-suite lime-suite)

(test explicit-active-membership-move-is-one-transaction-and-keeps-both-desks
  (dolist (mode '(:manual :master-stack :monocle))
    (dolist (floating-p '(nil t))
      (let* ((world (make-fixture))
             (source (activate-view-strictly world "left" "code"))
             (target (activate-view-strictly world "right" "play")))
        (set-presentation-layout-mode world (presentation-id target) mode)
        (when floating-p
          (toggle-client-floating world (presentation-id source) "emacs"
                                  :data '(:x 1/4 :y 1/4 :width 1/2 :height 1/2)))
        (let ((revision (world-revision world))
              (old-lease (lease-for-client world "game-client")))
          (move-client-to-presentation world "emacs" (presentation-id target)
                                       :tiled-insertion-position :front)
          (is (= (1+ revision) (world-revision world)))
          (is (eq source (current-presentation world "left")))
          (is (eq target (current-presentation world "right")))
          (is (equal "game" (client-activity-id (find-client world "emacs"))))
          (is (equal "right" (lease-head-id world "emacs")))
          (is (eq old-lease (lease-for-client world "game-client")))
          (is (equal "terminal" (presentation-focus-client-id source)))
          (is (equal "emacs" (presentation-focus-client-id target)))
          (is (equal '("terminal") (mapcar #'placement-client-id (view-placements (find-view world "code")))))
          (is (equal '("firefox") (mapcar #'placement-client-id (view-placements (find-view world "docs")))))
          (is (equal '("game-client") (mapcar #'placement-client-id (view-placements (find-view world "play")))))
          (is (presentation-dirty-p source))
          (is (presentation-dirty-p target))
          (is (eq mode (presentation-layout-mode target)))
          (let ((placement (find "emacs" (presentation-placements target) :key #'placement-client-id :test #'equal)))
            (is (eq (if floating-p :float :tile) (placement-kind placement)))
            (when floating-p
              (is (equal '(:x 1/4 :y 1/4 :width 1/2 :height 1/2) (placement-data placement)))))
          (is (validate-world world)))))))

(test explicit-live-move-failures-leave-membership-placements-and-lease-unchanged
  (let* ((world (make-fixture))
         (source (activate-view-strictly world "left" "code"))
         (target (activate-view-strictly world "right" "play"))
         (revision (world-revision world))
         (lease (lease-for-client world "emacs"))
         (source-placements (presentation-placements source))
         (target-placements (presentation-placements target)))
    ;; The old parked-move command still rejects an active destination.
    (signals invalid-transition (move-client-to-activity world "emacs" "game" :target-head-id "right"))
    (signals error (move-client-to-presentation world "emacs" (presentation-id target)
                                               :focus-direction (lambda (c) (declare (ignore c)) (error "bad policy"))))
    (signals invalid-transition (move-client-to-presentation world "emacs" (presentation-id target)
                                                            :tiled-insertion-position :invalid))
    (signals unknown-entity (move-client-to-presentation world "emacs" "missing"))
    (is (= revision (world-revision world)))
    (is (eq lease (lease-for-client world "emacs")))
    (is (eq source-placements (presentation-placements source)))
    (is (eq target-placements (presentation-placements target)))
    (is (equal "lime" (client-activity-id (find-client world "emacs"))))
    (activate-view-strictly world "right" "browser")
    (let ((revision (world-revision world)))
      (signals invalid-transition (move-client-to-presentation world "emacs" (presentation-id target)))
      (is (= revision (world-revision world))))
    (is (validate-world world))))

(test activity-deletion-cleans-checkpoints-cached-drafts-and-viewset-references
  (let ((world (make-fixture)))
    (create-activity world "old" "Old task")
    (create-view world "old/view" "old" "Saved" nil)
    (open-activity-draft world "left" "old")
    (activate-view-strictly world "left" "old/view")
    (activate-view-strictly world "left" "code")
    (open-activity-draft world "right" "old")
    (activate-view-strictly world "right" "browser")
    (create-viewset world "mixed" "Mixed" (list (make-viewset-entry :head-id "left" :view-id "code")
                                               (make-viewset-entry :head-id "right" :view-id "old/view")))
    (create-viewset world "only-old" "Only old" (list (make-viewset-entry :head-id "right" :view-id "old/view")))
    (let* ((revision (world-revision world))
           (summary (activity-deletion-summary world "old"))
           (drafts (getf summary :presentation-ids))
           (left (current-presentation world "left"))
           (right (current-presentation world "right")))
      (is-true (getf summary :ready-p))
      (is (= 2 (length drafts)))
      (is (= 2 (getf summary :viewset-entry-count)))
      (is (= revision (world-revision world)))
      (delete-activity world "old" :expected-revision revision)
      (signals unknown-entity (find-activity world "old"))
      (signals unknown-entity (find-view world "old/view"))
      (signals unknown-entity (find-viewset world "only-old"))
      (dolist (id drafts) (signals unknown-entity (find-presentation world id)))
      (is (equal '("code") (mapcar #'viewset-entry-view-id (viewset-entries (find-viewset world "mixed")))))
      (is (eq left (current-presentation world "left")))
      (is (eq right (current-presentation world "right")))
      (is (= 3 (hash-table-count (lime.core::world-leases world))))
      (is (= (1+ revision) (world-revision world)))
      (is-true (validate-world world)))))

(test activity-deletion-refuses-home-clients-even-hidden-or-shared-elsewhere
  (let ((world (make-fixture)))
    (create-activity world "music" "Music")
    (create-client world "player" "music" :shared-p t)
    (let ((revision (world-revision world)))
      (signals invalid-transition (delete-activity world "music"))
      (is (= revision (world-revision world))))
    (let ((p (open-activity-draft world "left" "lime")))
      (show-client-on-presentation world "player" (presentation-id p)))
    (let ((revision (world-revision world)))
      (signals invalid-transition (delete-activity world "music"))
      (is (= revision (world-revision world)))
      (is (equal "left" (lease-head-id world "player")))
      (is-true (validate-world world)))))

(test activity-deletion-refuses-even-empty-mounts-on-any-head
  (let ((world (make-fixture)))
    (create-activity world "empty" "Empty")
    (open-activity-draft world "left" "empty")
    (open-activity-draft world "right" "empty")
    (let ((revision (world-revision world)))
      (is (= 2 (length (getf (activity-deletion-summary world "empty") :head-ids))))
      (signals invalid-transition (delete-activity world "empty"))
      (is (= revision (world-revision world))))
    (activate-view-strictly world "left" "code")
    (signals invalid-transition (delete-activity world "empty"))
    (activate-view-strictly world "right" "browser")
    (delete-activity world "empty")
    (is-true (validate-world world))))

(test deleting-cached-shared-requests-never-retires-or-takes-the-client
  (let ((world (make-fixture)))
    (set-client-shared world "terminal" t)
    (create-activity world "borrower" "Borrower")
    (create-view world "borrowed" "borrower" "Borrowed" (placements "terminal"))
    (let ((p (open-activity-draft world "right" "borrower")))
      (show-client-on-presentation world "terminal" (presentation-id p)))
    (activate-view-strictly world "right" "browser")
    (activate-view-strictly world "left" "code")
    (let ((lease (lease-for-client world "terminal")))
      (delete-activity world "borrower")
      (is (eq lease (lease-for-client world "terminal")))
      (is (equal "lime" (client-activity-id (find-client world "terminal"))))
      (is-true (client-shared-p (find-client world "terminal")))
      (is-true (validate-world world)))))

(test stale-deletion-and-activation-plans-are-rejected
  (let ((world (make-fixture)))
    (create-activity world "old" "Old")
    (let* ((summary (activity-deletion-summary world "old"))
           (plan (build-strict-activation-plan (preflight-view-activation world "left" "code"))))
      (create-client world "new" "old")
      (let ((revision (world-revision world)))
        (signals stale-transition-plan (delete-activity world "old" :expected-revision (getf summary :revision)))
        (is (= revision (world-revision world))))
      (retire-client world "new")
      (delete-activity world "old")
      (signals stale-transition-plan (commit-activation-plan world plan))
      (is-true (validate-world world)))))

(test shared-eligibility-does-not-duplicate-home-membership-or-grant-leases
  (let* ((world (make-fixture)) (revision (world-revision world)))
    (set-client-shared world "terminal" t)
    (is (> (world-revision world) revision))
    (is (equal "lime" (client-activity-id (find-client world "terminal"))))
    (is-false (member "terminal" (activity-client-ids (find-activity world "game")) :test #'equal))
    (is (member "terminal" (activity-available-client-ids world "game") :test #'equal))
    (is-false (lease-for-client world "terminal"))
    (signals invalid-activity-membership
      (create-view world "bad" "game" "Bad" (placements "emacs")))
    (create-view world "music" "game" "Music" (placements "terminal"))
    (is-true (validate-world world))))

(test shared-cross-activity-views-use-the-existing-strict-partial-take-policies
  (let ((world (make-fixture)))
    (set-client-shared world "terminal" t)
    (create-view world "music" "game" "Music" (placements "terminal" "game-client"))
    (activate-view-strictly world "left" "code")
    (let ((revision (world-revision world)))
      (signals error (activate-view-strictly world "right" "music"))
      (is (= revision (world-revision world))))
    (activate-view-partially world "right" "music")
    (is (equal "left" (lease-head-id world "terminal")))
    (is (equal '("terminal") (presentation-unavailable-client-ids (current-presentation world "right"))))
    (transfer-client-lease world "terminal" (presentation-id (current-presentation world "right")))
    (is (equal "right" (lease-head-id world "terminal")))
    (is (equal '("emacs") (presentation-client-ids (current-presentation world "left"))))
    (is-true (validate-world world))
    (activate-view-taking world "left" "code")
    (is (equal "left" (lease-head-id world "terminal")))
    (is-true (validate-world world))))

(test shared-window-can-switch-activities-on-the-same-head-without-collision
  (let ((world (make-fixture)))
    (set-client-shared world "terminal" t)
    (create-view world "music" "game" "Music" (placements "terminal"))
    (activate-view-strictly world "left" "code")
    (activate-view-strictly world "left" "music")
    (is (equal "left" (lease-head-id world "terminal")))
    (is-true (validate-world world))))

(test private-move-prunes-checkpoints-and-cached-drafts-without-switching-heads
  (let ((world (make-fixture)))
    (let ((cached (open-activity-draft world "left" "lime")))
      (show-client-on-presentation world "emacs" (presentation-id cached))
      (activate-view-strictly world "left" "code")
      (activate-view-partially world "right" "docs")
      (let* ((source (current-presentation world "left"))
             (source-id (presentation-id source)))
        (move-client-to-activity world "emacs" "game" :target-head-id "left")
        (is (equal source-id (presentation-id (current-presentation world "left"))))
        (is (equal "terminal" (presentation-focus-client-id source)))
        (is (equal "game" (client-activity-id (find-client world "emacs"))))
        (is-false (lease-for-client world "emacs"))
        (is (eq cached source))
        (is (equal '("terminal") (presentation-client-ids cached)))
        (is (equal '("terminal") (mapcar #'placement-client-id (view-placements (find-view world "code")))))
        (is (equal '("firefox") (mapcar #'placement-client-id (view-placements (find-view world "docs")))))
        (is-false (presentation-unavailable-client-ids (current-presentation world "right")))
        (let ((target (open-activity-draft world "left" "game")))
          (is (equal '("emacs") (presentation-client-ids target)))
          (is (equal "left" (lease-head-id world "emacs"))))
        (is-true (validate-world world))))))

(test move-retains-floating-geometry-and-destination-draft-settings
  (let* ((world (make-fixture))
         (target (open-activity-draft world "left" "game" :default-layout :monocle)))
    (show-client-on-presentation world "game-client" (presentation-id target))
    (activate-view-strictly world "left" "code")
    (let ((source (current-presentation world "left")))
      (toggle-client-floating world (presentation-id source) "terminal"
                              :data '(:x 1/4 :y 1/4 :width 1/2 :height 1/2))
      (let ((data (copy-tree (placement-data (second (presentation-placements source))))))
        (move-client-to-activity world "terminal" "game" :target-head-id "left")
        (is (eq target (activity-draft-for-head world "game" "left")))
        (is (eq :monocle (presentation-layout-mode target)))
        (is (equal '("game-client" "terminal") (presentation-client-ids target)))
        (is (eq :float (placement-kind (second (presentation-placements target)))))
        (is (equal data (placement-data (second (presentation-placements target)))))))
    (is-true (validate-world world))))

(test membership-policy-failure-leaves-no-partial-transition
  (let ((world (make-fixture)))
    (activate-view-strictly world "left" "code")
    (let* ((revision (world-revision world))
           (source (current-presentation world "left"))
           (old-placements (presentation-placements source))
           (count (hash-table-count (lime.core::world-presentations world))))
      (signals error
        (move-client-to-activity world "emacs" "game" :target-head-id "left"
                                 :focus-direction (lambda (c) (declare (ignore c)) (error "bad policy"))))
      (is (= revision (world-revision world)))
      (is (= count (hash-table-count (lime.core::world-presentations world))))
      (is (eq old-placements (presentation-placements source)))
      (is (equal "lime" (client-activity-id (find-client world "emacs"))))
      (is (equal "left" (lease-head-id world "emacs")))
      (signals error (move-client-to-activity world "emacs" "missing"))
      (signals error (move-client-to-activity world "emacs" "game" :target-head-id "missing"))
      (is (= revision (world-revision world)))
      (is-true (validate-world world)))))

(test revoke-sharing-prunes-foreign-requests-and-leases-but-keeps-home-checkpoints
  (let ((world (make-fixture)))
    (set-client-shared world "terminal" t)
    (create-view world "music" "game" "Music" (placements "terminal" "game-client") :focus-client-id "terminal")
    (let ((cached (open-activity-draft world "left" "game")))
      (show-client-on-presentation world "terminal" (presentation-id cached))
      (activate-view-strictly world "left" "music")
      (set-client-shared world "terminal" nil)
      (is-false (lease-for-client world "terminal"))
      (is (equal '("game-client") (presentation-client-ids cached)))
      (is (equal "game-client" (presentation-focus-client-id (current-presentation world "left"))))
      (is (equal '("game-client") (mapcar #'placement-client-id (view-placements (find-view world "music")))))
      (is (equal '("emacs" "terminal") (mapcar #'placement-client-id (view-placements (find-view world "code")))))
      (is-false (member "terminal" (activity-available-client-ids world "game") :test #'equal))
      (is-true (validate-world world)))))

(test moving-a-shared-client-changes-home-without-revoking-sharing
  (let ((world (make-fixture)))
    (set-client-shared world "terminal" t)
    (activate-view-strictly world "left" "code")
    (move-client-to-activity world "terminal" "game" :target-head-id "left")
    (is-true (client-shared-p (find-client world "terminal")))
    (is (equal "game" (client-activity-id (find-client world "terminal"))))
    (is (member "terminal" (mapcar #'placement-client-id (view-placements (find-view world "code"))) :test #'equal))
    (is-false (lease-for-client world "terminal"))
    (is (equal '("emacs") (presentation-client-ids (current-presentation world "left"))))
    (is-true (validate-world world))
    (retire-client world "terminal")
    (is-true (validate-world world))
    (is-false (presentation-client-ids (activity-draft-for-head world "game" "left")))))

(test moving-without-a-target-draft-parks-even-with-the-same-home
  (let ((world (make-fixture)))
    (activate-view-strictly world "left" "code")
    (move-client-to-activity world "emacs" "lime")
    (is-false (lease-for-client world "emacs"))
    (is (equal '("terminal") (presentation-client-ids (current-presentation world "left"))))
    (is-true (validate-world world))))

(test shared-viewset-still-rejects-two-simultaneous-claims
  (let ((world (make-fixture)))
    (set-client-shared world "terminal" t)
    (create-view world "music" "game" "Music" (placements "terminal"))
    (create-viewset world "duplicate" "Duplicate"
                    (list (make-viewset-entry :head-id "left" :view-id "code")
                          (make-viewset-entry :head-id "right" :view-id "music")))
    (let ((revision (world-revision world)))
      (signals error (activate-viewset-taking world "duplicate"))
      (is (= revision (world-revision world)))
      (is-false (lease-for-client world "terminal")))))

(test sharing-and-moving-invalidate-previous-activation-plans
  (dolist (operation (list (lambda (w) (set-client-shared w "terminal" t))
                          (lambda (w) (move-client-to-activity w "terminal" "game"))))
    (let* ((world (make-fixture))
           (plan (build-strict-activation-plan (preflight-view-activation world "left" "code"))))
      (funcall operation world)
      (signals stale-transition-plan (commit-activation-plan world plan))
      (is-true (validate-world world)))))

(test private-here-preserves-the-current-arrangement-and-lease
  (dolist (mode '(:manual :master-stack :monocle))
    (dolist (floating-p '(nil t))
      (let ((world (make-fixture)))
        (set-client-shared world "terminal" t)
        (create-view world "music" "game" "Music" (placements "terminal" "game-client")
                     :focus-client-id "terminal")
        (let ((target (activate-view-strictly world "right" "music")))
          (set-presentation-layout-mode world (presentation-id target) mode)
          (when floating-p
            (toggle-client-floating world (presentation-id target) "terminal"
                                    :data '(:x 1/4 :y 1/4 :width 1/2 :height 1/2)))
          ;; A foreign active arrangement can still request the leased client.
          (let* ((source (activate-view-partially world "left" "code"))
                 (revision (world-revision world))
                 (lease (lease-for-client world "terminal"))
                 (other-lease (lease-for-client world "emacs"))
                 (before (lime.core::copy-presentation target))
                 (checkpoint (view-placements (find-view world "music"))))
            (is (equal '("terminal") (presentation-unavailable-client-ids source)))
            (make-client-private-in-presentation world "terminal" (presentation-id target)
                                                 :expected-revision revision)
            (is (= (1+ revision) (world-revision world)))
            (is (equalp before target))
            (is (eq target (current-presentation world "right")))
            (is (eq lease (lease-for-client world "terminal")))
            (is (eq other-lease (lease-for-client world "emacs")))
            (is (equal "game" (client-activity-id (find-client world "terminal"))))
            (is-false (client-shared-p (find-client world "terminal")))
            (is-false (member "terminal" (activity-client-ids (find-activity world "lime")) :test #'equal))
            (is (= 1 (count "terminal" (activity-client-ids (find-activity world "game")) :test #'equal)))
            (is (eq checkpoint (view-placements (find-view world "music"))))
            (is (equal '("emacs") (mapcar #'placement-client-id (view-placements (find-view world "code")))))
            (is (equal '("emacs") (presentation-client-ids source)))
            (is-false (presentation-unavailable-client-ids source))
            (is (validate-world world))
            (make-client-private-in-presentation world "terminal" (presentation-id target))
            (is (= (1+ revision) (world-revision world)))))))))

(test private-here-at-original-home-keeps-local-checkpoints-and-cleans-cached-guests
  (let ((world (make-fixture)))
    (set-client-shared world "terminal" t)
    (create-view world "music" "game" "Music" (placements "terminal" "game-client")
                 :focus-client-id "terminal")
    (let ((cached (activate-view-strictly world "right" "music")))
      (activate-view-strictly world "right" "browser")
      (let* ((target (activate-view-strictly world "left" "code"))
             (before (lime.core::copy-presentation target))
             (checkpoint (view-placements (find-view world "code"))))
        (make-client-private-in-presentation world "terminal" (presentation-id target))
        (is (equalp before target))
        (is (eq checkpoint (view-placements (find-view world "code"))))
        (is (equal "lime" (client-activity-id (find-client world "terminal"))))
        (is (equal '("game-client") (presentation-client-ids cached)))
        (is (equal "game-client" (presentation-focus-client-id cached)))
        (is (equal '("game-client") (mapcar #'placement-client-id (view-placements (find-view world "music")))))
        (is (validate-world world))))))

(test private-here-validates-before-committing-anything
  (let ((world (make-fixture)))
    (set-client-shared world "terminal" t)
    (create-view world "music" "game" "Music" (placements "terminal"))
    (let* ((target (activate-view-strictly world "right" "music"))
           (source (activate-view-partially world "left" "code"))
           (revision (world-revision world))
           (lease (lease-for-client world "terminal"))
           (checkpoint (view-placements (find-view world "code")))
           (old-source (lime.core::copy-presentation source))
           (old-target (lime.core::copy-presentation target)))
      (signals stale-transition-plan
        (make-client-private-in-presentation world "terminal" (presentation-id target) :expected-revision -1))
      (signals invalid-transition
        (make-client-private-in-presentation world "terminal" (presentation-id source)))
      (signals invalid-transition
        (make-client-private-in-presentation world "firefox" (presentation-id source)))
      (signals error
        (make-client-private-in-presentation world "terminal" (presentation-id target)
                                             :focus-direction (lambda (c) (declare (ignore c)) (error "bad policy"))))
      (is (= revision (world-revision world)))
      (is (eq lease (lease-for-client world "terminal")))
      (is (eq checkpoint (view-placements (find-view world "code"))))
      (is (equalp old-source source))
      (is (equalp old-target target))
      (is (client-shared-p (find-client world "terminal")))
      (is (equal "lime" (client-activity-id (find-client world "terminal"))))
      (activate-view-strictly world "right" "browser")
      (let ((revision (world-revision world)))
        (signals invalid-transition
          (make-client-private-in-presentation world "terminal" (presentation-id target)))
        (is (= revision (world-revision world))))
      (is (validate-world world)))))

(test revocation-is-atomic-if-a-focus-policy-fails
  (let ((world (make-fixture)))
    (set-client-shared world "terminal" t)
    (create-view world "music" "game" "Music" (placements "terminal"))
    (activate-view-strictly world "right" "music")
    (let ((revision (world-revision world)))
      (signals error
        (set-client-shared world "terminal" nil
                           :focus-direction (lambda (c) (declare (ignore c)) (error "bad policy"))))
      (is (= revision (world-revision world)))
      (is-true (client-shared-p (find-client world "terminal")))
      (is (equal "right" (lease-head-id world "terminal")))
      (is-true (validate-world world)))))