;;;; 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))))