;;; mastodon-media-test.el --- Tests for mastodon-media.el  -*- lexical-binding: nil -*-

;; non interactive failures:
;; FAILED  mastodon-media--get-avatar-rendering
;; FAILED  mastodon-media--load-image-from-url-avatar-with-imagemagic
;; FAILED  mastodon-media--load-image-from-url-media-link-with-imagemagic
;; FAILED  mastodon-media--load-image-from-url-media-link-without-imagemagic
;; FAILED  mastodon-media--load-image-from-url-url-fetching-fails

(require 'el-mock)

(defmacro mastodon-media-with-mock-image-foo (&rest body)
  `(progn
     (if noninteractive
         (mock (create-image *
                             (when (version< emacs-version "27.1") 'imagemagick)
                             t) ;; props arg fails non-interactively
               => '(image foo))
       (mock (create-image *
                           (when (version< emacs-version "27.1") 'imagemagick)
                           t :height 123)
             => '(image foo)))
     ,@body))

(defmacro mastodon-media-mock-url-retrieve-process (&rest body)
  `(progn
     (if noninteractive
         (mock (url-retrieve
                "http://example.org/image.png"
                #'mastodon-media--process-image-response
                '("http://example.org/image.png" :my-marker
                  nil ;; props arg fails non-interactively
                  5))
               => :called-as-expected)
       (mock (url-retrieve
              "http://example.org/image.png"
              #'mastodon-media--process-image-response
              '("http://example.org/image.png" :my-marker
                (:max-height 321)
                5))
             => :called-as-expected))
     ,@body))

(ert-deftest mastodon-media--get-avatar-rendering ()
  "Should return text with all expected properties."
  (with-mock
    ;; (mock (image-type-available-p 'imagemagick) => t)
    (mastodon-media-with-mock-image-foo
     (let* ((mastodon-media--avatar-height 123)
            (result (mastodon-media--get-avatar-rendering "http://example.org/img.png"))
            (result-no-properties (substring-no-properties result))
            (properties (text-properties-at 0 result)))
       (should (string= "  " result-no-properties))
       (should (string= "http://example.org/img.png" (plist-get properties 'media-url)))
       (should (eq 'needs-loading (plist-get properties 'media-state)))
       (should (eq 'avatar (plist-get properties 'media-type)))
       (should (equal '(image foo)
                      (plist-get properties 'display)))))))

(ert-deftest mastodon-media--get-media-link-rendering ()
  "Should return text with all expected properties."
  (with-mock
    (mock (create-image * nil t) => :mock-image)
    (let* ((mastodon-media--preview-max-height 123)
           (result
            (mastodon-media--get-media-link-rendering "http://example.org/img.png"
                                        "http://example.org/remote/img.png"
                                        "image"))
           (result-no-properties (substring-no-properties result))
           (properties (text-properties-at 0 result)))
      (should (string= "[img] " result-no-properties))
      (should (string= "http://example.org/img.png" (plist-get properties 'media-url)))
      (should (eq 'needs-loading (plist-get properties 'media-state)))
      (should (eq 'media-link (plist-get properties 'media-type)))
      (should (eq :mock-image (plist-get properties 'display)))
      (should (eq 'highlight (plist-get properties 'mouse-face)))
      (should (eq 'image (plist-get properties 'mastodon-tab-stop)))
      (should (string= "http://example.org/remote/img.png" (plist-get properties 'image-url)))
      (should (eq mastodon-tl--shr-image-map-replacement (plist-get properties 'keymap)))
      (should (string= "image" (plist-get properties 'mastodon-media-type)))
      (should (string= "RET: load full image or play video, i for image options, S: toggle sensitive media"
                       (plist-get properties 'help-echo))))))

(ert-deftest mastodon-media:get-media-link-rendering-gif ()
  "Should return text with all expected properties."
  (with-mock
   (mock (create-image * nil t) => :mock-image)
   (let* ((mastodon-media--preview-max-height 123)
          (result
           (mastodon-media--get-media-link-rendering "http://example.org/img.png"
                                                     "http://example.org/remote/img.png"
                                                     "gifv"))
          (result-no-properties (substring-no-properties result))
          (properties (text-properties-at 0 result)))
     (should (string= "[img] " result-no-properties))
     (should (string= "http://example.org/img.png" (plist-get properties 'media-url)))
     (should (eq 'needs-loading (plist-get properties 'media-state)))
     (should (eq 'media-link (plist-get properties 'media-type)))
     (should (eq :mock-image (plist-get properties 'display)))
     (should (eq 'highlight (plist-get properties 'mouse-face)))
     (should (eq 'image (plist-get properties 'mastodon-tab-stop)))
     (should (string= "http://example.org/remote/img.png" (plist-get properties 'image-url)))
     (should (eq mastodon-tl--shr-image-map-replacement (plist-get properties 'keymap)))
     (should (string= "gifv" (plist-get properties 'mastodon-media-type)))
     (should (string= "RET: load full image or play video, i for image options, S: toggle sensitive media\nC-RET: play gifv with mpv"
                 (plist-get properties 'help-echo))))))

(ert-deftest mastodon-media--load-image-from-url-avatar-with-imagemagic ()
  "Should make the right call to url-retrieve."
  (let ((url "http://example.org/image.png")
        (mastodon-media--avatar-height 123))
    (with-mock
      ;; (mock (image-type-available-p 'imagemagick) => t)
      (mastodon-media-with-mock-image-foo
       (mock (copy-marker 7) => :my-marker)
       (if noninteractive
           (mock (url-retrieve
                  url
                  #'mastodon-media--process-image-response
                  `(,url :my-marker nil 1))
                 => :called-as-expected)
         (mock (url-retrieve
                url
                #'mastodon-media--process-image-response
                `(,url :my-marker (:height 123) 1))
               => :called-as-expected))
       (with-temp-buffer
         (insert (concat "Start:"
                         (mastodon-media--get-avatar-rendering "http://example.org/img.png")
                         ":rest"))
         (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1))))))))

(ert-deftest mastodon-media--load-image-from-url-avatar-without-imagemagic ()
  "Should make the right call to url-retrieve."
  (let ((url "http://example.org/image.png"))
    (with-mock
      ;; (mock (image-type-available-p 'imagemagick) => nil)
      ;; (mock (image-transforms-p) => nil)
      (mock (create-image * nil t) => '(image foo))
      (mock (copy-marker 7) => :my-marker )
      (mock (url-retrieve
             url
             #'mastodon-media--process-image-response
             `(,url :my-marker () 1))
            => :called-as-expected)
      (with-temp-buffer
        (insert (concat "Start:"
                        (mastodon-media--get-avatar-rendering "http://example.org/img.png")
                        ":rest"))

        (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'avatar 7 1)))))))

(ert-deftest mastodon-media--load-image-from-url-media-link-with-imagemagic ()
  "Should make the right call to url-retrieve."
  (let ((url "http://example.org/image.png"))
    (with-mock
      ;; (mock (image-type-available-p 'imagemagick) => t)
      (mock (create-image * nil t) => '(image foo))
      (mock (copy-marker 7) => :my-marker)
      (mastodon-media-mock-url-retrieve-process
       (with-temp-buffer
         (insert (concat "Start:"
                         (mastodon-media--get-media-link-rendering url)
                         ":rest"))
         (let ((mastodon-media--preview-max-height 321))
           (should (eq :called-as-expected
                       (mastodon-media--load-image-from-url url 'media-link 7 5)))))))))

(ert-deftest mastodon-media--load-image-from-url-media-link-without-imagemagic ()
  "Should make the right call to url-retrieve."
  (let ((url "http://example.org/image.png"))
    (with-mock
      ;; (mock (image-type-available-p 'imagemagick) => nil)
      ;; (mock (image-transforms-p) => nil)
      (if noninteractive
          (mock (create-image * nil t) ;; props arg fails non-interactively
                => '(image foo))
        (mock (create-image * nil t :height 20) => '(image foo)))
      (mock (copy-marker 7) => :my-marker)
      (mastodon-media-mock-url-retrieve-process
       (with-temp-buffer
         (insert (concat "Start:"
                         (mastodon-media--get-avatar-rendering url)
                         ":rest"))
         (let ((mastodon-media--preview-max-height 321))
           (should (eq :called-as-expected (mastodon-media--load-image-from-url url 'media-link 7 5)))))))))

(ert-deftest mastodon-media--load-image-from-url-url-fetching-fails ()
  "Should cope with failures in url-retrieve."
  (let ((url "http://example.org/image.png")
        (mastodon-media--avatar-height 123))
    (with-mock
      ;; (mock (image-type-available-p 'imagemagick) => t)
      (mastodon-media-with-mock-image-foo
       (stub url-retrieve => (error "url-retrieve failed"))
       (with-temp-buffer
         (insert (concat "Start:"
                         (mastodon-media--get-avatar-rendering "http://example.org/img.png")
                         ":rest"))

         (should (eq :loading-failed (mastodon-media--load-image-from-url url 'avatar 7 1)))
         ;; the media state was updated so we won't load this again:
         (should (eq 'loading-failed (get-text-property 7 'media-state))))))))

(ert-deftest mastodon-media--process-image-response ()
  "Should process the HTTP response and adjust the source buffer."
  (with-temp-buffer
    (with-mock
      (let ((source-buffer (current-buffer))
            used-marker
            saved-marker)
        (insert "start:")
        (setq used-marker (copy-marker (point))
              saved-marker (copy-marker (point)))
        ;; Mock needed for the preliminary image created in
        ;; mastodon-media--get-avatar-rendering
        (stub create-image => :fake-image)
        (insert (mastodon-media--get-avatar-rendering
                 "http://example.org/image.png.")
                ":end")
        (with-temp-buffer
          (insert "some irrelevant\n"
                  "http headers\n"
                  "which will be ignored\n\n"
                  "fake\nimage\ndata")
          (goto-char (point-min))

          (mock (create-image
                 "fake\nimage\ndata"
                 (when (version< emacs-version "27.1") 'imagemagick)
                 t ':image :option)
                => :fake-image)

          (mastodon-media--process-image-response
           () "http://example.org/image.png" used-marker '(:image :option) 1)

          ;; the used marker has been unset:
          (should (null (marker-position used-marker)))
          ;; the media-state has been set to loaded and the image is being displayed
          (should (eq 'loaded (get-text-property saved-marker 'media-state source-buffer)))
          (should (eq ':fake-image (get-text-property saved-marker 'display source-buffer))))))))

(ert-deftest mastodon-media--inline-images ()
  "Should process all media in buffer."
  (with-mock
    ;; Stub needed for the test setup:
    (stub create-image => '(image ignored))

    (let (marker-media-link marker-media-link-bad-url marker-false-media marker-avatar)
      (with-temp-buffer
        (insert "Some text before\n")
        (setq marker-media-link (copy-marker (point)))
        (insert (mastodon-media--get-media-link-rendering "http://example.org/i.jpg")
                " some more text ")
        (setq marker-media-link-bad-url (copy-marker (point)))
        (insert (mastodon-media--get-media-link-rendering "/files/small/missing.png")
                " some more text ")
        (setq marker-false-media (copy-marker (point)))
        (insert
         ;; text that looks almost like an avatar but lacks the media-url property
         (propertize "this won't be processed"
                     'media-state 'needs-loading
                     'media-type 'avatar)
         "even more text ")
        (setq marker-avatar (copy-marker (point)))
        (insert (mastodon-media--get-avatar-rendering "http://example.org/avatar.png")
                " end of text")
        (goto-char (point-min))

        ;; stub for the actual test:
        (stub mastodon-media--load-image-from-url)
        (mastodon-media--inline-images (point-min) (point-max))

        (should (eq 'loading (get-text-property marker-media-link 'media-state)))
        (should (eq 'invalid-url (get-text-property marker-media-link-bad-url 'media-state)))
        (should (eq 'loading (get-text-property marker-avatar 'media-state)))
        (should (eq 'needs-loading (get-text-property marker-false-media 'media-state)))))))
