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

(defun make-presentation-navigation-fixture ()
  (let ((w (make-world)))
    (dolist (id '("left" "right" "third")) (create-head w id))
    (dolist (id '("work" "chat" "other")) (create-activity w id id))
    (dolist (row '(("browser" "work") ("terminal" "work") ("discord" "chat")
                   ("hidden" "chat") ("shared" "chat")))
      (create-client w (first row) (second row)))
    (set-client-shared w "shared" t)
    (create-view w "work/code" "work" "Code" (placements "browser"))
    (create-view w "chat/chat" "chat" "Chat" (placements "discord" "shared"))
    (activate-view-strictly w "left" "work/code")
    (activate-view-strictly w "right" "chat/chat")
    w))

(test portable-arrangement-swaps-preserve-state-and-lease-identity
  (let* ((w (make-presentation-navigation-fixture))
         (work (current-presentation w "left")) (chat (current-presentation w "right"))
         (leases (mapcar (lambda (id) (lease-for-client w id)) '("browser" "discord" "shared")))
         (view-before (lime.core::%copy-placements (view-placements (find-view w "chat/chat")))))
    (set-presentation-layout-mode w (presentation-id chat) :monocle)
    (let ((report (preflight-presentation-bring w "left" (presentation-id chat)))
          (before (world-revision w)))
      (is (activation-report-ready-p report))
      (is (= before (world-revision w))))
    (bring-presentation-to-head w (presentation-id chat) "left")
    (is (eq chat (current-presentation w "left")))
    (is (eq work (current-presentation w "right")))
    (is (equal "left" (presentation-head-id chat)))
    (is (equal "right" (presentation-head-id work)))
    (is (eq :monocle (presentation-layout-mode chat)))
    (is (presentation-dirty-p chat))
    (is (equalp view-before (view-placements (find-view w "chat/chat"))))
    (is (null (lease-for-client w "hidden")))
    (loop for id in '("browser" "discord" "shared") for old in leases
          do (is (eq old (lease-for-client w id))))
    (dotimes (i 20)
      (bring-presentation-to-head w (presentation-id chat) (if (evenp i) "right" "left"))
      (is (validate-world w)))
    (let ((revision (world-revision w)))
      (bring-presentation-to-head w (presentation-id chat) "left")
      (is (= revision (world-revision w))))))

(test swaps-transpose-cached-extended-portions-without-erasing-them
  (let* ((w (make-presentation-navigation-fixture)) (chat (current-presentation w "right"))
         (work-left (current-presentation w "left")))
    (create-view w "work/logs" "work" "Logs" (placements "terminal"))
    (let ((work-right (activate-view-strictly w "right" "work/logs")))
      (resume-presentation-strictly w "right" (presentation-id chat))
      (bring-presentation-to-head w (presentation-id chat) "left")
      (is (eq work-left (current-presentation w "right")))
      (is (eq work-right (activity-draft-for-head w "work" "left")))
      (is (equal '("terminal") (presentation-client-ids work-right)))
      (is (equal "work/logs" (presentation-source-view-id work-right)))
      (is (null (lease-for-client w "terminal")))
      (is (validate-world w))
      (open-activity-draft w "left" "work")
      (is (eq work-right (current-presentation w "left")))
      (is (validate-world w)))))

(test inactive-portable-return-does-not-change-other-displays-or-recall-missing-slots
  (let* ((w (make-presentation-navigation-fixture)) (chat (current-presentation w "right")))
    (open-activity-draft w "right" "other")
    (let ((other (current-presentation w "right")))
      (bring-presentation-to-head w (presentation-id chat) "left")
      (is (eq other (current-presentation w "right")))
      (is (eq chat (current-presentation w "left")))
      (is (null (lease-for-client w "browser")))
      (is (null (lease-for-client w "hidden")))
      (is (validate-world w)))
    (let ((before (world-revision w)))
      (signals stale-transition-plan
        (bring-presentation-to-head w (presentation-id chat) "third" :expected-revision (1- before)))
      (signals unknown-entity (bring-presentation-to-head w (presentation-id chat) "missing"))
      (is (= before (world-revision w))))
    ;; A topology-suspended arrangement is still portable.
    (commit-head-topology-reconciliation-plan w
      (build-head-topology-reconciliation-plan
       (preflight-head-topology-reconciliation w '("right" "third"))))
    (is (null (presentation-head-id chat)))
    (bring-presentation-to-head w (presentation-id chat) "third")
    (is (eq chat (current-presentation w "third")))
    (is (validate-world w))))