create publish script

data/atom.csv

@@ -0,0 +1 @@
+title,link,summary,published,updated

data/make-atom.txt

@@ -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))

data/root.csv

@@ -0,0 +1 @@
+id,headline,description,history->

data/settled.csv

@@ -0,0 +1 @@
+id,headline,description,history->

data/tagged.csv

@@ -0,0 +1 @@
+tags,->

data/unsettled.csv

@@ -0,0 +1 @@
+id,headline,description,history->

publish-test/archive/beginning-latl.txt

@@ -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")))

publish-test/data/atom.csv

@@ -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

publish-test/data/make-atom.txt

@@ -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))

publish-test/data/root.csv

@@ -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

publish-test/data/settled.csv

@@ -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

publish-test/data/tagged.csv

@@ -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

publish-test/data/test.csv

@@ -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

publish-test/data/unsettled.csv

@@ -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

publish-test/source/feed.atom

@@ -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>

publish.rkt

@@ -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)