activitypub/collection.scm \

;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu>

;;;; 

;;;; This library is free software; you can redistribute it and/or

;;;; modify it under the terms of the GNU Lesser General Public

;;;; License as published by the Free Software Foundation; either

;;;; version 3 of the License, or (at your option) any later version.

;;;; 

;;;; This library 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

;;;; Lesser General Public License for more details.

;;;; 

;;;; You should have received a copy of the GNU Lesser General Public

;;;; License along with this library; if not, write to the Free Software

;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

(define-module (activitypub collection)

  #:use-module ((activitystreams vocabulary) #:prefix as:)

  #:use-module ((activitypub vocabulary) #:prefix as:)

  #:use-module (activitystreams ontology)

  #:use-module (ice-9 match)

  #:use-module (srfi srfi-9)

  #:export (alist->collection

            make-collection

            collection?

            collection-element-ref

            collection-first

            collection-last

            collection-size

            collection

            collection-page))

(define-record-type <collection>

  (make-collection element-ref first last size)

  collection?

  (element-ref collection-element-ref)

  (first       collection-first)

  (last        collection-last)

  (size        collection-size))

(define (delimited-collection-ref collection start number)

  (let loop ((result '()) (id (or start (collection-first collection))))

    (let ((element ((collection-element-ref collection) id)))

      (if (or (not element) (= (length result) number))

          (reverse result)

          (loop (cons id result) (assoc-ref element "next"))))))

(define (previous-page collection start number)

  (let loop ((id start) (num 0))

    (let ((prev (assoc-ref ((collection-element-ref collection) id) "prev")))

      (if (or (not prev) (= num number))

          id

          (loop prev (+ num 1))))))

(define (collection-ref collection id)

  ((collection-element-ref collection) id))

(define (page-id collection-id start-id)

  (string-append collection-id "?page=true&min_id=" start-id))

(define (collection-page collection start size collection-id)

  (let* ((result (delimited-collection-ref collection start size))

         (content (map (lambda (el) (assoc-ref el "content"))

                       (map (collection-element-ref collection) result))))

    (if (null? result)

        (make-as-document

          (list as:OrderedCollectionPage)

          (list (cons as:id (page-id collection-id start))

                (cons as:partOf collection-id)

                (cons as:items '())))

        (let* ((last (pk (car (reverse result))))

               (prev-id (previous-page collection start size))

               (next-id (assoc-ref ((collection-element-ref collection) last) "next")))

          (make-as-document

            (list as:OrderedCollectionPage)

            (append

              (list (cons as:id (page-id collection-id start))

                    (cons as:partOf collection-id)

                    (cons as:prev (page-id collection-id prev-id))

                    (cons as:items content))

              (if next-id

                (list (cons as:next (page-id collection-id next-id)))

                '())))))))

(define (collection collection collection-id)

  (make-as-document

    (list as:OrderedCollection)

    (list (cons as:id collection-id)

          (cons as:totalItems (collection-size collection))

          (cons as:first (page-id collection-id (collection-first collection)))

          (cons as:last (page-id collection-id (collection-last collection))))))

(define (alist->collection lst)

  (define (alist->collection-alist lst)

    (let loop ((result '()) (lst lst) (prev #f))

      (match lst

        (() result)

        (((id . val) lst ...)

         (loop (cons (cons id `(("content" . ,val) ("prev" . ,prev)))

                     (if prev

                         (cons

                           (cons* prev (cons "next" id) (cdr (car result)))

                           (cdr result))

                         result))

               lst

               id)))))

  (let ((lst (alist->collection-alist lst)))

    (make-collection

      (lambda (id)

        (assoc-ref lst id))

      (car (car (reverse lst)))

      (car (car lst))

      (length lst))))