;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; REST API bindings for lists.sr.ht
;;;
;;; Copyright (c) 2019, Evan Hanson
;;;
;;; See LICENSE for details.
;;;

(declare (module (topham lists))
         (export user subscription subscriptions
                 email emails thread posts
                 mailing-list mailing-lists))

(import (chicken format)
        (chicken keyword)
        (chicken type)
        (topham))

(define-inline (make-crud path #!optional (body '()))
  `((#:service "lists" #:path ,path) . ,body))

(define-inline (make-mailing-list #!key (name 'null) (description 'null))
  `((name . ,name)
    (description . ,description)))

(define-inline (make-subscription #!key (list 'null))
  `((list . ,list)))

;;
;; https://man.sr.ht/lists.sr.ht/api.md#get-apiuser
;; https://man.sr.ht/lists.sr.ht/api.md#get-apiuserusername
;;
(: user (#!optional string -> (list-of pair)))
(define (user #!optional username)
  (make-crud
   (if (not username)
       "/api/user"
       (format "/api/user/~A" username))))

;;
;; https://man.sr.ht/lists.sr.ht/api.md#get-apisubscriptions
;;
(: subscriptions (-> (list-of pair)))
(define (subscriptions)
  (make-crud "/api/subscriptions"))

;;
;; https://man.sr.ht/lists.sr.ht/api.md#get-apisubscriptionssub-id
;; https://man.sr.ht/lists.sr.ht/api.md#post-apisubscriptions
;; https://man.sr.ht/lists.sr.ht/api.md#delete-apisubscriptionssub-id
;;
(: subscription (number #!rest any -> (list-of pair)))
(define (subscription #!optional id #!rest details)
  (cond
    ((integer? id)
     (make-crud (format "/api/subscriptions/~A" id)))
    ((get-keyword #:list (cons id details))
     (make-crud "/api/subscriptions" (apply make-subscription id details)))
    (else
     (signal-condition
      '(topham)
      '(arity)
      '(exn location subscription message "subscription id or #:list must be given")))))

;;
;; https://man.sr.ht/lists.sr.ht/api.md#get-apiemails
;; https://man.sr.ht/lists.sr.ht/api.md#get-apiuserusernameemails
;;
(: emails (#!optional string -> (list-of pair)))
(define (emails #!optional username)
  (make-crud
   (if (not username)
       "/api/emails"
       (format "/api/user/~A/emails" username))))

;;
;; https://man.sr.ht/lists.sr.ht/api.md#get-apiemailsemail-id
;; https://man.sr.ht/lists.sr.ht/api.md#get-apiuserusernameemailsemail-id
;;
(: email (string #!optional (or number string) -> (list-of pair)))
(define (email username-or-email-id #!optional email-id)
  (make-crud
   (if (not email-id)
       (format "/api/emails/~A" username-or-email-id)
       (format "/api/user/~A/emails/~A" username-or-email-id email-id))))

;;
;; https://man.sr.ht/lists.sr.ht/api.md#get-apithreademail-id
;; https://man.sr.ht/lists.sr.ht/api.md#get-apiuserusernamethreademail-id
;;
(: thread (string #!optional (or number string) string -> (list-of pair)))
(define (thread username-or-email-id #!optional email-id)
  (make-crud
   (if (not email-id)
       (format "/api/thread/~A" username-or-email-id)
       (format "/api/user/~A/thread/~A" username-or-email-id email-id))))

;;
;; https://man.sr.ht/lists.sr.ht/api.md#get-apilists
;; https://man.sr.ht/lists.sr.ht/api.md#get-apiuserusernamelists
;;
(: mailing-lists (#!optional string -> (list-of pair)))
(define (mailing-lists #!optional username)
  (make-crud
   (if (not username)
       "/api/lists"
       (format "/api/user/~A/lists" username))))

;;
;; https://man.sr.ht/lists.sr.ht/api.md#get-apilistslist-name
;; https://man.sr.ht/lists.sr.ht/api.md#put-apilistslist-name
;; https://man.sr.ht/lists.sr.ht/api.md#post-apilists
;;
(: mailing-list (#!optional string #!rest any -> (list-of pair)))
(define (mailing-list #!optional username-or-listname listname #!rest details)
  (cond
    ;; update
    ((and (string? username-or-listname)
          (get-keyword #:description (cons listname details)))
     (make-crud (format "/api/lists/~A" username-or-listname)
                (apply make-mailing-list listname details)))
    ;; fetch
    ((string? username-or-listname)
     (make-crud
      (if (not listname)
          (format "/api/lists/~A" username-or-listname)
          (format "/api/user/~A/lists/~A" username-or-listname listname))))
    ;; create
    ((get-keyword #:name (append (list username-or-listname listname) details))
     (make-crud
      "/api/lists"
      (apply make-mailing-list username-or-listname listname details)))
    (else
     (signal-condition
      '(topham)
      '(arity)
      '(exn location mailing-list message "mailing list name or #:name must be given")))))

;;
;; https://man.sr.ht/lists.sr.ht/api.md#get-apilistslist-nameposts
;; https://man.sr.ht/lists.sr.ht/api.md#get-apiuserusernamelistslist-nameposts
;;
(: posts (string #!optional string -> (list-of pair)))
(define (posts username-or-listname #!optional listname)
  (make-crud
   (if (not listname)
       (format "/api/lists/~A/posts" username-or-listname)
       (format "/api/user/~A/lists/~A/posts" username-or-listname listname))))