diff --git a/src/link-header-parser.lisp b/src/link-header-parser.lisp deleted file mode 100644 index ccd06e0..0000000 --- a/src/link-header-parser.lisp +++ /dev/null @@ -1,108 +0,0 @@ -;; tinmop: an humble gemini and pleroma client -;; Copyright (C) 2020 cage - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. -;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]]. - -(in-package :link-header-parser) - -(defrule link-start #\< - (:text t)) - -(defrule link-end #\> - (:text t)) - -(defrule field-separator #\; - (:text t)) - -(defrule parameter-separator #\= - (:text t)) - -(defrule parameter-value-quoting #\" - (:text t)) - -(defrule links-separator #\, - (:text t)) - -(defrule alpha (character-ranges (#\a #\z) (#\A #\Z)) - (:text t)) - -(defrule digit (character-ranges (#\0 #\9)) - (:text t)) - -(defrule iri-chars (not link-end) - (:text t)) - -(defrule blank (or #\space #\Newline #\Tab) - (:constant nil)) - -(defrule blanks (* blank) - (:constant nil)) - -(defrule parameter-key-chars (or alpha digit #\_ #\- #\.)) - -(defrule parameter-value-chars (not (or blank field-separator links-separator parameter-value-quoting))) - -(defrule parameter (and (+ parameter-key-chars) - blanks - parameter-separator - blanks - (? parameter-value-quoting) - (+ parameter-value-chars) - (? parameter-value-quoting) - (? field-separator)) - (:function (lambda (a) (cons (text (first a)) - (text (sixth a)))))) - -(defrule parameters-list (+ (and parameter blanks)) - (:function (lambda (a) (mapcar #'first a)))) - -(defrule link-block (and link-start (+ iri-chars) link-end) - (:function (lambda (a) (iri:iri-parse (text (second a)) :null-on-error t)))) - -(defrule link-record (and link-block (? field-separator) blanks (* parameters-list)) - (:function (lambda (a) (append (list (first a)) (fourth a))))) - -(defrule link-header-value (and link-record blanks - (? links-separator) - blanks - (* link-record)) - (:function (lambda (a) (append (list (first a)) (fifth a))))) - -(defun parse-header (header) - (parse 'link-header-value header)) - -(define-constant +link-parameter-relation+ "rel" :test #'string=) - -(defun extract-pagination-id (header direction query-key) - (when-let ((parsed (ignore-errors (parse-header header)))) - (loop for field in parsed do - (let* ((iri (first field)) - (params (second field)) - (relation (assoc +link-parameter-relation+ params :test #'string=)) - (query (uri:query iri))) - (when (string= (cdr relation) direction) - (multiple-value-bind (matched registers) - (cl-ppcre:scan-to-strings (strcat query-key "=([^&]+)") query) - (when matched - (return-from extract-pagination-id (elt registers 0))))))))) - -(define-constant +link-pagination-query-param-max-id+ "max_id" :test #'string=) - -(define-constant +link-pagination-relation-next+ "next" :test #'string=) - -(defun extract-pagination-current-max-id (header) - (extract-pagination-id header - +link-pagination-relation-next+ - +link-pagination-query-param-max-id+)) diff --git a/src/package.lisp b/src/package.lisp index b866fac..294601d 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -775,17 +775,6 @@ :ipv6-address-p :iri-to-parent-path)) -;; (defpackage :link-header-parser -;; (:use -;; :cl -;; :alexandria -;; :esrap -;; :cl-ppcre -;; :text-utils) -;; (:export -;; :parse-header -;; :extract-pagination-current-max-id)) - (defpackage :tour-mode-parser (:use :cl diff --git a/src/tests/link-header-tests.lisp b/src/tests/link-header-tests.lisp deleted file mode 100644 index 4149e34..0000000 --- a/src/tests/link-header-tests.lisp +++ /dev/null @@ -1,43 +0,0 @@ -;; tinmop: an humble gemini and pleroma client -;; Copyright (C) 2020 cage - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. -;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]]. - -(in-package :link-header-tests) - -(defsuite link-header-suite (all-suite)) - -(defun test-link-header (link-header results) - (let ((parsed (parse-header link-header))) - (loop for field in parsed - for original-field in results do - (when (not (and (iri= (first field) (first original-field)) - (equalp (second field) (second original-field)))) - (return-from test-link-header nil))) - t)) - -(defparameter *test-cases* `(("; rel=\"f\"" . - (("http://invalid/a/b?p=5" (("rel" . "f"))))) - ,(cons (format nil "; rel=\"start\",~%; rel=\"index\"") - '(("https://example.org/" (("rel" . "start"))) - ("https://example.org/index" (("rel" . "index"))))))) - -(deftest test-parsing (link-header-suite) - (loop for (a . b) in *test-cases* do - (assert-true (test-link-header a b) b))) - -(deftest test-extraction-next-pagination-id (link-header-suite) - (let ((link-pagination "; rel=\"next\", ; rel=\"prev\"")) - (assert-equalp "123456" (extract-pagination-current-max-id link-pagination)))) diff --git a/src/tests/package.lisp b/src/tests/package.lisp index fa96c21..bdd3686 100644 --- a/src/tests/package.lisp +++ b/src/tests/package.lisp @@ -55,15 +55,6 @@ :all-tests) (:export)) -(defpackage :link-header-tests - (:use :cl - :alexandria - :clunit - :link-header-parser - :iri - :all-tests) - (:export)) - (defpackage :numeric-tests (:use :cl :clunit