capitalex a révisé ce gist 3 days ago. Aller à la révision
1 file changed, 58 insertions
email-archives.factor(fichier créé)
| @@ -0,0 +1,58 @@ | |||
| 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>" % ; | |
Plus récent
Plus ancien