email-archives.factor
· 1.6 KiB · Factor
Raw
Playground
! Copyright (C) 2026 CapitalEx.
! See https://factorcode.org/license.txt for BSD license.
USING: assocs calendar calendar.format concurrency.combinators
io.encodings.utf8 io.files kernel make math.parser sequences
splitting unicode ;
IN: email-archives
: post-date ( json -- ymdhms )
"postDate" of dup [ dec> unix-time>timestamp timestamp>ymdhms ] [ drop "[DATE MISSING]" ] if ;
: build-subject ( json -- json )
dup "<h1>" % first "subject" of % "</h1>\n" % ;
: build-message ( json -- )
"<h2>" %
dup "authorName" of % " — " % dup post-date %
"</h2>\n" %
"<pre>" %
"messageBody" of %
"</pre>\n" % ;
: build-message-seq ( json -- )
[ build-message ] each ;
: build-page ( json -- )
build-subject
build-message-seq ;
: only-alphaspace ( str -- str )
[ [ alpha? ] [ blank? ] bi or ] filter ;
: spaces>dashes ( str -- str )
" " "-" replace ;
: add-location ( str -- str )
"/home/exarch/Documents/zz-concatenative-archives/" prepend
".html" append ;
: title>filename ( json -- title )
first [ post-date ] [ "subject" of >lower ] bi "-" glue
only-alphaspace
spaces>dashes
add-location ;
: make-page ( json -- html name )
dup [ build-page ] "" make swap title>filename ;
: write-page ( json -- )
make-page utf8 set-file-contents ;
: write-page-seq ( seq -- )
[ write-page ] parallel-each ;
: make-listing ( pair -- )
first2 "<li><a href=\"" % swap % "\">" % % "<\\a><\\li>" % ;
: make-listing-seq ( pair-seq -- )
"<ul>" % [ make-listing "\n" % ] each "<\\ul>" % ;
| 1 | ! Copyright (C) 2026 CapitalEx. |
| 2 | ! See https://factorcode.org/license.txt for BSD license. |
| 3 | USING: assocs calendar calendar.format concurrency.combinators |
| 4 | io.encodings.utf8 io.files kernel make math.parser sequences |
| 5 | splitting unicode ; |
| 6 | IN: email-archives |
| 7 | |
| 8 | : post-date ( json -- ymdhms ) |
| 9 | "postDate" of dup [ dec> unix-time>timestamp timestamp>ymdhms ] [ drop "[DATE MISSING]" ] if ; |
| 10 | |
| 11 | : build-subject ( json -- json ) |
| 12 | dup "<h1>" % first "subject" of % "</h1>\n" % ; |
| 13 | |
| 14 | : build-message ( json -- ) |
| 15 | "<h2>" % |
| 16 | dup "authorName" of % " — " % dup post-date % |
| 17 | "</h2>\n" % |
| 18 | "<pre>" % |
| 19 | "messageBody" of % |
| 20 | "</pre>\n" % ; |
| 21 | |
| 22 | : build-message-seq ( json -- ) |
| 23 | [ build-message ] each ; |
| 24 | |
| 25 | : build-page ( json -- ) |
| 26 | build-subject |
| 27 | build-message-seq ; |
| 28 | |
| 29 | : only-alphaspace ( str -- str ) |
| 30 | [ [ alpha? ] [ blank? ] bi or ] filter ; |
| 31 | |
| 32 | : spaces>dashes ( str -- str ) |
| 33 | " " "-" replace ; |
| 34 | |
| 35 | : add-location ( str -- str ) |
| 36 | "/home/exarch/Documents/zz-concatenative-archives/" prepend |
| 37 | ".html" append ; |
| 38 | |
| 39 | : title>filename ( json -- title ) |
| 40 | first [ post-date ] [ "subject" of >lower ] bi "-" glue |
| 41 | only-alphaspace |
| 42 | spaces>dashes |
| 43 | add-location ; |
| 44 | |
| 45 | : make-page ( json -- html name ) |
| 46 | dup [ build-page ] "" make swap title>filename ; |
| 47 | |
| 48 | : write-page ( json -- ) |
| 49 | make-page utf8 set-file-contents ; |
| 50 | |
| 51 | : write-page-seq ( seq -- ) |
| 52 | [ write-page ] parallel-each ; |
| 53 | |
| 54 | : make-listing ( pair -- ) |
| 55 | first2 "<li><a href=\"" % swap % "\">" % % "<\\a><\\li>" % ; |
| 56 | |
| 57 | : make-listing-seq ( pair-seq -- ) |
| 58 | "<ul>" % [ make-listing "\n" % ] each "<\\ul>" % ; |
| 59 |