API: move `src` to `ss`

9 files changed, 0 insertions, 690 deletions

diff --git a/src/as.scm b/src/as.scm
deleted file mode 100644
index d309b8a..0000000
--- a/src/as.scm
+++ /dev/null
@@ -1,16 +0,0 @@
-(define-module (src as)
-  #:export (as)
-  #:declarative? #f)
-
-(define (call-in-module thunk module)
-  (let* ((curmod (current-module))
-         (_ (set-current-module (resolve-module module)))
-         (v (thunk))
-         (_ (set-current-module curmod)))
-    v))
-
-(define (load-in-module path module-name)
-  (call-in-module (lambda () (load path)) module-name))
-
-(define (as what file)
-  (load-in-module file `(src as ,what)))
diff --git a/src/as/atom.scm b/src/as/atom.scm
deleted file mode 100644
index 092393c..0000000
--- a/src/as/atom.scm
+++ /dev/null
@@ -1,10 +0,0 @@
-(define-module (src as atom)
-  #:use-module ((src atom) #:prefix atom:)
-  #:use-module (src dates)
-  #:declarative? #f)
-
-(define main atom:feed)
-(define post atom:entry)
-(define person atom:person)
-(define media atom:media)
-
diff --git a/src/as/html.scm b/src/as/html.scm
deleted file mode 100644
index 8d2a6e8..0000000
--- a/src/as/html.scm
+++ /dev/null
@@ -1,9 +0,0 @@
-(define-module (src as html)
-  #:use-module (src dates)
-  #:use-module ((src html) #:prefix html:)
-  #:declarative? #f)
-
-(define main html:index)
-(define post html:post)
-(define person html:person)
-(define media html:media)
diff --git a/src/as/media-list.scm b/src/as/media-list.scm
deleted file mode 100644
index ca29507..0000000
--- a/src/as/media-list.scm
+++ /dev/null
@@ -1,9 +0,0 @@
-(define-module (src as media-list)
-  #:use-module (src dates)
-  #:use-module ((src media-list) #:prefix media-list:)
-  #:declarative? #f)
-
-(define main media-list:media-list)
-(define post media-list:ignore)
-(define person media-list:ignore)
-(define media media-list:add-to-list)
diff --git a/src/atom.scm b/src/atom.scm
deleted file mode 100644
index ba4ff3d..0000000
--- a/src/atom.scm
+++ /dev/null
@@ -1,219 +0,0 @@
-(define-module (src atom)
-  #:use-module (src mime-types)
-  #:use-module (src dates)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (sxml simple)
-  #:use-module (ice-9 binary-ports)
-  #:use-module (rnrs bytevectors)
-  #:export (feed
-            feed?
-            feed-id
-            feed-title
-            feed-subtitle
-            feed-uri
-            feed-updated
-            feed-entries
-            append-feed-entry!
-
-            entry
-            entry?
-            entry-id
-            entry-title
-            entry-published
-            entry-updated
-            entry-authors
-            entry-summary
-            entry-content
-            entry-categories
-            entry-contributors
-            entry-media
-
-            person
-            person?
-            person-name
-            person-email
-            person-uri
-
-            media
-            media?
-            media-title
-            media-type
-            media-length
-            media-uri
-            media-path
-
-            render))
-
-; ATOM Explanation: http://www.atomenabled.org/developers/syndication/
-; ATOM Validator:   https://validator.w3.org/feed/check.cgi
-
-;; Entities
-(define-record-type <feed>
-  (%make-feed id title subtitle uri updated entries)
-  feed?
-  (id feed-id)
-  (title feed-title)
-  (subtitle feed-subtitle)
-  (uri feed-uri)
-  (updated feed-updated set-feed-updated!)
-  (entries feed-entries set-feed-entries!))
-
-(define-record-type <entry>
-  (%make-entry id title published updated authors summary content categories contributors media)
-  entry?
-  (id entry-id set-entry-id!)
-  (title entry-title)
-  (published entry-published)
-  (updated entry-updated)
-  (authors entry-authors)
-  (summary entry-summary)
-  (content entry-content)
-  (categories entry-categories)
-  (contributors entry-contributors)
-  (media entry-media))
-
-(define-record-type <media>
-  (%make-media title type length uri path)
-  media?
-  (title media-title)
-  (type media-type)
-  (length media-length)
-  (uri media-uri)
-  (path media-path))
-
-(define-record-type <person>
-  (%make-person name email uri)
-  person?
-  (name person-name)
-  (email person-email)
-  (uri person-uri))
-
-(define* (append-feed-entry! feed entry)
-         (let ((entries (feed-entries feed)))
-           (set-entry-id!     entry (string-append
-                                      (feed-uri feed) "/"
-                                      (entry-id entry))) ;; TODO: is this enough
-           (set-feed-entries! feed (append entries (list entry))))
-           (set-feed-updated! feed (find-newest (map entry-updated
-                                                     (feed-entries feed)))))
-
-(define* (feed #:key (title              "")
-                     (subtitle           "")
-                     (uri                "")
-                     (atom-feed-location "")
-                     (posts             '())
-               #:allow-other-keys)
-  (let* ((f (%make-feed uri
-                        title
-                        subtitle
-                        (string-append uri atom-feed-location)
-                        (find-newest (map entry-updated posts))
-                        '()))
-         (append-entry! (partial append-feed-entry! f)))
-    (for-each append-entry!
-              (sort posts (lambda (a b)
-                            (date>? (entry-published a) (entry-published b)))))
-    f))
-
-
-(define* (entry  #:key (title "")
-                       (id #f)
-                       (published unix-date)
-                       (updated unix-date)
-                       (authors '())
-                       (summary-html '())
-                       (content-html '())
-                       (categories '())
-                       (contributors '())
-                       (media '())
-                 #:allow-other-keys)
-  (define valid (char-set-intersection char-set:ascii char-set:letter))
-  (define (id-from-title title)
-    (string-map (lambda (c)
-                  (if (char-set-contains? valid c) c #\-))
-                title))
-
-  (%make-entry (or id (id-from-title title))
-               title
-               published
-               (find-newest (list published updated))
-               authors
-               summary-html
-               content-html
-               categories
-               contributors
-               media))
-
-(define* (person name #:key (email "")
-                            (uri   "")
-                      #:allow-other-keys)
-  (%make-person name email uri))
-
-
-(define* (media path #:key (title "")
-                           (uri   "")
-                     #:allow-other-keys)
-  (define (type path)
-    (let* ((extension (car (last-pair (string-split path #\.))))
-           (type (assoc-ref mime-types extension)))
-      (if (string? type) type (throw "Unknown mime-type"))))
-  (let ((contents (call-with-input-file path get-bytevector-all #:binary #t)))
-    (%make-media title
-                 (type path)
-                 (bytevector-length contents)
-                 uri
-                 path)))
-
-;; Rendering
-(define (render-person tag person)
-  `(,tag
-     (name  ,(person-name person))
-     (uri   ,(or (person-uri person) ""))
-     (email ,(or (person-email person) ""))))
-
-(define (partial  f . set)
-  (lambda (. args) (apply f (append set args))))
-(define render-author      (partial render-person 'author))
-(define render-contributor (partial render-person 'contributor))
-
-(define (render-media med)
-  `(link (@(rel enclosure)
-           (href ,(media-uri med))
-           (type ,(media-type med))
-           (title ,(media-title med))
-           (length ,(media-length med)))))
-
-(define (render-category cat)
-  `(category (@(term ,cat))))
-
-(define (sxml->string/rendered content)
-  (call-with-output-string
-    (lambda (p) (sxml->xml content p))))
-
-(define (render-entry ent)
-  `(entry
-     (id                      ,(entry-id ent))
-     (title                   ,(entry-title ent))
-     (published               ,(date->string/RFC3339 (entry-published ent)))
-     (updated                 ,(date->string/RFC3339 (entry-updated ent)))
-     ,@(map render-author      (entry-authors ent))
-     (summary (@(type html))  ,(sxml->string/rendered (entry-summary ent)))
-     (content (@(type html))  ,(sxml->string/rendered (entry-content ent)))
-     ,@(map render-category    (entry-categories ent))
-     ,@(map render-contributor (entry-contributors ent))
-     ,@(map render-media       (entry-media ent))))
-
-(define (render-feed fe)
-  `(feed (@(xmlns "http://www.w3.org/2005/Atom"))
-     (id ,(feed-id fe))
-     (title ,(feed-title fe))
-     (link (@(href ,(feed-uri fe))
-             (rel "self")))
-     (updated ,(date->string/RFC3339 (feed-updated fe)))
-     (subtitle ,(feed-subtitle fe))
-     ,@(map render-entry (feed-entries fe))))
-
-(define (render feed)
-  (display "<?xml version=\"1.0\" encoding=\"utf-8\"?>")
-  (sxml->xml (render-feed feed)))
diff --git a/src/dates.scm b/src/dates.scm
deleted file mode 100644
index a70aa01..0000000
--- a/src/dates.scm
+++ /dev/null
@@ -1,44 +0,0 @@
-(define-module (src dates)
-  #:use-module (ice-9 format)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-19)
-  #:export (string/ISO->date
-            date->string/RFC3339
-            unix-date
-            newest
-            find-newest
-            date>?))
-
-(define (string/ISO->date string)
-  (string->date string "~Y-~m-~d"))
-
-(define (date->string/RFC3339 date)
-  (call-with-output-string
-    (lambda (p)
-      (let* ((offset           (abs (date-zone-offset date)))
-             (rem-h-seconds    (modulo offset (* 60 60)))
-             (offset-hours     (floor (/ (- offset rem-h-seconds) 60 60)))
-             (rem-m-seconds    (modulo rem-h-seconds 60))
-             (offset-minutes   (floor (/ (- rem-h-seconds rem-m-seconds) 60))))
-       (format
-         p
-         "~4,'0d-~2,'0d-~2,'0dT~2,'0d:~2,'0d:~2,'0d~:[Z~;~c~2,'0d:~2,'0d~]"
-         (date-year date)
-         (date-month date)
-         (date-day date)
-         (date-hour date)
-         (date-minute date)
-         (date-second date)
-         (not (= 0 (date-zone-offset date)))
-         (if (< 0 (date-zone-offset date)) #\+ #\-)
-         offset-hours
-         offset-minutes)))))
-
-(define unix-date (string/ISO->date "1970-01-01"))
-
-(define (newest a b) (if (time>? (date->time-utc a) (date->time-utc b)) a b))
-
-(define (date>? a b)
-  (time>? (date->time-utc a) (date->time-utc b)))
-
-(define (find-newest dates) (reduce newest unix-date dates))
diff --git a/src/html.scm b/src/html.scm
deleted file mode 100644
index e957683..0000000
--- a/src/html.scm
+++ /dev/null
@@ -1,214 +0,0 @@
-(define-module (src html)
-  #:use-module (src dates)
-  #:use-module (srfi srfi-9)
-  #:use-module (sxml simple)
-  #:use-module (src mime-types)
-  #:export (render
-            person
-            person?
-            person-name
-            person-email
-            person-uri
-
-            post
-            post?
-            post-id
-            post-title
-            post-published
-            post-updated
-            post-authors
-            post-summary-html
-            post-content-html
-            post-categories
-            post-contributors
-            post-media
-
-            index
-            index?
-            index-title
-            index-short-description
-            index-long-description
-            index-uri
-            index-atom-feed-uri
-            index-author
-            index-posts
-            index-styles
-            index-scripts
-
-            media
-            media?
-            media-type
-            media-uri
-            media-path))
-
-(define-record-type <index>
-  (%make-index title short-description long-description uri atom-feed-uri author posts styles scripts)
-  index?
-  (title index-title)
-  (short-description index-short-description)
-  (long-description index-long-description)
-  (uri index-uri)
-  (atom-feed-uri index-atom-feed-uri)
-  (author index-author)
-  (posts index-posts)
-  (styles index-styles)
-  (scripts index-scripts))
-
-(define-record-type <post>
-  (%make-post id
-              title
-              published
-              updated
-              authors
-              summary-html
-              content-html
-              categories
-              contributors
-              media)
-  post?
-  (id post-id)
-  (title post-title)
-  (published post-published)
-  (updated post-updated)
-  (authors post-authors)
-  (summary-html post-summary-html)
-  (content-html post-content-html)
-  (categories post-categories)
-  (contributors post-contributors)
-  (media post-media))
-
-(define-record-type <media>
-  (%make-media type uri path)
-  media?
-  (type media-type)
-  (uri media-uri)
-  (path media-path))
-
-(define-record-type <person>
-  (%make-person name email uri)
-  person?
-  (name person-name)
-  (email person-email)
-  (uri person-uri))
-
-
-(define* (index #:key (title "")
-                      (short-description "")
-                      (long-description "")
-                      (uri "")
-                      (atom-feed-uri #f)
-                      (author (person ""))
-                      (posts '())
-                      (styles '())
-                      (scripts '())
-                #:allow-other-keys)
-         (%make-index
-           title
-           short-description
-           long-description
-           uri
-           atom-feed-uri
-           author
-           (sort posts (lambda (a b)
-                         (date>? (post-published a) (post-published b))))
-           styles
-           scripts))
-
-
-(define* (post #:key (id #f)
-                     (title "")
-                     (published unix-date)
-                     (updated unix-date)
-                     (authors '())
-                     (summary-html '())
-                     (content-html '())
-                     (categories '())
-                     (contributors '())
-                     (media '())
-              #:allow-other-keys)
-
-  (define (id-from-title title)
-    (string-map (lambda (c)
-                  (if (char-set-contains? char-set:letter c) c #\-))
-                title))
-  (%make-post (or id (id-from-title title))
-              title
-              published
-              (find-newest (list published updated))
-              authors
-              summary-html
-              content-html
-              categories
-              contributors
-              media))
-
-(define* (media path #:key (uri   "")
-                     #:allow-other-keys)
-  (define (type path)
-    (let* ((extension (car (last-pair (string-split path #\.))))
-           (type (assoc-ref mime-types extension)))
-      (if (string? type) type (throw "Unknown mime-type"))))
-
-  (%make-media (type path)
-               uri
-               path))
-
-(define* (person name #:key (email "")
-                            (uri   "")
-                      #:allow-other-keys)
-  (%make-person name email uri))
-
-; Rendering
-(define (render-author author)
-  `(address (@(class author))
-    (a (@(rel author)) ,(person-name author))))
-
-(define (render-post post)
-  `(article (@(class "post")
-              (id ,(post-id post))) ;; For anchors
-            (h2 ,(post-title post))
-            (time (@(datetime ,(date->string/RFC3339 (post-published post)))
-                    (pubdate #t))
-                  ,(date->string/RFC3339 (post-published post))) ;; TODO make human readable
-            ,@(map render-author (post-authors post))
-            (section (@(class summary))
-                     ,(post-summary-html post))
-            (section (@(class content))
-                     ,(post-content-html post))))
-
-(define (render-style style)
-  (if (media? style)
-    `(link (@(rel stylesheet)
-             (href ,(media-uri style))))
-    `(style ,(lambda () (display style)))))
-
-(define (render-script script)
- (if (media? script)
-   `(script (@(src ,(media-uri script))))
-   `(script ,(lambda () (display script)))))
-
-(define (render-index index)
-  `(html
-     (head
-       (meta (@(author ,(person-name (index-author index)))))
-       (meta (@(charset "utf-8")))
-       (meta (@(name "color-scheme") (content "light dark")))
-       (meta (@(name "viewport")
-               (content "width=device-width, initial-scale=1")))
-       (meta (@(name "description")
-               (content ,(index-short-description index))))
-       ,(if (not (index-atom-feed-uri index))
-         `()
-         `(link (@(rel "alternate")
-                  (type "application/atom+xml")
-                  (href ,(index-atom-feed-uri index)))))
-       ,@(map render-style (index-styles index)))
-     (body
-       (h1 (@(class title)) ,(index-title index))
-       (section (@(class description)) ,(index-long-description index))
-       ,@(map render-post (index-posts index))
-       ,@(map render-script (index-scripts index)))))
-
-(define (render index)
-  (display "<!DOCTYPE html>")
-  (sxml->xml (render-index index)))
diff --git a/src/media-list.scm b/src/media-list.scm
deleted file mode 100644
index 115ae0a..0000000
--- a/src/media-list.scm
+++ /dev/null
@@ -1,14 +0,0 @@
-(define-module (src media-list)
-  #:use-module (ice-9 format)
-  #:export (ignore
-            media-list
-            add-to-list))
-
-(define %media '())
-
-(define (ignore . rest) #f)
-
-(define* (add-to-list path #:key (uri  "") #:allow-other-keys)
- (set! %media (append! %media (list (cons path uri)))))
-
-(define (media-list . rest) %media)
diff --git a/src/mime-types.scm b/src/mime-types.scm
deleted file mode 100644
index 20dd228..0000000
--- a/src/mime-types.scm
+++ /dev/null
@@ -1,155 +0,0 @@
-(define-module (src mime-types)
-      #:export (mime-types))
-
-(define mime-types
-  '(("js"         . "application/javascript")
-    ("mjs"        . "application/javascript")
-    ("json"       . "application/json")
-    ("webmanifest". "application/manifest+json")
-    ("doc"        . "application/msword")
-    ("dot"        . "application/msword")
-    ("wiz"        . "application/msword")
-    ("nq"         . "application/n-quads")
-    ("nt"         . "application/n-triples")
-    ("bin"        . "application/octet-stream")
-    ("a"          . "application/octet-stream")
-    ("dll"        . "application/octet-stream")
-    ("exe"        . "application/octet-stream")
-    ("o"          . "application/octet-stream")
-    ("obj"        . "application/octet-stream")
-    ("so"         . "application/octet-stream")
-    ("oda"        . "application/oda")
-    ("pdf"        . "application/pdf")
-    ("p7c"        . "application/pkcs7-mime")
-    ("ps"         . "application/postscript")
-    ("ai"         . "application/postscript")
-    ("eps"        . "application/postscript")
-    ("trig"       . "application/trig")
-    ("m3u"        . "application/vnd.apple.mpegurl")
-    ("m3u8"       . "application/vnd.apple.mpegurl")
-    ("xls"        . "application/vnd.ms-excel")
-    ("xlb"        . "application/vnd.ms-excel")
-    ("ppt"        . "application/vnd.ms-powerpoint")
-    ("pot"        . "application/vnd.ms-powerpoint")
-    ("ppa"        . "application/vnd.ms-powerpoint")
-    ("pps"        . "application/vnd.ms-powerpoint")
-    ("pwz"        . "application/vnd.ms-powerpoint")
-    ("wasm"       . "application/wasm")
-    ("bcpio"      . "application/x-bcpio")
-    ("cpio"       . "application/x-cpio")
-    ("csh"        . "application/x-csh")
-    ("dvi"        . "application/x-dvi")
-    ("gtar"       . "application/x-gtar")
-    ("hdf"        . "application/x-hdf")
-    ("h5"         . "application/x-hdf5")
-    ("latex"      . "application/x-latex")
-    ("mif"        . "application/x-mif")
-    ("cdf"        . "application/x-netcdf")
-    ("nc"         . "application/x-netcdf")
-    ("p12"        . "application/x-pkcs12")
-    ("pfx"        . "application/x-pkcs12")
-    ("ram"        . "application/x-pn-realaudio")
-    ("pyc"        . "application/x-python-code")
-    ("pyo"        . "application/x-python-code")
-    ("sh"         . "application/x-sh")
-    ("shar"       . "application/x-shar")
-    ("swf"        . "application/x-shockwave-flash")
-    ("sv4cpio"    . "application/x-sv4cpio")
-    ("sv4crc"     . "application/x-sv4crc")
-    ("tar"        . "application/x-tar")
-    ("tcl"        . "application/x-tcl")
-    ("tex"        . "application/x-tex")
-    ("texi"       . "application/x-texinfo")
-    ("texinfo"    . "application/x-texinfo")
-    ("roff"       . "application/x-troff")
-    ("t"          . "application/x-troff")
-    ("tr"         . "application/x-troff")
-    ("man"        . "application/x-troff-man")
-    ("me"         . "application/x-troff-me")
-    ("ms"         . "application/x-troff-ms")
-    ("ustar"      . "application/x-ustar")
-    ("src"        . "application/x-wais-source")
-    ("xsl"        . "application/xml")
-    ("rdf"        . "application/xml")
-    ("wsdl"       . "application/xml")
-    ("xpdl"       . "application/xml")
-    ("zip"        . "application/zip")
-    ("3gp"        . "audio/3gpp")
-    ("3gpp"       . "audio/3gpp")
-    ("3g2"        . "audio/3gpp2")
-    ("3gpp2"      . "audio/3gpp2")
-    ("aac"        . "audio/aac")
-    ("adts"       . "audio/aac")
-    ("loas"       . "audio/aac")
-    ("ass"        . "audio/aac")
-    ("au"         . "audio/basic")
-    ("snd"        . "audio/basic")
-    ("mp3"        . "audio/mpeg")
-    ("mp2"        . "audio/mpeg")
-    ("opus"       . "audio/opus")
-    ("oga"        . "audio/ogg")
-    ("aif"        . "audio/x-aiff")
-    ("aifc"       . "audio/x-aiff")
-    ("aiff"       . "audio/x-aiff")
-    ("ra"         . "audio/x-pn-realaudio")
-    ("wav"        . "audio/x-wav")
-    ("avif"       . "image/avif")
-    ("bmp"        . "image/bmp")
-    ("gif"        . "image/gif")
-    ("ief"        . "image/ief")
-    ("jpg"        . "image/jpeg")
-    ("jpe"        . "image/jpeg")
-    ("jpeg"       . "image/jpeg")
-    ("heic"       . "image/heic")
-    ("heif"       . "image/heif")
-    ("png"        . "image/png")
-    ("svg"        . "image/svg+xml")
-    ("tiff"       . "image/tiff")
-    ("tif"        . "image/tiff")
-    ("ico"        . "image/vnd.microsoft.icon")
-    ("ras"        . "image/x-cmu-raster")
-    ("pnm"        . "image/x-portable-anymap")
-    ("pbm"        . "image/x-portable-bitmap")
-    ("pgm"        . "image/x-portable-graymap")
-    ("ppm"        . "image/x-portable-pixmap")
-    ("rgb"        . "image/x-rgb")
-    ("xbm"        . "image/x-xbitmap")
-    ("xpm"        . "image/x-xpixmap")
-    ("xwd"        . "image/x-xwindowdump")
-    ("eml"        . "message/rfc822")
-    ("mht"        . "message/rfc822")
-    ("mhtml"      . "message/rfc822")
-    ("nws"        . "message/rfc822")
-    ("css"        . "text/css")
-    ("csv"        . "text/csv")
-    ("html"       . "text/html")
-    ("htm"        . "text/html")
-    ("n3"         . "text/n3")
-    ("txt"        . "text/plain")
-    ("bat"        . "text/plain")
-    ("c"          . "text/plain")
-    ("h"          . "text/plain")
-    ("ksh"        . "text/plain")
-    ("pl"         . "text/plain")
-    ("srt"        . "text/plain")
-    ("rtx"        . "text/richtext")
-    ("tsv"        . "text/tab-separated-values")
-    ("vtt"        . "text/vtt")
-    ("py"         . "text/x-python")
-    ("etx"        . "text/x-setext")
-    ("sgm"        . "text/x-sgml")
-    ("sgml"       . "text/x-sgml")
-    ("vcf"        . "text/x-vcard")
-    ("xml"        . "text/xml")
-    ("mp4"        . "video/mp4")
-    ("mpeg"       . "video/mpeg")
-    ("m1v"        . "video/mpeg")
-    ("mpa"        . "video/mpeg")
-    ("mpe"        . "video/mpeg")
-    ("mpg"        . "video/mpeg")
-    ("mov"        . "video/quicktime")
-    ("qt"         . "video/quicktime")
-    ("webm"       . "video/webm")
-    ("ogv"        . "video/ogg")
-    ("avi"        . "video/x-msvideo")
-    ("movie"      . "video/x-sgi-movie")))