oxaliq.net/publish.rkt
2023-11-08 23:12:52 -05:00

261 lines
9.9 KiB
Racket

#lang cli
(require (only-in racket/string non-empty-string? string-replace string-split)
(only-in racket/date current-date date->string date-display-format)
(only-in racket/format ~a)
(only-in racket/list append* first second third fourth fifth rest flatten add-between take)
(only-in xml xexpr->string)
csv-reading)
(define-namespace-anchor anc)
(define ns (namespace-anchor->namespace anc))
(define homepage "https://sorrel.dev")
;; publish needs to:
;: - take an input file, build a source file in the appropriate place in source/
;; - update a read-table for tags
;; - update a read-table for resource type
;; - update the atom.txt feed
;; - move the original input file
;; example
;; publish -input-file in-progress/beginning-latl.txt --resource-type unsettled --tags latl,conlang \
;; --headline "Beginning LATL" --description "beginning the process of thinking through an environment \
;; for conlanging and other language shenanigans"
;; publish -i in-progress/beginning-latl.txt -r unsettled -t latl,conlang -l "Beginning LATL" -d "beginning the process of thinking through an environment for conlanging and other language shenanigans"
(help (usage "Publish is here to put yr posts together."))
(flag (resource-type #:param [resource-type ""] t)
("-r" "--resource-type" "Type of resource [settled|unsettled|root]")
(resource-type (begin
(cond
[(equal? t "settled") "settled"]
[(equal? t "unsettled") "unsettled"]
[(equal? t "root") "root"]
[else (error 'failed "couldn't recognize resource. please use one of 'settled' 'unsettled' 'root'")]))))
(flag (tags #:param [tags ""] t)
("-t" "--tags" "Tags to apply to resource")
(tags (if (non-empty-string? t)
(string-split t ",")
(error 'failure "no tags supplied. please provide tags as comma separated values"))))
(flag (input #:param [input ""] i)
("-i" "--input-file" "File to publish")
(input (if (file-exists? i)
i
(error 'failure "couldn't locate file ~a" i))))
(flag (headline #:param [headline ""] h)
("-l" "--headline" "the shortest representation of a post")
(headline (if (non-empty-string? h)
h
(error 'failure "your post needs a headline"))))
(flag (description #:param [description ""] d)
("-d" "--description" "a little preview description of the post")
(description (if (non-empty-string? d)
d
(error 'failure "your post needs a short description"))))
(flag (test-mode)
("-x" "--test-mode" "publishes to test directory")
(test-mode #t))
(define (read-tag-lookup)
(let ([l (eval (read (open-input-file "tag-lookup.rkt")))])
(print l)))
(define (append-post-footer post-xexpr tag-list history-list)
(let ([post-footer
(read (open-input-file "source/post-footer.txt"))])
`(body
,post-xexpr
,((eval post-footer ns) tag-list history-list))))
(define (make-output-file-handle x-test r-type #:headline [l-headline ""] #:res-id [r-id 0])
(define (make-root-file-handle x l)
(if (non-empty-string? l)
(path->string (path-add-extension (build-path (if x "publish-test/source" "source")
(string-replace l " " "-"))
".txt"))
(error "'root resource requires headline")))
(define (make-res-file-handle x r id)
(if (< 0 id)
(path->string (path-add-extension (build-path (if x "publish-test/source" "source") r (~a id))
".txt"))
(error "~a resource requires r-id" r)))
(if (equal? r-type "root")
(make-root-file-handle x-test l-headline)
(make-res-file-handle x-test r-type r-id)))
(define (archive-file i x)
(if x
(copy-file i (string-replace i "in-progress" "publish-test/archive"))
(rename-file-or-directory i (string-replace i "in-progress" "archive"))))
;; takes a parsed table as a list of lists and formats for writing as a .csv file
(define (list->csv l)
(foldl (lambda (i res)
(string-append res i))
""
(flatten
(add-between (map (lambda (row)
(add-between row ","))
l)
"\n"))))
(define (write-csv-to-file data handle)
(let ([file (open-output-file handle #:exists 'replace)])
(if (port-try-file-lock? file 'exclusive)
(begin
(display data file)
(port-file-unlock file)
(close-output-port file))
(error "couldn't obtain file lock on ~a" file))))
(define (write-new-tag-table old-tag-table tag-list type res-id)
(let* ([res (~a type "/" res-id)]
[new-tt (map (lambda (row)
(let ([row-tag (first row)])
(if (member row-tag tag-list)
(begin
(set! tag-list (remove row-tag tag-list))
(append (list row-tag res) (rest row)))
row)))
old-tag-table)])
(if (null? tag-list)
new-tt
(begin (for-each (lambda (new-tag)
(set! new-tt (append new-tt (list (list new-tag res)))))
tag-list)
new-tt))))
(define (add-atom-entry atom-table new-row)
;; take only first 21 rows (or all rows)
;; insert new-row after header
(let ([out-length (min (+ 1 (length atom-table)) 21)]
[header (first atom-table)]
[old-content (rest atom-table)])
(take (append (list header new-row) old-content)
out-length)))
(program
(publish)
(let ([i (input)]
[r (resource-type)]
[t (tags)]
[l (headline)]
[d (description)]
[x (test-mode)]
[publish-time (date->string (current-date) (date-display-format 'iso-8601))])
(displayln "running publish")
;; get res id
(define res-table (csv->list (open-input-file
(path-add-extension
(if x
(build-path "publish-test" "data" r)
(build-path "data" r))
#".csv"))))
(define res-id (if (equal? r "root")
(string-replace l " " "-")
(length res-table)))
;; before anything else, open output file
;; doing this means that if a file exists of the intended
(define out
(if (equal? r "root")
(open-output-file (make-output-file-handle x r #:headline l) #:exists (if x 'replace 'error))
(open-output-file (make-output-file-handle x r #:res-id res-id) #:exists (if x 'replace 'error))))
(define res-link (if (equal? r "root")
(build-path homepage (~a res-id))
(build-path homepage r (~a res-id))))
(define resource (append-post-footer (read (open-input-file i))
t
(list publish-time)))
(define new-res-table (append (list (first res-table)) (list (list (~a res-id) l d publish-time)) (rest res-table)))
(write-csv-to-file (list->csv new-res-table)
(path-add-extension
(if x
(build-path "publish-test" "data" (~a r "x"))
(build-path "data" r))
#".csv"))
;; update tag table
(define tag-table (csv->list (open-input-file
(if x "publish-test/data/tagged.csv" "data/tagged.csv"))))
(define new-tag-table (write-new-tag-table tag-table t r res-id))
(write-csv-to-file (list->csv new-tag-table)
(if x "publish-test/data/tagged.csv" "data/tagged.csv"))
;; write to file
(if (port-try-file-lock? out 'exclusive)
(begin
(write resource out)
(port-file-unlock out)
(close-output-port out))
(error "couldn't obtain file lock on ~a" out))
;; update feed table
(define atom-table (csv->list
(open-input-file
(path-add-extension
(if x
(build-path "publish-test" "data" "atom")
(build-path "data" "atom"))
#".csv"))))
(define new-atom-table
(add-atom-entry atom-table (list l (~a res-link) d publish-time)))
(write-csv-to-file (list->csv new-atom-table)
(if x "publish-test/data/atom.csv" "data/atom.csv"))
;; update feed.atom
(define feed ((eval (read (open-input-file (if x
"publish-test/data/make-atom.txt"
"data/make-atom.txt"))) ns)
"https://sorrel.dev/feed.atom"
publish-time
homepage
(rest new-atom-table)))
(define feed-out
(open-output-file (if x "publish-test/source/feed.atom"
"source/feed.atom")
#:exists (if x 'replace 'error)))
(if (port-try-file-lock? feed-out 'exclusive)
(begin
(display
(string-append "<?xml version=\"1.0\" encoding=\"utf-8\"?>"
(xexpr->string feed))
feed-out)
(port-file-unlock feed-out)
(close-output-port feed-out))
(error "couldn't obtain file lock on ~a" feed-out))
;; only archive after everything else is done
(archive-file i x)
(displayln "publish was successful")))
(run publish)