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

(define-module (favicon)
  #:use-module (srfi srfi-9)
  #:use-module (oop goops describe)
  #:use-module (oop goops)
  #:export (<favicon>
            favicon-href))

"Can either have
- an absolute https://example.com/favicon.png link
- a path to a file in the repository, e.g.: under raw/data/icons/my.app.png
- a relative path not in the repository e.g: ../platform-fallback-favicon.png
"
(define-class <favicon> ()
  (absolute-href #:init-keyword #:absolute-href #:inital-value #f)
  (raw-path #:init-keyword #:raw-path #:inital-value #f)
  (relative-path #:init-keyword #:relative-path #:inital-value #f))

(define (favicon-href favicon prefix-to-root)
  (cond
   ((not favicon)
    #f)
   ((slot-bound? favicon 'absolute-href)
    (slot-ref favicon 'absolute-href))
   ((slot-bound? favicon 'raw-path)
    (string-append prefix-to-root "/raw/" (slot-ref favicon 'raw-path)))
   ((slot-bound? favicon 'relative-path)
    (string-append prefix-to-root "/" (slot-ref favicon 'relative-path)))
   (#t #f)))