root/data-source-rss.scm

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
(define-module (data-source-rss)
  #:use-module (srfi srfi-19)           ;date
  #:use-module (sxml simple)
  #:export (data-source-rss))


(define (data-source-rss year file)
  (if (string-suffix? ".sxml" file)
      (sxml->data-source-rss year (call-with-input-file file read))
      (sxml->data-source-rss year (get-feed (call-with-input-file file xml->sxml)))))

(define (get-entries sxml)
  (define feed (assoc-ref sxml 'http://www.w3.org/2005/Atom:feed))
  (define entries (filter
                   (lambda (e)
                     (and (list? e)
                          (eq? (car e) 'http://www.w3.org/2005/Atom:entry)))
                   feed))
  entries)

(define (sxml->data-source-rss year entries)

  ;; TODO shift year based on calendar
  (let* ((start-date (make-date 0 0 0 0 1 1 year 0))
         (end-date (make-date 0 0 0 0 31 12 (+ year 1) 0)))
    (define data (map gitlab-entry->data entries))
    data
    )
  )

(define (gitlab-entry->data e)
  (define link (assoc-ref e 'http://www.w3.org/2005/Atom:link))
  (define link-attrs (assoc-ref link '@))
  (define link-href (car (assoc-ref link-attrs 'href)))
  (define updated (car (assoc-ref e 'http://www.w3.org/2005/Atom:updated)))  ;2021-07-06T17:37:59Z
  `((project . ,(gitlab-projectname link-href))
    (date . ,(string->date updated "~Y-~m-~dT~H:~M:~S~z"))))

(define (gitlab-projectname str)
  "Convert \"https://gitlab.gnome.org/World/podcasts/-/issues/73#note_1198570\" to \"podcasts\""
  (define prefix 9)                     ; https://x
  (define slash1 (string-index str #\/ prefix))
  (define slash2 (string-index str #\/ (+ slash1 1)))
  (define slash3 (string-index str #\/ (+ slash2 1)))
  (define name (substring str (+ slash2 1) (or slash3 (string-length str))))
  name)