From d6023ee0cb1c88dcf4c3854e738dc66c88da9e60 Mon Sep 17 00:00:00 2001 From: VictorHugoPilled Date: Sun, 15 Sep 2024 22:51:21 -0500 Subject: [PATCH] fix: Fixed spacing, parentheses and ran make check fix: Added compat and seq-positions --- test/verb-test.el | 670 +++++++++++++++++----------------------------- verb.el | 340 ++++++++++------------- 2 files changed, 386 insertions(+), 624 deletions(-) diff --git a/test/verb-test.el b/test/verb-test.el index b125a91..41e19b3 100644 --- a/test/verb-test.el +++ b/test/verb-test.el @@ -183,22 +183,30 @@ (with-temp-buffer (insert text-to-insert) (goto-char (point-min)) - (funcall test-function) - ) - - ) + (funcall test-function))) (defun assert-equal (actual expected) - (should (equal actual expected)) - ) + (should (equal actual expected))) (defun assert-user-error (test) - (should-error (funcall test) :type 'user-error) - ) + (should-error (funcall test) :type 'user-error)) + +(ert-deftest test-range-member-p () + (let* ((passing-test-one (cons 9 '((2 . 5) 9 (11 . 13)))) + (passing-test-two (cons 12 '((2 . 5) 9 (11 . 13)))) + (passing-tests (list passing-test-one passing-test-two)) + (failing-test-one (cons 1 '((2 . 5) 9 (11 . 13)))) + (failing-test-two (cons 15 '((2 . 5) 9 (11 . 13)))) + (failing-tests (list failing-test-one failing-test-two))) + (map-do (lambda (test-number test-range) + (should (range-member-p test-number test-range))) + passing-tests) + (map-do (lambda (test-number test-range) + (should-not (range-member-p test-number test-range))) + failing-tests))) (ert-deftest test-get-indices-of-inner-brace-pairs () - (let* ( - (test-line-one "get http://example.org/{{(+ 40 2)}}/") + (let* ((test-line-one "get http://example.org/{{(+ 40 2)}}/") (answer-one (list (cons 24 34))) (test-line-two "GET http://example.com/users/{{(+ 1 1)}}\n") (answer-two (list (cons 30 39))) @@ -212,104 +220,55 @@ (cons test-line-two answer-two) (cons test-line-three answer-three) (cons test-line-four answer-four) - (cons test-line-five answer-five) - ) - ) - - ) + (cons test-line-five answer-five)))) (map-do (lambda (test answer) - (assert-equal (verb--get-indices-of-inner-brace-pairs test) answer) - ) - test-cases) - ) - ) + (assert-equal (verb--get-indices-of-inner-brace-pairs test) answer)) + test-cases))) (ert-deftest test-is-within-code-tags-p () (cl-flet ( (test-runner (test-line test-indices test-answers) (seq-do-indexed (lambda (actual-index index-in-test-indices) - (assert-equal (verb--is-within-code-tags-p test-line actual-index) (nth index-in-test-indices test-answers)) - ) - test-indices) - ) - ) - (let* ( - (test-line-one "get http://example.org/{{(+ 40 2)}}/") - (test-indices-one (seq-positions test-line-one (string-to-char "\s"))) - (test-answers-one (list nil 't 't)) - (test-line-two "POST http://hello.com/{{(funcall inc-counter)}}/{{(+ 1 1)}}") - (test-indices-two (seq-positions test-line-two (string-to-char "1"))) - (test-answers-two (list 't 't)) - ) - + (assert-equal (verb--is-within-code-tags-p test-line actual-index) (nth index-in-test-indices test-answers))) + test-indices))) + (let* ((test-line-one "get http://example.org/{{(+ 40 2)}}/") + (test-indices-one (seq-positions test-line-one (string-to-char "\s"))) + (test-answers-one (list nil 't 't)) + (test-line-two "POST http://hello.com/{{(funcall inc-counter)}}/{{(+ 1 1)}}") + (test-indices-two (seq-positions test-line-two (string-to-char "1"))) + (test-answers-two (list 't 't))) (test-runner test-line-one test-indices-one test-answers-one) - (test-runner test-line-two test-indices-two test-answers-two) - - ) - - ) - - ) + (test-runner test-line-two test-indices-two test-answers-two)))) (ert-deftest test-split-line-on-spaces-outside-code-tags () - (let* ( - (test-one "get http://www.gnu.org http/1.1") - (answer-one (list "get" "http://www.gnu.org" "http/1.1")) - (test-two "get http://example.com") - (answer-two (list "get" "http://example.com")) - (test-three "get http://example.org/{{(+ 40 2)}}/") - (answer-three (list "get" "http://example.org/{{(+ 40 2)}}/")) - (test-four "POST http://hello.com/{{(funcall inc-counter)}}/{{(+ 1 1)}} http/1.0") - (answer-four (list "POST" "http://hello.com/{{(funcall inc-counter)}}/{{(+ 1 1)}}" "http/1.0")) - (tests (list - (cons (verb--split-line-on-spaces-outside-code-tags test-one) answer-one) - (cons (verb--split-line-on-spaces-outside-code-tags test-two) answer-two) - (cons (verb--split-line-on-spaces-outside-code-tags test-three) answer-three) - (cons (verb--split-line-on-spaces-outside-code-tags test-four) answer-four) - ) - ) - - ) - - (map-do #'assert-equal tests) - ) - ) + (let* ((test-one "get http://www.gnu.org http/1.1") + (answer-one (list "get" "http://www.gnu.org" "http/1.1")) + (test-two "get http://example.com") + (answer-two (list "get" "http://example.com")) + (test-three "get http://example.org/{{(+ 40 2)}}/") + (answer-three (list "get" "http://example.org/{{(+ 40 2)}}/")) + (test-four "POST http://hello.com/{{(funcall inc-counter)}}/{{(+ 1 1)}} http/1.0") + (answer-four (list "POST" "http://hello.com/{{(funcall inc-counter)}}/{{(+ 1 1)}}" "http/1.0")) + (tests (list + (cons (verb--split-line-on-spaces-outside-code-tags test-one) answer-one) + (cons (verb--split-line-on-spaces-outside-code-tags test-two) answer-two) + (cons (verb--split-line-on-spaces-outside-code-tags test-three) answer-three) + (cons (verb--split-line-on-spaces-outside-code-tags test-four) answer-four)))) + (map-do #'assert-equal tests))) (ert-deftest test-get-line-in-buffer () - - - (cl-flet ( - (test-case-creator (test) + (cl-flet ((test-case-creator (test) (cons test (lambda () - (apply #'assert-equal (list (apply #'verb--get-line-in-buffer '(current-context)) test)) - )) - ) - ) - (let* ( - (test-one "#+begin_src verb") + (apply #'assert-equal (list (apply #'verb--get-line-in-buffer '(current-context)) test)))))) + (let* ((test-one "#+begin_src verb") (test-two "template http://localhost:8000/basic") - (test-three "#+end_src") + (test-three "#+end_src") (tests (list test-one test-two test-three)) - (test-cases (mapcar #'test-case-creator tests)) - ) - - (map-do #'test-temp-buffer-creator test-cases) - - ) - - - - - ) - ) + (test-cases (mapcar #'test-case-creator tests))) + (map-do #'test-temp-buffer-creator test-cases)))) - - - -(ert-deftest test-validate-http-method () - - (let* ( - (passing-test-one "GET") +(ert-deftest test-validate-http-method () + (let* ((passing-test-one "GET") (passing-answer-one "GET") (passing-test-two "POST") (passing-answer-two "POST") @@ -320,37 +279,24 @@ (passing-tests (list (cons (verb--validate-http-method passing-test-one) passing-answer-one) (cons (verb--validate-http-method passing-test-two) passing-answer-two) (cons (verb--validate-http-method passing-test-three) passing-answer-three) - (cons (verb--validate-http-method passing-test-four) passing-answer-four) - ) - ) - - (error-test-one "TEST") - (error-test-two "TEST") - (error-test-three "") - (error-test-four nil) - (errors (list error-test-three error-test-four)) - (error-tests (mapcar (lambda (err) - (lambda () - (verb--validate-http-method err) - )) - errors)) - (failing-test-one verb--template-keyword) - ) - - - (map-do #'assert-equal passing-tests) + (cons (verb--validate-http-method passing-test-four) passing-answer-four))) + (error-test-one "TEST") + (error-test-two "TEST") + (error-test-three "") + (error-test-four nil) + (errors (list error-test-three error-test-four)) + (error-tests (mapcar (lambda (err) + (lambda () + (verb--validate-http-method err) + )) + errors)) + (failing-test-one verb--template-keyword)) + (map-do #'assert-equal passing-tests) (mapc #'assert-user-error error-tests) - (should-not (verb--validate-http-method failing-test-one)) - - ) - - - ) - + (should-not (verb--validate-http-method failing-test-one)))) (ert-deftest test-validate-http-protocol () - (let* ( - (passing-test-one "HTTP/0.9") + (let* ((passing-test-one "HTTP/0.9") (passing-answer-one "HTTP/0.9") (passing-test-two "HTTP/1.0") (passing-answer-two "HTTP/1.0") @@ -361,85 +307,58 @@ (passing-tests (list (cons (verb--validate-http-protocol passing-test-one) passing-answer-one) (cons (verb--validate-http-protocol passing-test-two) passing-answer-two) (cons (verb--validate-http-protocol passing-test-three) passing-answer-three) - (cons (verb--validate-http-protocol passing-test-four) passing-answer-four) - ) - ) + (cons (verb--validate-http-protocol passing-test-four) passing-answer-four))) (error-test-one "http/1.7") (error-test-two "HTTP/1.") (error-test-three "ht") - (errors (list error-test-one error-test-two error-test-three)) + (errors (list error-test-one error-test-two error-test-three)) (error-tests (mapcar (lambda (err) (lambda () - (verb--validate-http-protocol err) - ) - ) - errors) - ) + (verb--validate-http-protocol err))) + errors)) (empty-test-one nil) (empty-test-two nil) (empties (list empty-test-one empty-test-two)) (empty-tests (mapcar (lambda (empty) - (verb--validate-http-protocol empty) - ) - empties) - ) - ) + (verb--validate-http-protocol empty)) + empties))) (map-do #'assert-equal passing-tests) (mapc #'assert-user-error error-tests) (should-not empty-test-one) - (should-not empty-test-two) - ) - - ) + (should-not empty-test-two))) (ert-deftest test-single-line-method-url-protocol () - (let* ( - (passing-test-one "get http://www.gnu.org http/1.1") - (passing-answer-one (list "GET" "http://www.gnu.org" "HTTP/1.1")) - (passing-test-two "get http://example.com") - (passing-answer-two (list "GET" "http://example.com")) - (passing-test-three "post") - (passing-answer-three (list "POST")) - (passing-test-four "put") - (passing-answer-four (list "PUT")) - (passing-tests (list - (cons (verb--single-line-method-url-protocol passing-test-one) passing-answer-one) - (cons (verb--single-line-method-url-protocol passing-test-two) passing-answer-two) - (cons (verb--single-line-method-url-protocol passing-test-three) passing-answer-three) - (cons (verb--single-line-method-url-protocol passing-test-four) passing-answer-four) - ) - ) - - (error-test-one "ge http://www.gnu.org http/1.1") - (error-test-two "get http://www.gnu.org http/99") - (errors (list error-test-one)) - (error-tests (mapcar (lambda (err) - (lambda () - (verb--single-line-method-url-protocol err) - )) - errors)) - ) - - (map-do #'assert-equal passing-tests) - (mapc #'assert-user-error error-tests) - ) - - - ) - + (let* ((passing-test-one "get http://www.gnu.org http/1.1") + (passing-answer-one (list "GET" "http://www.gnu.org" "HTTP/1.1")) + (passing-test-two "get http://example.com") + (passing-answer-two (list "GET" "http://example.com")) + (passing-test-three "post") + (passing-answer-three (list "POST")) + (passing-test-four "put") + (passing-answer-four (list "PUT")) + (passing-tests (list + (cons (verb--single-line-method-url-protocol passing-test-one) passing-answer-one) + (cons (verb--single-line-method-url-protocol passing-test-two) passing-answer-two) + (cons (verb--single-line-method-url-protocol passing-test-three) passing-answer-three) + (cons (verb--single-line-method-url-protocol passing-test-four) passing-answer-four))) + (error-test-one "ge http://www.gnu.org http/1.1") + (error-test-two "get http://www.gnu.org http/99") + (errors (list error-test-one)) + (error-tests (mapcar (lambda (err) + (lambda () + (verb--single-line-method-url-protocol err))) + errors))) + (map-do #'assert-equal passing-tests) + (mapc #'assert-user-error error-tests))) (ert-deftest test-valid-multiline-method-url-protocol () (cl-flet ( (passing-test-case-creator (passing-test-case answer) (cons (car passing-test-case) (lambda () - (apply #'assert-equal (list (apply #'verb--multiline-method-url-protocol (list (cdr passing-test-case) (funcall 'verb--get-line-in-buffer '(current-context)))) answer)) - ) - ) - ) - - ) - (let* ( - (starting-url "http://example.com/?") + (apply #'assert-equal (list (apply #'verb--multiline-method-url-protocol + (list (cdr passing-test-case) (funcall 'verb--get-line-in-buffer '(current-context)))) + answer)))))) + (let* ((starting-url "http://example.com/?") (passing-test-one (cons (join-lines "get http://example.com?\\" "a=b http/0.9") starting-url)) (passing-answer-one (list "http://example.com/?a=b" "HTTP/0.9")) @@ -455,59 +374,37 @@ (passing-answer-three (list "http://example.com/?a=b&c=d" "HTTP/2")) (passing-test-four (cons (join-lines "POST http://example.com?\\" "a=b") - starting-url)) + starting-url)) (passing-answer-four (list "http://example.com/?a=b")) (passing-test-five (cons (join-lines "get http://example.com?\\" " a=b http/1.0" ) - starting-url)) + starting-url)) (passing-answer-five (list "http://example.com/?a=b")) (passing-test-six (cons (join-lines "get http://example.com?\\" " a=b&\\" "\t\t\t\tc=d") - starting-url)) + starting-url)) (passing-answer-six (list "http://example.com/?a=b&c=d")) (passing-tests (list - (cons passing-test-three passing-answer-three) - ) - ) - (passing-test-cases (map-apply #'passing-test-case-creator passing-tests)) - - - ) - (map-do #'test-temp-buffer-creator passing-test-cases) - - ) - - - ) -) - + (cons passing-test-three passing-answer-three))) + (passing-test-cases (map-apply #'passing-test-case-creator passing-tests))) + (map-do #'test-temp-buffer-creator passing-test-cases)))) (ert-deftest test-get-invalid-multiline-method-url-protocol () (cl-flet ( - (failing-test-creator (test starting-url) - (cons test (lambda () - (assert-user-error (lambda () - (apply #'verb--multiline-method-url-protocol (list starting-url (funcall #'verb--get-line-in-buffer '(current-context)))) - ) - ) - )) - ) - ) - (let* ( - (starting-url "http://example.com/?") + (failing-test-creator (test starting-url) + (cons test (lambda () + (assert-user-error (lambda () + (apply #'verb--multiline-method-url-protocol + (list starting-url (funcall #'verb--get-line-in-buffer '(current-context)))))))))) + (let* ((starting-url "http://example.com/?") (failing-test-one (cons "get http://example.com?\\" starting-url)) (failing-test-two (cons (join-lines "get http://example.com?\\" "foobar\\") starting-url)) (failing-test-three (cons (join-lines "get http://example.com?\\" " ") starting-url)) (failing-tests (list failing-test-one failing-test-two failing-test-three)) - - (failing-test-cases (map-apply #'failing-test-creator failing-tests)) - ) - (map-do #'test-temp-buffer-creator failing-test-cases)) - - ) - ) + (failing-test-cases (map-apply #'failing-test-creator failing-tests))) + (map-do #'test-temp-buffer-creator failing-test-cases)))) (ert-deftest test-request-spec-from-hierarchy-babel-blocks-above () (setq tgt-spec (verb-request-spec :method "GET" @@ -565,15 +462,12 @@ (org-mode) (verb-mode) (insert outline-test) - (should-error (verb--request-spec-from-hierarchy)))) - ) - (let* ( - (tgt-spec + (should-error (verb--request-spec-from-hierarchy))))) + (let* ((tgt-spec (verb-request-spec :method "GET" :url (verb--clean-url "http://hello.com") - :protocol "HTTP/1.1" - )) + :protocol "HTTP/1.1")) (passing-test-one (join-lines "* Test :verb:" "#+begin_src verb" @@ -595,19 +489,10 @@ "print('hellooooo')" "#+end_src" "** Test2" - "get")) - - ) - + "get"))) (map-do (lambda (passing-test-case answer) (test-1 passing-test-case answer)) passing-test-cases) - - (test-2 failing-test-one)) - - - ) - -) + (test-2 failing-test-one)))) (ert-deftest test-request-spec-from-hierarchy-ignore-nontagged () (setq test-rs (verb-request-spec :method "GET" @@ -637,8 +522,7 @@ (verb-mode) (insert outline-test) (should (equal (verb--request-spec-from-hierarchy) test-rs))))) - (let* ( - (test-rs (verb-request-spec :method "GET" + (let* ((test-rs (verb-request-spec :method "GET" :url (verb--clean-url "http://hello.com") :protocol "HTTP/1.1" )) @@ -653,12 +537,8 @@ ":END:" "template http://hello.com http/1.1" "*** Test2" - "get")) - ) - (test-1 outline-test test-rs)) - ) - - ) + "get"))) + (test-1 outline-test test-rs)))) (ert-deftest test-request-spec-from-hierarchy-no-headings () (setq outline-test @@ -747,66 +627,48 @@ (insert outline-test) (should-error (verb--request-spec-from-hierarchy)))) - (ert-deftest test-request-spec-with-protocol-from-hierarchy () - (cl-flet ( - (test-1 (outline-test tgt-spec) +(ert-deftest test-request-spec-with-protocol-from-hierarchy () + (cl-flet ( + (test-1 (outline-test tgt-spec) (with-temp-buffer - (org-mode) - (verb-mode) - (insert outline-test) - (should (equal (verb--request-spec-from-hierarchy) - tgt-spec))) - ) - (test-2 (outline-test) - (with-temp-buffer - (org-mode) - (verb-mode) - (insert outline-test) - (should-error (verb--request-spec-from-hierarchy))) - - ) - - ) - (let* ( - (passing-test-1 + (org-mode) + (verb-mode) + (insert outline-test) + (should (equal (verb--request-spec-from-hierarchy) + tgt-spec))) + ) + (test-2 (outline-test) + (with-temp-buffer + (org-mode) + (verb-mode) + (insert outline-test) + (should-error (verb--request-spec-from-hierarchy))))) + (let* ((passing-test-1 (join-lines "* Test :verb:" "template http://hello.com http/1.1" "** Test2" "get")) - (tgt-spec-1 (verb-request-spec :method "GET" - :url (verb--clean-url - "http://hello.com") - :protocol "HTTP/1.1" - ) - ) - (passing-test-2 - (join-lines "foo bar" - "* Test :verb:" - "template http://hello.com http/1.1" - "** Test2" - "post ?a=b")) - - (tgt-spec-2 (verb-request-spec :method "POST" - :url (verb--clean-url - "http://hello.com?a=b") - :protocol "HTTP/1.1" - ) - ) - (passing-test-cases (list (cons passing-test-1 tgt-spec-1) (cons passing-test-2 tgt-spec-2))) - (failing-test-1 - (join-lines "* Test :verb:" - "template http://hello.com http/1.1")) - - ) - - (map-do (lambda (passing-test-case answer) (test-1 passing-test-case answer)) - passing-test-cases) - - (test-2 failing-test-1)) - - ) - - ) + (tgt-spec-1 (verb-request-spec :method "GET" + :url (verb--clean-url + "http://hello.com") + :protocol "HTTP/1.1")) + (passing-test-2 + (join-lines "foo bar" + "* Test :verb:" + "template http://hello.com http/1.1" + "** Test2" + "post ?a=b")) + (tgt-spec-2 (verb-request-spec :method "POST" + :url (verb--clean-url + "http://hello.com?a=b") + :protocol "HTTP/1.1")) + (passing-test-cases (list (cons passing-test-1 tgt-spec-1) (cons passing-test-2 tgt-spec-2))) + (failing-test-1 + (join-lines "* Test :verb:" + "template http://hello.com http/1.1"))) + (map-do (lambda (passing-test-case answer) (test-1 passing-test-case answer)) + passing-test-cases) + (test-2 failing-test-1)))) (ert-deftest test-request-spec-from-hierarchy-metadata () (with-temp-buffer @@ -1221,93 +1083,63 @@ (cons "Referer" "host.com"))))) (ert-deftest test-request-spec-from-text-with-protocol-headers () - (let* ( - (test-one (text-as-spec "GET example.com http/1.1\n" - "Accept: text")) - (answer-one (list (cons "Accept" "text") - )) - (test-two (text-as-spec "GET example.com http/1.1\n" - "A:\n" - "B:")) - (answer-two (list (cons "A" "") - (cons "B" "")) - ) - (test-three (text-as-spec "GET example.com http/1.1\n" - "Accept: text\n")) - (answer-three (list (cons "Accept" "text")) - ) - (test-four (text-as-spec "GET example.com http/1.1\n" - "Foo-Bar: text\n" - "Referer: host.com\n")) - (answer-four (list (cons "Foo-Bar" "text") - (cons "Referer" "host.com")) - ) - (test-cases (list (cons test-one answer-one) - (cons test-two answer-two) - (cons test-three answer-three) - (cons test-four answer-four) - )) - - ) - (map-do (lambda (test-case answer) (should (equal (oref test-case :headers) - answer) - ) - ) - test-cases) - ) - ) + (let* ((test-one (text-as-spec "GET example.com http/1.1\n" + "Accept: text")) + (answer-one (list (cons "Accept" "text"))) + (test-two (text-as-spec "GET example.com http/1.1\n" + "A:\n" + "B:")) + (answer-two (list (cons "A" "") + (cons "B" ""))) + (test-three (text-as-spec "GET example.com http/1.1\n" + "Accept: text\n")) + (answer-three (list (cons "Accept" "text"))) + (test-four (text-as-spec "GET example.com http/1.1\n" + "Foo-Bar: text\n" + "Referer: host.com\n")) + (answer-four (list (cons "Foo-Bar" "text") + (cons "Referer" "host.com"))) + (test-cases (list (cons test-one answer-one) + (cons test-two answer-two) + (cons test-three answer-three) + (cons test-four answer-four)))) + (map-do (lambda (test-case answer) (should (equal (oref test-case :headers) + answer))) + test-cases))) (ert-deftest test-request-spec-from-text-protocol () - (let* ( - (test-one (text-as-spec "post example.com http/1.1")) - (test-two (text-as-spec "post example.com HTTP/1.1")) - (test-three (text-as-spec "post example.com hTTP/1.1")) - (test-four (text-as-spec "POST example.com htTP/1.1")) - (answer "HTTP/1.1") - (test-cases (list (cons test-one answer) - (cons test-two answer) - (cons test-three answer) - (cons test-four answer) - ) - ) - ) - - (map-do (lambda (test-case answer) (should (string= (oref test-case :protocol) answer))) - test-cases) - ) - - ) + (let* ((test-one (text-as-spec "post example.com http/1.1")) + (test-two (text-as-spec "post example.com HTTP/1.1")) + (test-three (text-as-spec "post example.com hTTP/1.1")) + (test-four (text-as-spec "POST example.com htTP/1.1")) + (answer "HTTP/1.1") + (test-cases (list (cons test-one answer) + (cons test-two answer) + (cons test-three answer) + (cons test-four answer)))) + (map-do (lambda (test-case answer) (should (string= (oref test-case :protocol) answer))) + test-cases))) (ert-deftest test-request-spec-from-multiline-text-with-protocol () - (let* ( - (test-case-one (text-as-spec "GET https://example.com http/1.1")) - - (test-case-two (text-as-spec "GET https://example.com http/1.1\n")) - - (test-case-three (text-as-spec "# Comment\n" - "\n" - "GET https://example.com http/1.1")) - (test-case-four (text-as-spec "\n" - " # hello\n" - "\n" - "GET https://example.com http/1.1")) - (answer (cons "https://example.com" "HTTP/1.1")) - (test-cases (list (cons test-case-one answer) - (cons test-case-two answer) - (cons test-case-three answer) - (cons test-case-four answer) - ) - ) - ) - - (map-do (lambda (test-case answers) - (should (string= (verb-request-spec-url-to-string test-case) - (car answers))) - (should (string= (oref test-case :protocol) (cdr answers))) - ) - test-cases) - ) - ) + (let* ((test-case-one (text-as-spec "GET https://example.com http/1.1")) + (test-case-two (text-as-spec "GET https://example.com http/1.1\n")) + (test-case-three (text-as-spec "# Comment\n" + "\n" + "GET https://example.com http/1.1")) + (test-case-four (text-as-spec "\n" + " # hello\n" + "\n" + "GET https://example.com http/1.1")) + (answer (cons "https://example.com" "HTTP/1.1")) + (test-cases (list (cons test-case-one answer) + (cons test-case-two answer) + (cons test-case-three answer) + (cons test-case-four answer)))) + (map-do (lambda (test-case answers) + (should (string= (verb-request-spec-url-to-string test-case) + (car answers))) + (should (string= (oref test-case :protocol) (cdr answers)))) + test-cases))) (ert-deftest test-request-spec-from-text-url-backslash () (setq aux (text-as-spec-nl "get http://example.com?\\" @@ -1336,29 +1168,24 @@ " "))) (ert-deftest test-request-spec-from-text-url-backslash-with-protocol () - (let* ( - (passing-test-one (text-as-spec-nl "get http://example.com?\\" - "a=b http/1.1")) - (answer-one "http://example.com/?a=b") - (passing-test-two (text-as-spec-nl "get http://example.com?\\" - " a=b http/1.1")) - (answer-two "http://example.com/?a=b") - (passing-test-three (text-as-spec-nl "get http://example.com?\\" - " a=b&\\" - "\t\t\t\tc=d http/1.1")) - (answer-three "http://example.com/?a=b&c=d") - (passing-test-cases (list (cons passing-test-one answer-one) - (cons passing-test-two answer-two) - (cons passing-test-three answer-three) - )) - - ) - - (map-do (lambda (passing-test-case answer) (should (string= (verb-request-spec-url-to-string passing-test-case) - answer))) - passing-test-cases) - ) - ) + (let* ( + (passing-test-one (text-as-spec-nl "get http://example.com?\\" + "a=b http/1.1")) + (answer-one "http://example.com/?a=b") + (passing-test-two (text-as-spec-nl "get http://example.com?\\" + " a=b http/1.1")) + (answer-two "http://example.com/?a=b") + (passing-test-three (text-as-spec-nl "get http://example.com?\\" + " a=b&\\" + "\t\t\t\tc=d http/1.1")) + (answer-three "http://example.com/?a=b&c=d") + (passing-test-cases (list (cons passing-test-one answer-one) + (cons passing-test-two answer-two) + (cons passing-test-three answer-three) + ))) + (map-do (lambda (passing-test-case answer) (should (string= (verb-request-spec-url-to-string passing-test-case) + answer))) + passing-test-cases))) (ert-deftest test-request-spec-from-text-body-trailing-chars () (setq aux (text-as-spec-nl "GET example.com" @@ -1662,8 +1489,7 @@ (should (string= (oref aux :body) "Content\n"))) (ert-deftest test-request-spec-from-text-with-protocol-complete () - (let ( - (test-one (text-as-spec "# Comment\n" + (let ((test-one (text-as-spec "# Comment\n" " #\n" " # \n" " # test \n" @@ -1677,8 +1503,7 @@ "Example: HeaderValue \n" " Referer :host\n" "\n" - "Content\n")) - ) + "Content\n"))) (should (string= (verb-request-spec-url-to-string test-one) "http://example.com/foobar")) (should (string= (oref test-one :method) "POST")) @@ -1689,8 +1514,7 @@ (cons "Quux" "Quuz") (cons "Example" "HeaderValue") (cons "Referer" "host")))) - (should (string= (oref test-one :body) "Content\n"))) - ) + (should (string= (oref test-one :body) "Content\n")))) (ert-deftest test-request-spec-headers-underscore () (setq aux (text-as-spec "get http://example.com/foobar\n" @@ -2481,18 +2305,12 @@ (should-not (verb--http-method-p "test"))) (ert-deftest test-http-protocol-p () - (let ( - (true-test-cases (list "HTTP/0.9" "HTTP/1.0" "HTTP/1.1" "HTTP/2" "HTTP/3")) - (false-test-cases (list "test" "HTT 0.9" "HTTP 5" "ttp 1.1")) - ) - + (let ((true-test-cases (list "HTTP/0.9" "HTTP/1.0" "HTTP/1.1" "HTTP/2" "HTTP/3")) + (false-test-cases (list "test" "HTT 0.9" "HTTP 5" "ttp 1.1"))) (mapc (lambda (test-case) (should (verb--http-protocol-p test-case))) true-test-cases) (mapc (lambda (test-case) (should-not (verb--http-protocol-p test-case))) - false-test-cases) - - ) - ) + false-test-cases))) (ert-deftest test-disable-verb-mode-font-lock () (with-temp-buffer @@ -3189,17 +3007,12 @@ "POST http://abc.com")))) (ert-deftest test-protocol-as-curl-option () - (let ( - (tests (list "HTTP/0.9" "HTTP/1.0" "HTTP/1.1" "HTTP/2" "HTTP/3")) - (answers (list "--http0.9" "--http1.0" "--http1.1" "--http2" "--http3")) - ) + (let ((tests (list "HTTP/0.9" "HTTP/1.0" "HTTP/1.1" "HTTP/2" "HTTP/3")) + (answers (list "--http0.9" "--http1.0" "--http1.1" "--http2" "--http3"))) (seq-do-indexed (lambda (test index) - (should (equal (verb--protocol-as-curl-option test) (nth index answers))) - ) + (should (equal (verb--protocol-as-curl-option test) (nth index answers)))) tests) - (should-error (verb--protocol-as-curl-option "HTTP/1.7") :type 'user-error) - ) - ) + (should-error (verb--protocol-as-curl-option "HTTP/1.7") :type 'user-error))) (defun should-curl (rs-text &rest lines) (should (string= (verb--export-to-curl @@ -3267,7 +3080,8 @@ (should-error (verb--export-to-curl (verb-request-spec-from-string - "GET http://abc.com http/1.9")) :type 'user-error) + "GET http://abc.com http/1.9")) + :type 'user-error) (should-error (verb--export-to-curl (verb-request-spec-from-string diff --git a/verb.el b/verb.el index 660c38d..64da982 100644 --- a/verb.el +++ b/verb.el @@ -7,7 +7,7 @@ ;; Homepage: https://github.com/federicotdn/verb ;; Keywords: tools ;; Package-Version: 2.16.0 -;; Package-Requires: ((emacs "26.3")) +;; Package-Requires: ((emacs "26.3") (compat "30.0.0.0")) ;; This file is NOT part of GNU Emacs. @@ -306,8 +306,8 @@ no warning will be shown when loading Emacs Lisp external files." "List of valid HTTP methods.") (defconst verb--http-protocols - '("HTTP/0.9" "HTTP/1.0" "HTTP/1.1" "HTTP/2" "HTTP/3") - "List of valid HTTP protocols") + '("HTTP/0.9" "HTTP/1.0" "HTTP/1.1" "HTTP/2" "HTTP/3") + "List of valid HTTP protocols.") (defconst verb--bodyless-http-methods '("GET" "HEAD" "DELETE" "TRACE" "OPTIONS" "CONNECT") @@ -518,6 +518,7 @@ more details on how to use it." map) "Keymap for `verb-response-headers-mode'.") + (define-derived-mode verb-response-headers-mode special-mode "Verb[Headers]" "Major mode for displaying an HTTP response's headers." (font-lock-add-keywords @@ -530,7 +531,8 @@ more details on how to use it." (member m verb--http-methods)) (defun verb--http-protocol-p (protocol) - (member protocol verb--http-protocols)) + "Return non-nil if PROTOCOL is a valid HTTP protocol." + (member protocol verb--http-protocols)) (defun verb--alist-p (l) @@ -577,9 +579,9 @@ KEY and VALUE must be strings. KEY must not be the empty string." :type (or null url) :documentation "Request URL.") (protocol :initarg :protocol - :initform nil - :type (or null string) - :documentation "HTTP protocol.") + :initform nil + :type (or null string) + :documentation "HTTP protocol.") (headers :initarg :headers :initform () :type verb--http-headers-type @@ -1028,8 +1030,7 @@ all the request specs in SPECS, in the order they were passed in." ;; Override spec 1 with spec 2, and the result with spec ;; 3, then with 4, etc. (setq final-spec (verb-request-spec-override final-spec - spec))) - ) + spec)))) ;; Process and return. (verb--request-spec-post-process final-spec)) (user-error (concat "No request specifications found\n" @@ -1611,22 +1612,15 @@ If NO-KILL is non-nil, do not add the command to the kill ring." result))) (defun verb--protocol-as-curl-option (protocol) - "Return the corresponding curl option for - a given http protocol." - (unless (verb--http-protocol-p protocol) - (user-error "Please pass a valid http protocol") - ) - (let ( - (protocol-maps (list (cons "HTTP/0.9" "--http0.9") + "Return the corresponding curl option for a given http PROTOCOL." + (unless (verb--http-protocol-p protocol) + (user-error "Please pass a valid http protocol")) + (let ((protocol-maps (list (cons "HTTP/0.9" "--http0.9") (cons "HTTP/1.0" "--http1.0") (cons "HTTP/1.1" "--http1.1") (cons "HTTP/2" "--http2") - (cons "HTTP/3" "--http3") - )) - ) - - (alist-get protocol protocol-maps nil nil 'equal)) - ) + (cons "HTTP/3" "--http3")))) + (alist-get protocol protocol-maps nil nil 'equal))) (defun verb--export-to-curl (rs &optional no-message no-kill) "Export a request spec RS to curl format. @@ -1659,12 +1653,8 @@ non-nil, do not add the command to the kill ring." (insert "-X TRACE")) ("CONNECT" (user-error "%s" "CONNECT method not supported in curl format"))) - (when-let ( - (protocol (oref rs protocol)) - ) - (insert "\s" (verb--protocol-as-curl-option protocol) - ) - ) + (when-let ((protocol (oref rs protocol))) + (insert "\s" (verb--protocol-as-curl-option protocol))) (let ((result (verb--buffer-string-no-properties))) (unless no-kill (kill-new result)) @@ -2097,7 +2087,7 @@ loaded into." (verb-kill-all-response-buffers t)) (let* ((url (oref rs url)) - (url-request-method (verb--to-ascii (oref rs method))) + (url-request-method (verb--to-ascii (oref rs method))) (url-mime-accept-string (verb--get-accept-header (oref rs headers))) (url-request-extra-headers (verb--prepare-http-headers (oref rs headers))) @@ -2593,193 +2583,168 @@ and fragment component of a URL with no host or scheme defined." (define-error 'verb-empty-spec "Request specification has no contents.") +(cl-defgeneric verb--seq-positions (sequence elt &optional testfn) + "Return list of indices of SEQUENCE elements. +TESTFN is a two-argument function. +SEQUENCE is the first argument and ELT is the second. +TESTFN defaults to `equal'." + (let ((result '())) + (seq-do-indexed + (lambda (e index) + (when (funcall (or testfn #'equal) e elt) + (push index result))) + sequence) + (nreverse result))) + +(defun verb--range-member-p (number ranges) + "Say whether NUMBER is in RANGES." + (if (not (listp (cdr ranges))) + (and (>= number (car ranges)) + (<= number (cdr ranges))) + (let ((not-stop t)) + (while (and ranges + (if (numberp (car ranges)) + (>= number (car ranges)) + (>= number (caar ranges))) + not-stop) + (when (if (numberp (car ranges)) + (= number (car ranges)) + (and (>= number (caar ranges)) + (<= number (cdar ranges)))) + (setq not-stop nil)) + (setq ranges (cdr ranges))) + (not not-stop)))) (defun verb--get-indices-of-inner-brace-pairs (line) - "Find each set of braces and then get - the indices of the inner brace pair. - A list of lists with the indices of each - inner brace pair is returned." - (cl-flet* ( - (get-pairs (seq) - (seq-partition seq 2) - ) + "Get the indices of each inner brace pair in a LINE. +A list of lists with the indices of each inner brace pair is returned." + (cl-flet* ((get-pairs (seq) + (seq-partition seq 2)) (get-inner-brace-indices (brace) - (let* ( - (braces (seq-positions line (string-to-char brace))) + (let* ((braces (verb--seq-positions line (string-to-char brace))) (brace-pairs (get-pairs braces)) - (brace-indices (flatten-list (mapcar #'cdr brace-pairs))) - ) - brace-indices) - ) - - ) - (let* ( - - (front-indices (get-inner-brace-indices "{")) - (back-indices (get-inner-brace-indices "}")) + (brace-indices (flatten-tree (mapcar #'cdr brace-pairs)))) + brace-indices))) + (let* ((front-indices (get-inner-brace-indices "{")) + (back-indices (get-inner-brace-indices "}")) (brace-pairs (seq-map-indexed (lambda (front index) - (cons front (nth index back-indices)) - ) - front-indices) - ) - ) - brace-pairs) - ) - ) + (cons front (nth index back-indices))) + front-indices))) + brace-pairs))) (defun verb--is-within-code-tags-p (line index) - "Returns t if the index of a given line is - within a code tag and nil otherwise." - (let ( - (is-within nil) - ) + "Return t if the INDEX of a given LINE is within a code tag. +Return nil otherwise." + (let ((is-within nil)) (when (seq-contains-p line (string-to-char "{")) - (let* ( - (brace-indices (verb--get-indices-of-inner-brace-pairs line)) + (let* ((brace-indices (verb--get-indices-of-inner-brace-pairs line)) (bools (mapcar (lambda (range) - (range-member-p index range)) - brace-indices) - ) - ) - (setq is-within (seq-contains-p bools 't)) - ) - is-within) - - ) - ) + (verb--range-member-p index range)) + brace-indices))) + (setq is-within (seq-contains-p bools 't))) + is-within))) (defun verb--split-line-on-spaces-outside-code-tags (line) - "Split a line on each space - that is not apart of a code tag and return a - the result as a list." - (cl-flet* ( - (get-space-indices (line) - "Get Indices of each space" - (seq-positions line (string-to-char "\s")) - ) + "Split LINE on each space outside of a code tag. +Return the result as a list." + (cl-flet* ((get-space-indices (line) + "Get indices of each space" + (verb--seq-positions line (string-to-char "\s"))) (filter-spaces-in-code-tags (line) "Filter for spaces in code tags" - (seq-remove (lambda (space-index) - (verb--is-within-code-tags-p line space-index) - ) (get-space-indices line)) - ) - + (seq-remove (lambda (space-index) + (verb--is-within-code-tags-p line space-index)) + (get-space-indices line))) (get-line-splits (line &optional splits) "Since METHOD+URL+PROTOCOL is three parts only take the first three spaces" - (let ((take-count (or splits 3)) - ) - (take take-count (filter-spaces-in-code-tags line)) - ) - ) + (let ((take-count (or splits 3))) + (take take-count (filter-spaces-in-code-tags line)))) (mark-valid-spaces (line) "Mark valid spaces with a ^" - (mapc (lambda (index) - (aset line index ?^) - ) - (get-line-splits line)) - line) + (mapc (lambda (index) + (aset line index ?^)) + (get-line-splits line)) + line) (cleanup-line (line) "Trim the line and replace any double spaces with a single space" - (replace-regexp-in-string "[[:space:]]\\{2,\\}" "\s" (string-trim line))) + (replace-regexp-in-string + "[[:space:]]\\{2,\\}" "\s" (string-trim line))) (split-line (line) "Split the line into a list" - (string-split (mark-valid-spaces (cleanup-line line)) "\\^") - ) - ) - - (split-line line)) - - ) + (string-split (mark-valid-spaces (cleanup-line line)) "\\^"))) + (split-line line))) + (defun verb--get-line-in-buffer (buffer) - "Return a line from a given buffer. - First, all code tags are expanded on it (if any)" - (verb--eval-code-tags-in-string - (buffer-substring-no-properties - (point) (line-end-position)) - buffer) - - ) - + "Return a line from a given BUFFER. +First, all code tags are expanded on it (if any)" + (verb--eval-code-tags-in-string + (buffer-substring-no-properties + (point) (line-end-position)) + buffer)) (defun verb--validate-http-method (method) - "Check if a given method is a valid method or - or a template. If the method is valid, it is - simply returned. If the method is a template, - method is set to nil then returned. Otherwise, - an error is thrown." + "Check if a given METHOD is a valid method or a template. +If the METHOD is valid, it is simply returned. +If the method is a template, method is set to nil then returned. +Otherwise,an error is thrown." (when method (setq method (upcase method))) (pcase method ((pred verb--http-method-p) method) ((pred (string= verb--template-keyword)) (setq method nil)) (_ (user-error (concat "Could not read a valid HTTP method (%s)\n" - "Additionally, you can also specify %s " - "(matching is case insensitive)") - (mapconcat #'identity verb--http-methods ", ") - verb--template-keyword)) - - ) + "Additionally, you can also specify %s " + "(matching is case insensitive)") + (mapconcat #'identity verb--http-methods ", ") + verb--template-keyword))) method) (defun verb--validate-http-protocol (protocol) - "Check if a given protocol is a valid protocol. - If the protocol is valid, it is simply returned. - If nothing is passed at all, protocol is set to nil and returned. - If an invalid protocol is passed, an error is thrown." + "Check if a given PROTOCOL is a valid protocol. +If the PROTOCOL is valid, it is simply returned. +If nothing is passed at all, protocol is set to nil and returned. +If an invalid protocol is passed, an error is thrown." (when protocol (setq protocol (upcase protocol))) (pcase protocol ((pred verb--http-protocol-p) protocol) ((pred (lambda (p) (= (length p) 0))) (setq protocol nil)) (_ (user-error (concat "Could not read a valid HTTP protocol. - The following are valid protocols: (%s)\n" - "Matching is case insensitive.") - (mapconcat #'identity verb--http-protocols ", ") - )) - - ) + The following are valid protocols: (%s)\n" + "Matching is case insensitive.") + (mapconcat #'identity verb--http-protocols ", ")))) + protocol) (defun verb--single-line-method-url-protocol (line) - "Returns a list created by splitting the method+url+protocol - line into three parts. Method and protocol are validated - before the return statement while the url is returned as is." - (let* ( - (lines (verb--split-line-on-spaces-outside-code-tags line)) - (function-list (list #'verb--validate-http-method #'identity #'verb--validate-http-protocol)) - ) - + "Return a list created by splitting the LINE into three parts. +Method and protocol are validated before the return statement. +The url is always returned as is." + (let* ((lines (verb--split-line-on-spaces-outside-code-tags line)) + (function-list (list #'verb--validate-http-method + #'identity #'verb--validate-http-protocol))) (seq-map-indexed (lambda (element index) - (funcall (nth index function-list) element) - ) - lines) - ) - - ) - -(defun verb--multiline-method-url-protocol (url line) - "If URL ends with '\', append following lines to it - until one of them does not end with '\' (ignoring - leading whitespace, for alignment). Finally a list - with the url and the protocol, if specified, is returned." - (while (string-suffix-p "\\" line) - (end-of-line) - (if (eobp) - (user-error - "Backslash in URL not followed by additional line") - (forward-char)) - (back-to-indentation) - (setq line (verb--get-line-in-buffer '(current-context))) - (when (string-empty-p line) - (user-error - "Backslash in URL not followed by additional content")) - (setq url (concat url (string-remove-suffix "\\" line)))) - + (funcall (nth index function-list) element)) + lines))) + +(defun verb--multiline-method-url-protocol (url current-line) + "If URL ends with '\', append the following lines. +Keep appending until the CURRENT-LINE does not end with '\'. +Ignore all leading whitespace for alignment. +A list with the url and the protocol, if specified, is returned." + (while (string-suffix-p "\\" current-line) + (end-of-line) + (if (eobp) + (user-error + "Backslash in URL not followed by additional line") + (forward-char)) + (back-to-indentation) + (setq current-line (verb--get-line-in-buffer '(current-context))) + (when (string-empty-p current-line) + (user-error + "Backslash in URL not followed by additional content")) + (setq url (concat url (string-remove-suffix "\\" current-line)))) (verb--split-line-on-spaces-outside-code-tags url)) - - - - (defun verb-request-spec-from-string (text &optional metadata) "Create and return a request specification from string TEXT. @@ -2810,7 +2775,7 @@ will be appended to it (ignoring its leading whitespace). The process is repeated as long as the current line ends with a backslash. PROTOCOL must be a protocol that is a member of the `verb--http-protocols' -set (that is, an HTTP protocol). Matching is case-insensitive. +set (that is, an HTTP protocol). Matching is case-insensitive. Each HEADER must be in the form of KEY: VALUE. KEY must be a nonempty string, VALUE can be the empty string. HEADER may also start with @@ -2850,40 +2815,23 @@ METADATA." (signal 'verb-empty-spec nil)) ;;; METHOD + URL + PROTOCOL - ;; Get the first line and split it into parts - (let* ( - (line (verb--get-line-in-buffer context)) - (single-line-list (verb--single-line-method-url-protocol line)) - - ) - + (let* ((line (verb--get-line-in-buffer context)) + (single-line-list (verb--single-line-method-url-protocol line))) ;; Store each part of the line (setq method (nth 0 single-line-list) - url (string-remove-suffix "\\" (nth 1 single-line-list)) - protocol (nth 2 single-line-list) - ) - + url (string-remove-suffix "\\" (nth 1 single-line-list)) + protocol (nth 2 single-line-list)) ;; If the url is on multiple lines ;; Continue until we have the full ;; url and the protocol, if specified. (when (string-suffix-p "\\" line) - (let* ( - (multiline-list (verb--multiline-method-url-protocol url line)) - ) + (let* ((multiline-list (verb--multiline-method-url-protocol url line))) (setq url (nth 0 multiline-list) - protocol (verb--validate-http-protocol (nth 1 multiline-list)) - ) - ) - ) - - ) - + protocol (verb--validate-http-protocol (nth 1 multiline-list)))))) ;; We've processed the URL line, move to the end of it. (end-of-line) - - ;; Skip newline after URL line. (unless (eobp) (forward-char)) (setq headers-start (point))