create publish script
This commit is contained in:
parent
521d460867
commit
8dffcd36d4
17 changed files with 542 additions and 0 deletions
1
data/atom.csv
Normal file
1
data/atom.csv
Normal file
|
@ -0,0 +1 @@
|
||||||
|
title,link,summary,published,updated
|
|
30
data/make-atom.txt
Normal file
30
data/make-atom.txt
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
(lambda (feed-ref update-time homepage entries)
|
||||||
|
(let ([feed
|
||||||
|
`(feed
|
||||||
|
((xmlns "http://www.w3.org/2005/Atom"))
|
||||||
|
(title "λ.sorrel.dev")
|
||||||
|
(link ((rel "self")
|
||||||
|
(href ,feed-ref)))
|
||||||
|
(updated ,update-time)
|
||||||
|
(author
|
||||||
|
(name "sorrel"))
|
||||||
|
(id ,homepage))])
|
||||||
|
|
||||||
|
|
||||||
|
(for-each
|
||||||
|
(lambda (entry)
|
||||||
|
(set! feed
|
||||||
|
(append feed
|
||||||
|
`((entry
|
||||||
|
(title ,(first entry))
|
||||||
|
(link ((href ,(second entry))))
|
||||||
|
(id ,(second entry))
|
||||||
|
(content ((src ,(second entry))
|
||||||
|
(type "text/html")))
|
||||||
|
(summary ,(third entry))
|
||||||
|
(published ,(fourth entry))
|
||||||
|
,(if (eq? 5 (length entry))
|
||||||
|
`(updated ,(fifth entry))
|
||||||
|
'(updated "")))))))
|
||||||
|
entries)
|
||||||
|
feed))
|
1
data/root.csv
Normal file
1
data/root.csv
Normal file
|
@ -0,0 +1 @@
|
||||||
|
id,headline,description,history->
|
|
1
data/settled.csv
Normal file
1
data/settled.csv
Normal file
|
@ -0,0 +1 @@
|
||||||
|
id,headline,description,history->
|
|
1
data/tagged.csv
Normal file
1
data/tagged.csv
Normal file
|
@ -0,0 +1 @@
|
||||||
|
tags,->
|
|
1
data/unsettled.csv
Normal file
1
data/unsettled.csv
Normal file
|
@ -0,0 +1 @@
|
||||||
|
id,headline,description,history->
|
|
190
publish-test/archive/beginning-latl.txt
Normal file
190
publish-test/archive/beginning-latl.txt
Normal file
|
@ -0,0 +1,190 @@
|
||||||
|
(article
|
||||||
|
(h1 "beginning work on LATL")
|
||||||
|
(p
|
||||||
|
"a little introduction to a project i started thinking about in early 2020,
|
||||||
|
as i was learning how to do web development and wanted to try my hand at
|
||||||
|
combining some hobbies.")
|
||||||
|
(section
|
||||||
|
(hgroup
|
||||||
|
(h2 "what even is this?")
|
||||||
|
(p (em "of linguistics and hubris."))
|
||||||
|
(hr))
|
||||||
|
(p
|
||||||
|
"so, when i was a wee little child, i discovered language. i was one of
|
||||||
|
those kids who picked up reading real quick (like before i could form
|
||||||
|
memories) and just have always been fascinated by what those words and
|
||||||
|
symbols do. like, most wee little children discover language, but some
|
||||||
|
wee little children get given the lord of the rings when they're ten or
|
||||||
|
something and get into the narrative and the characters, sure. but
|
||||||
|
those appendices.... there's .. a language here? called quenya? and
|
||||||
|
this tolkien guy just made this up? "
|
||||||
|
(small "this is not in fact how i talked as a child, just go with me."))
|
||||||
|
(p
|
||||||
|
"so, i did the precocious kid thing and said to myself \"if this dead
|
||||||
|
british weirdo (who's like really into the concept of royalty) can
|
||||||
|
make a whole new language, then surely i can to.\"")
|
||||||
|
(p
|
||||||
|
"i did not, in fact, make a language. i made a relex of the language i
|
||||||
|
already spoke (u.s. english,) but we all gotta start somewhere." )
|
||||||
|
(p
|
||||||
|
"for a long time the internet to me was mostly "
|
||||||
|
(a ((href "https://listserv.brown.edu/archives/conlang.html"))
|
||||||
|
"the brown university conlang listserv.")
|
||||||
|
" here i learned about different phonology, what the heck
|
||||||
|
morphosyntactic alignment is, diachronicity and how different
|
||||||
|
languages can be related. i got exposed to awkwords and sca2 (tools
|
||||||
|
for generating words and modeling changes to those words.) but i
|
||||||
|
never interacted with ppl much. i was a kid and the ppl in there
|
||||||
|
really knew their stuff, and i never much felt comfy with the idea
|
||||||
|
of being just "
|
||||||
|
(em "in public") " on the internet like that.")
|
||||||
|
(p
|
||||||
|
"anyway i got better at making languages and learning about how
|
||||||
|
language works, and it's just been a (at times more consistent, at
|
||||||
|
times less) hobby of mine for most of my life.")
|
||||||
|
(p
|
||||||
|
"flash forward to a few years ago, i'm working on a language that has
|
||||||
|
turned into the passion language that i've spend the majority of my
|
||||||
|
conlanging on and i'm getting frustrated with my tools. i want to do
|
||||||
|
more complex, phonological-feature-aware, sound change rules; i want
|
||||||
|
a tighter feedback loop; i want to see how a derivational pattern at
|
||||||
|
one stage in a parent form of a language branches out or collapses
|
||||||
|
into different derivational patterns in a child language.")
|
||||||
|
(p
|
||||||
|
"all was not well in my conlanging.")
|
||||||
|
(p
|
||||||
|
"i would need to " (strong "do some programming."))
|
||||||
|
(p
|
||||||
|
"the thing is, i had just learned javascript. (it was a tech bootcamp.
|
||||||
|
someday i'll talk about what a horrible decision that was, but not
|
||||||
|
in this post.) i had built a few little toy web apps, and i was not
|
||||||
|
ready to execute on a vision for a multi-purpose conlanging tool that
|
||||||
|
was beginning to take shape in my head.")
|
||||||
|
(p "i tried anyway.")
|
||||||
|
(p "and i made "
|
||||||
|
(a ((href "https://sorrelbri.github.io/feature-change-applier/"))
|
||||||
|
"a bad first draft of a sound change tool."))
|
||||||
|
(p
|
||||||
|
"there's an ebnf grammar in that project somewhere! the hubris i
|
||||||
|
had then, to think i could make a little javascript-backed
|
||||||
|
language tool with all of the bells and whistles i needed! with
|
||||||
|
the knowledge that i had then! (or more accurately, didn't have)")
|
||||||
|
(br)
|
||||||
|
(p "but now..."))
|
||||||
|
(section
|
||||||
|
(hgroup
|
||||||
|
(h2 "reviving this project")
|
||||||
|
(p (em "whatcha gonna do sorrel?"))
|
||||||
|
(hr))
|
||||||
|
(p "i'm still not ready.")
|
||||||
|
(p
|
||||||
|
"but at least, today i'm forgoing bells and whistles for
|
||||||
|
execution models. core abstractions. experience using "
|
||||||
|
(a ((href "https://racket-lang.org"))
|
||||||
|
"a (programming) language-oriented programming language")
|
||||||
|
" maybe. there's a lot to think about.")
|
||||||
|
(p
|
||||||
|
"so, i'm going to try reviving this project. or, more accurately,
|
||||||
|
reimagining this project. from the little sound change tool that
|
||||||
|
was merely an unusably buggy iteration on tools that other
|
||||||
|
conlangers had executed better, to a more robust environment for
|
||||||
|
conlanging. one which gives language nerds the power to solve
|
||||||
|
all of their language nerding problems in one runtime, with an
|
||||||
|
extensible and reflective interface. and which is written in such
|
||||||
|
a way, with the appropriate abstractions, that lanuage nerdy
|
||||||
|
hackers can hack their own tools on top of it.")
|
||||||
|
(p
|
||||||
|
"and i'm going to be doing "
|
||||||
|
(a ((href "https://www.recurse.com/"))
|
||||||
|
"a hecking hacking retreat")
|
||||||
|
" about it. i'll spend some full time programming making a goofy
|
||||||
|
little thing for goofy little language nerds surrounded by
|
||||||
|
goofy programming nerds doing whatever rad things they happen
|
||||||
|
to be getting up to when i happen to be there.")
|
||||||
|
(p
|
||||||
|
"like many of the communities i am a part of, i am a quiet part of
|
||||||
|
the conlanging community. so, we'll see how this goes. maybe it
|
||||||
|
is only ever something of interest to me and the conlangers i
|
||||||
|
interact with in meatspace. maybe it only teaches me some things
|
||||||
|
about designing and building a tool of the type that i'm designing
|
||||||
|
and building. hoooopefully it is helpful in a way to other
|
||||||
|
conlangers such that it evolves beyond what i could do on
|
||||||
|
my own (cause i ain't no whiz kid 10x programmer.)")
|
||||||
|
(p
|
||||||
|
"but that's all me getting ahead of myself (as is often my wont.)
|
||||||
|
first! to pack for the trip!"))
|
||||||
|
(section
|
||||||
|
(hgroup
|
||||||
|
(h2 "packing for the trip")
|
||||||
|
(p (em "a biggg heap of things to expand"))
|
||||||
|
(hr))
|
||||||
|
(p
|
||||||
|
"i'm just gonna fly right through these. there's going to be a lot
|
||||||
|
to read up on, to explore, to think and talk through, before it
|
||||||
|
gets time to prototyping and to building a workable tool. so,
|
||||||
|
here's the very start of the thinking-in-public. each of these
|
||||||
|
little thoughts is going to get at least it's own writeup (if not
|
||||||
|
several) and i'll update with additional sections and links to
|
||||||
|
the writeups as i go.")
|
||||||
|
(section
|
||||||
|
(h3 "notes on the goals")
|
||||||
|
(p
|
||||||
|
"it's good to have goals! to define what it even is yr tring to
|
||||||
|
do. so here's my attempt. my goal is to create a foss+ working
|
||||||
|
runtime that *can* serve as a singular tool for conlangers with
|
||||||
|
some basic programming capacity. it should be linguistically
|
||||||
|
*theory neutral* to the extant that such a thing is possible.
|
||||||
|
it should allow for the definition of all relevant structures
|
||||||
|
of a language *in code* and support the construction of grammars,
|
||||||
|
dictionaries, text documents and (stretch goal) non-programmer
|
||||||
|
friendly tools *from code*. it should support phonological,
|
||||||
|
lexical, syntactic, morphological, semantic, etc transformations
|
||||||
|
across different \"epochs\" be they diachronic or synchronic.
|
||||||
|
these transformations should work on transformations, ie
|
||||||
|
morphological transformations should themselves be transformed
|
||||||
|
by phonological transformations. users of the tool should be
|
||||||
|
able to edit their work and see the consequences of their changes
|
||||||
|
quickly. hopefully, this can all happen on the web, i guess,
|
||||||
|
cause ppl like using their browser as the everything app. ")
|
||||||
|
(section
|
||||||
|
(h3 "notes on existing tools")
|
||||||
|
(p
|
||||||
|
"i'm going to talk a bunch about existing tools made by
|
||||||
|
conlangers or made for professional linguists and used by
|
||||||
|
conlangers or just yr regular old spreedsheets and such. i'm
|
||||||
|
going to be doing some research about how conlangers do their
|
||||||
|
conlanging, lest this truly be a just-for-me type project."))
|
||||||
|
(section
|
||||||
|
(h3 "notes on primitives")
|
||||||
|
(p
|
||||||
|
"i think some interesting things start to bubble out of some of
|
||||||
|
those goals up there. like the idea of supporting a bunch of
|
||||||
|
different kinds of transformations that should themselves be
|
||||||
|
transformable. the primitives we're working with have to work
|
||||||
|
below the level of \"lexeme\" or \"phoneme\" to have something
|
||||||
|
abstract that can apply to both. i'm not going to get into
|
||||||
|
specifics even a little bit at this point-you'll have to stay
|
||||||
|
tuned for more.")))
|
||||||
|
(section
|
||||||
|
(h3 "notes on execution model"))
|
||||||
|
(section
|
||||||
|
(h3 "notes on reflectivity and interaction"))
|
||||||
|
(section
|
||||||
|
(h3 "notes on portability"))
|
||||||
|
(section
|
||||||
|
(h3 "notes on the substratum (racket?)")))
|
||||||
|
(section
|
||||||
|
(hgroup
|
||||||
|
(h2 "about the name")
|
||||||
|
(p (em "it's pronouced ˈlæ.ɾɫ̩"))
|
||||||
|
(hr))
|
||||||
|
(p
|
||||||
|
"i don't know dude, naming things is hard. it's a working name,
|
||||||
|
it works good as an extension. "
|
||||||
|
(code "my-conlang.latl") "anyone?")
|
||||||
|
(p
|
||||||
|
"i also just like syllabic laterals? they sound neat to me. the
|
||||||
|
official initialism is _l_inguistic _a_nalytic _t_ransformation
|
||||||
|
_l_anguage, but it also double entendres to _l_ower _a_nterior
|
||||||
|
_t_emporal _l_obe, so that's just kind of fun.")
|
||||||
|
(p "maybe it'll have a different name some day, idk")))
|
5
publish-test/data/atom.csv
Normal file
5
publish-test/data/atom.csv
Normal file
|
@ -0,0 +1,5 @@
|
||||||
|
title,link,summary,published,updated
|
||||||
|
beginning latl,https://sorrel.dev/unsettled/5,beginning the process of thinking through an environment for conlanging and other language shenanigans,2023-11-08T22:49:41
|
||||||
|
beginning latl,https://sorrel.dev/unsettled/5,beginning the process of thinking through an environment for conlanging and other language shenanigans,2023-11-08T22:41:52
|
||||||
|
beginning latl,https://sorrel.dev/unsettled/5,beginning the process of thinking through an environment for conlanging and other language shenanigans,2023-11-08T22:41:24
|
||||||
|
beginning latl,https://sorrel.dev/unsettled/5,beginning the process of thinking through an environment for conlanging and other language shenanigans,2023-11-08T15:51:25
|
|
30
publish-test/data/make-atom.txt
Normal file
30
publish-test/data/make-atom.txt
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
(lambda (feed-ref update-time homepage entries)
|
||||||
|
(let ([feed
|
||||||
|
`(feed
|
||||||
|
((xmlns "http://www.w3.org/2005/Atom"))
|
||||||
|
(title "λ.sorrel.dev")
|
||||||
|
(link ((rel "self")
|
||||||
|
(href ,feed-ref)))
|
||||||
|
(updated ,update-time)
|
||||||
|
(author
|
||||||
|
(name "sorrel"))
|
||||||
|
(id ,homepage))])
|
||||||
|
|
||||||
|
|
||||||
|
(for-each
|
||||||
|
(lambda (entry)
|
||||||
|
(set! feed
|
||||||
|
(append feed
|
||||||
|
`((entry
|
||||||
|
(title ,(first entry))
|
||||||
|
(link ((href ,(second entry))))
|
||||||
|
(id ,(second entry))
|
||||||
|
(content ((src ,(second entry))
|
||||||
|
(type "text/html")))
|
||||||
|
(summary ,(third entry))
|
||||||
|
(published ,(fourth entry))
|
||||||
|
,(if (eq? 5 (length entry))
|
||||||
|
`(updated ,(fifth entry))
|
||||||
|
'(updated "")))))))
|
||||||
|
entries)
|
||||||
|
feed))
|
2
publish-test/data/root.csv
Normal file
2
publish-test/data/root.csv
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
id,headline,description,history->
|
||||||
|
this,this website's internals,how i built this website and why i built it the way i did
|
|
3
publish-test/data/settled.csv
Normal file
3
publish-test/data/settled.csv
Normal file
|
@ -0,0 +1,3 @@
|
||||||
|
id,headline,description,history->
|
||||||
|
1,fca,the feature change applier i built as a baby developer
|
||||||
|
2,latl proto-prototype,a first pass at proving some ideas for latl
|
|
4
publish-test/data/tagged.csv
Normal file
4
publish-test/data/tagged.csv
Normal file
|
@ -0,0 +1,4 @@
|
||||||
|
tags,->
|
||||||
|
latl,unsettled/5,unsettled/5,unsettled/5,settled/2,unsettled/3,settled/1,unsettled/2,unsettled/1
|
||||||
|
conlang,unsettled/5,unsettled/5,unsettled/5,unsettled/3,unsettled/1
|
||||||
|
brain,unsettled/4
|
|
5
publish-test/data/test.csv
Normal file
5
publish-test/data/test.csv
Normal file
|
@ -0,0 +1,5 @@
|
||||||
|
id,headline,description
|
||||||
|
1,beginning latl,an introduction to a project focused on linguistics and conlanging
|
||||||
|
2,evaluation models,working through possible evaluation models for latl
|
||||||
|
3,existing conlanging tools,an overview of some tools that are out there for conlanging (and legit lingustics)
|
||||||
|
4,a note about brains,so i've got some diagnoses and some experiences and some notes
|
|
5
publish-test/data/unsettled.csv
Normal file
5
publish-test/data/unsettled.csv
Normal file
|
@ -0,0 +1,5 @@
|
||||||
|
id,headline,description,history->
|
||||||
|
1,beginning latl,an introduction to a project focused on linguistics and conlanging
|
||||||
|
2,evaluation models,working through possible evaluation models for latl
|
||||||
|
3,existing conlanging tools,an overview of some tools that are out there for conlanging (and legit lingustics)
|
||||||
|
4,a note about brains,so i've got some diagnoses and some experiences and some notes
|
|
1
publish-test/source/feed.atom
Normal file
1
publish-test/source/feed.atom
Normal file
|
@ -0,0 +1 @@
|
||||||
|
<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom"><title>λ.sorrel.dev</title><link rel="self" href="https://sorrel.dev/feed.atom"/><updated>2023-11-08T22:49:41</updated><author><name>sorrel</name></author><id>https://sorrel.dev</id><entry><title>beginning latl</title><link href="https://sorrel.dev/unsettled/5"/><id>https://sorrel.dev/unsettled/5</id><content src="https://sorrel.dev/unsettled/5" type="text/html"></content><summary>beginning the process of thinking through an environment for conlanging and other language shenanigans</summary><published>2023-11-08T22:49:41</published><updated></updated></entry><entry><title>beginning latl</title><link href="https://sorrel.dev/unsettled/5"/><id>https://sorrel.dev/unsettled/5</id><content src="https://sorrel.dev/unsettled/5" type="text/html"></content><summary>beginning the process of thinking through an environment for conlanging and other language shenanigans</summary><published>2023-11-08T22:41:52</published><updated></updated></entry><entry><title>beginning latl</title><link href="https://sorrel.dev/unsettled/5"/><id>https://sorrel.dev/unsettled/5</id><content src="https://sorrel.dev/unsettled/5" type="text/html"></content><summary>beginning the process of thinking through an environment for conlanging and other language shenanigans</summary><published>2023-11-08T22:41:24</published><updated></updated></entry><entry><title>beginning latl</title><link href="https://sorrel.dev/unsettled/5"/><id>https://sorrel.dev/unsettled/5</id><content src="https://sorrel.dev/unsettled/5" type="text/html"></content><summary>beginning the process of thinking through an environment for conlanging and other language shenanigans</summary><published>2023-11-08T15:51:25</published><updated></updated></entry></feed>
|
1
publish-test/source/unsettled/5.txt
Normal file
1
publish-test/source/unsettled/5.txt
Normal file
File diff suppressed because one or more lines are too long
261
publish.rkt
Normal file
261
publish.rkt
Normal file
|
@ -0,0 +1,261 @@
|
||||||
|
#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)
|
Loading…
Reference in a new issue