create modify script

.dev-log

@@ -1,11 +1,60 @@
-10/12/2023
+2024/01/14
+
+
+2024/01/13
+- update atom-table-writing
+- finish atom-feed-recreation in modify
+- modify functionality complete
+- START HERE:
+  - update all references to old url
+- TODO:
+  - add content in atom <entry><content /></>
+  - re-publish stuff in publish branch
+
+2024/01/11
+- rebuilding post-footer
+- created tools/utils.rkt to put utils shared between modify
+  and publish (includes new url)
+- update-atom-table writing
+- START HERE:
+  - update-atom-table needs description for post
+
+2024/01/08
+- rb-thunks accumulating via compose
+- update-res-table now adding update-history to data/<resource>.csv
+- started loading tag-list for rebuilding post-footer
+- START HERE:
+  - rebuild post-footer
+  - update-atom-table
+- TODO:
+  - update all references to old url (especially in atom feed)
+  - update light-mode style
+
+2024/01/07
+- returning to project
+- refactor get-res-table and get-output-file for returning input and output ports
+  - rb thunk will require read from input-file-port to rewrite contents on fail
+- TODO:
+  - initialize rb-thunks and ensure they accumulate on passage to each handler
+
+2023/12/30
+- starting work on "modify" script
+- custom errors that emit a list of "rollback thunks" to enable resetting
+  to prior state if any error is raised
+
+2023/12/21
+- broke "about" into smaller sections and linked from "/"
+- removed "about" from header - now just [settled | unsettled | feed]
+- added "now" and "this" sections and linked from "/"
+
+2023/12/10
 - added resource/index builder to publish script
 
-4/12/2023
+2023/12/04
 - added function to build index source xexpr file for tagged/'tag
   - fixed tagged/ index source xexpr printing to file so that it can be read
 
-30/11/2023
+2023/11/30
 - added function to build an index source xexpr file for tagged/
   - have not tested to see if it builds tagged/ properly yet
 

.idea-log

@@ -0,0 +1,12 @@
+21/12/2023
+- beginning latl effectively finished and ready for post once ci is fixed
+- projects to write about
+  - input-messenger
+  - there-is-something-inside-me-that-has-no-name
+  - cnc
+- blogs to write
+  - conlanging tools
+  - latl primitives
+  - latl execution model
+  - thoughts on clj?
+  - some media crit?

data/tagged.csv

@@ -1,3 +1 @@
 tags,->
-latl,unsettled/1
-conlang,unsettled/1

data/unsettled.csv

@@ -1,2 +1 @@
 id,headline,description,history->
-1,Beginning LATL,beginning the process of thinking through an environment for conlanging and other language shenanigans,2023-12-04T15:20:53

in-progress/beginning-latl.txt

@@ -3,30 +3,29 @@
  (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.")
+   combining some hobbies")
- (section
+ (p (a ((href "#the-point")) "skip the story and get to the point"))
+ (section ((id "the-story"))
   (hgroup
    (h2 "what even is this?")
-   (p (em "of linguistics and hubris."))
+   (p (em "a story of linguistics and hubris"))
    (hr))
   (p
-   "so, when i was a wee little child, i discovered language. i was one of
+   "so, when i was a wee little child, i discovered language. like, most
-    those kids who picked up reading real quick (like before i could form
+    wee little children discover language, but some wee little children
-    memories) and just have always been fascinated by what those words and
+    get given the lord of the rings when they're ten or something and get
-    symbols do. like, most wee little children discover language, but some
+    into the narrative and the characters, sure. but those appendices....
-    wee little children get given the lord of the rings when they're ten or
+    there's .. a language here? called quenya? and it's written in this
-    something and get into the narrative and the characters, sure. but
+    script? called tengwar? and there's a related language, sindarin? and
-    those appendices.... there's .. a language here? called quenya? and
+    this tolkien guy just made all this up? ")
-    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.\"")
+    make a whole new language, then surely i can too\"")
   (p
-   "i did not, in fact, make a language. i made a relex of the language i
+   "i did not, in fact, make a language. i made a relex of the language
-    already spoke (my own peculiar idiolect of u.s. english,) but we all
+    i already spoke (my own peculiar idiolect of u.s. english,) but we all
-    gotta start somewhere." )
+    gotta start somewhere" )
   (p
    "for a long time the internet to me was mostly "
    (a ((href "https://listserv.brown.edu/archives/conlang.html"))
@@ -38,52 +37,55 @@
     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.")
+   (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
+    language works, and it's just been a (sometimes more consistent, at
-    times less) hobby of mine for most of my life.")
+    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 project that i've spend the majority of my
-    conlanging on and i'm getting frustrated with my tools. i want to do
+    conlanging on and i'm getting frustrated with my tools. other
-    more complex, phonological-feature-aware, sound change rules; i want
+    conlangers have made some really cool tools that i've used forever,
-    a tighter feedback loop; i want to see how a derivational pattern at
+    but i wanted to change my workflow. i wanted to do more complex,
-    one stage in a parent form of a language branches out or collapses
+    phonological-feature-aware, sound change rules; i wanted diachroinc
-    into different derivational patterns in a child language.")
+    tooling for morhposyntactic bits of my languages; i wanted a tighter
+    feedback loop between defining some changes, or lexical items, or
+    whathave you, and seeing the results; i wanted 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.")
+   "all was not well in my conlanging")
   (p
-   "i would need to " (strong "do some programming."))
+   "i would need to " (strong "do some programming"))
   (p
-   "the thing is, i had just learned javascript. (it was a tech bootcamp.
+   "the thing is, i had just learned javascript. i had built a few
-    someday i'll talk about my ~feelings~ about ~that~, but not here, not
+    little toy web apps, and i was not ready to execute on a vision
-    now.) i had built a few little toy web apps, and i was not ready to
+    for a multi-purpose conlanging tool that was beginning to take shape in my head")
-    execute on a vision for a multi-purpose conlanging tool that was
+  (p "i tried anyway")
-    beginning to take shape in my head.")
-  (p "i tried anyway.")
   (p "and i made "
      (a ((href "settled/1"))
-        "a bad first draft of a sound change tool."))
+        "a bad first draft of a sound change tool"))
   (p
-   "there's an ebnf grammar in that project somewhere! the hubris i
+   "there's an e-bnf 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
+ (section ((id "the-point"))
   (hgroup
    (h2 "reviving this project")
    (p (em "whatcha gonna do sorrel?"))
    (hr))
-  (p "i'm still not ready.")
+  (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.")
+   " 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
@@ -93,7 +95,7 @@
     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.")
+    hackers can hack their own tools on top of it")
   (p
    "and i'm going to be doing "
    (a ((href "https://www.recurse.com/"))
@@ -101,7 +103,7 @@
    " about it. i'll spend some full-time programming days 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.")
+    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
@@ -110,7 +112,7 @@
     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.)")
+    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!"))
@@ -126,7 +128,9 @@
     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.")
+    the writeups as i go. a note: it would be impossible for me (and
+    probably most ppl) to create the full vision in the time i'll be
+    working on it fulltime")
   (section
    (h3 "notes on the goals")
    (p
@@ -146,7 +150,7 @@
      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. ")
+     cause ppl like using their browser as the everything app"))
   (section
    (h3 "notes on existing tools")
    (p
@@ -154,7 +158,7 @@
      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."))
+     conlanging, lest this truly be a just-for-me type project"))
   (section
    (h3 "notes on primitives")
    (p
@@ -165,23 +169,52 @@
      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.")))
+     tuned for more"))
   (section
    (h3 "notes on execution model")
    (p
-    "this is going to be some crunchy computer language stuff. i'm
+    "this is going to be the crunchiest stuff to think about. i'm
      going to make some arguments for some things that (it is my
      belief) fall out of these goals. things like dynamic typing.
      things like reflectivity (this is sooo important it gets its
      own section.) things like lazy evaluation (because languages
      are big and sometimes you only want to look at a subset of a
-     language.) means of combination: propositions.")
+     language.) there's also some hypothetical notions that will
+     require some experiments to determine applicability to the
+     project. i'm just going to list them as questions and not
+     expound upon or defend their existence as questions here:
+     propositions as a means of combination? propagation networks
+     as primitives?"))
   (section
-   (h3 "notes on reflectivity and interaction"))
+   (h3 "notes on reflectivity and interaction")
+   (p
+    "this is so important! i want conlangers to use this tool to
+     iterate and that requires ~something like a REPL~ in a
+     dynamic environment. my dream is to have a bidirectional
+     flow of information; whereby a user of the system can define
+     some rules about their language, evaluate those rules on some
+     data in an interpreter, inspect those data, modify those data
+     and run the interpreter such that it produces possible rules
+     that would yield the new result. wether or not that experience
+     results from the project, users should be able to rebind
+     anything their project needs *at runtime*"))
   (section
-   (h3 "notes on portability"))
+   (h3 "notes on portability")
+   (p
+    "as the project develops i will have to give some thought to
+     how to make it available to conlangers with different kinds
+     of computation experience. the ideal would be for a full
+     featured web implementation that interoperates with hosted
+     implementations, but we'll see"))
   (section
-   (h3 "notes on the substratum (racket?)")))
+   (h3 "notes on the substrate")
+   (p
+    "not a lot to say here. i will begin this project in racket
+     because i have some familiarity with it and it is
+     specifically built for developing languages. i will be using
+     other tools to explore other aspects of the project and may
+     ultimately move away from the racket ecosystem, but a girl
+     has gotta start somewhere")))
  (section
   (hgroup
    (h2 "about the name")
@@ -193,7 +226,12 @@
    (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
+    official initialism is " (u "l") "inguistic " (u "a") "nalytic "
-    _l_anguage, but it also double entendres to _l_ower _a_nterior
+    (u "t") "ransformation " (u "l") "anguage, but it also double
-    _t_emporal _l_obe, so that's just kind of fun.")
+    entendres to " (u "l") "ower " (u "a" ) "nterior " (u "t")
-  (p "maybe it'll have a different name some day, idk"))))
+    "emporal " (u "l" ) "obe, so that's just kind of fun.")
+  (p
+   "and the l means there can be lambda iconography-this is crucial
+    for a new computer project. [ˈλæ.ɾɫ̩] as a typographic image is
+    so perfectly specific to the kinds of things i dream about.")                             
+  (p "maybe it'll have a different name some day, idk")))

in-progress/contact.txt

@@ -0,0 +1,12 @@
+(section
+ (h2 "contact")
+ (p "e-m-"
+    (span "a-i")
+    (span "-l [ at ")
+    (span "] s-o-")
+    (span "r-r-e-l [ d o")
+    (span "t ] d-e")
+    (span "-v is a good place to do the email"))
+ (p
+  "i have avoided 'online' for a long time, but i'm getting hip to it. i'm
+   on the big mastodon server @oxaliq"))

in-progress/links.txt

@@ -0,0 +1,8 @@
+(section
+ (hgroup
+  (h2 "links")
+  (p "contributing to the hyper-fication of the hypermedia"))
+ (p "propjects that i think are cool"
+    (ul (li "")))
+ (p "communities that i think are neat"
+    (ul (li ""))))

in-progress/now.txt

@@ -0,0 +1,39 @@
+(section
+ (hgroup
+  (h2 "now")
+  (p "a snapshot of the (mostly) non-computer things of import"))
+ (section
+  (hgroup
+   (h3 "read")
+   (p "stuff i'm taking in"))
+  (ul (li "the paying guests, sarah waters")
+      (li "females, andrea long chu")
+      (li "palo alto, malcolm harris")
+      (li "high pitched and moist, tami t")
+      (li "desolation's flower, ragana")
+      (li "salesforce, lauren bousfield")
+      (li "el mal querer, rosalía")
+      (li "guacamelee, drinkbox")))
+ (section
+  (hgroup
+   (h3 "eval")
+   (p "stuff i'm crunching on"))
+  (ul (li "playing more go")
+      (li "winter garden chores")
+      (li "starting a community maker space")
+      (li "going on more hikes")
+      (li "body stuff")))
+ (section
+  (hgroup
+   (h3 "print")
+   (p "stuff i'm putting out"))
+  (ul (li "fun leatherwork")
+      (li "fun woodwork")
+      (li "relearning how to draw")))
+ (section
+  (hgroup
+   (h3 "loop")
+   (p "stuff what's on the horizon"))
+  (ul (li "being in the northeastern us")
+      (li "putting my labor on the market")
+      (li "maybe making some music again?"))))

in-progress/this.txt

@@ -0,0 +1,36 @@
+(section
+ (hgroup
+  (h2 "how this site")
+  (p "some kind of colophon"))
+ (p
+  "all of the code for the website is hosted and deployed from tree, "
+  (a ((href "https://git.bunk.computer/oxaliq/sorrel.dev"))
+     "bunk computer club's git forge")
+  "i do almost everything in the main branch, cause it's just me and that way
+   i can add links below to the in-progress stuff real easy")
+ (p
+  "first, this website doesn't do anything to know who you are or anything.
+   this website is a ~20MB binary and some static resources. it is built
+   primarily with "
+  (a ((href "https://docs.racket-lang.org/web-server/"))
+     "racket web-server"))
+ (p
+  "this website serves ~46kB of javascript in the form of "
+  (a ((href "https://htmx.org/"))
+     "the htmx library (minified.)")
+  " i don't love serving minified code. forking the library and removing
+   features that are of no use to me is on the agenda for 2024")
+ (p
+  "everything here is hosted on turtle, "
+  (a ((href "https://wiki.bunk.computer/hypha/servers"))
+     "bunk computer club's shared application server"))
+ (p
+  "there's some racket scripts i use for tooling that were made with "
+  (a ((href "https://docs.racket-lang.org/cli/"))
+     "#lang cli"))
+ (p (a ((href "https://git.bunk.computer/oxaliq/sorrel.dev/src/branch/main/.dev-log"))
+       "you can read about development here"))
+ (p (a ((href "https://git.bunk.computer/oxaliq/sorrel.dev/src/branch/main/.idea-log"))
+       "you can read about my vague plans here"))
+ (p (a ((href "https://git.bunk.computer/oxaliq/sorrel.dev/src/branch/main/in-progress"))
+       "or read works in progress here")))

in-progress/very-earnest-disclaimer.txt

@@ -0,0 +1,26 @@
+(section
+ (h2 "a very earnest disclaimer")
+ (p
+  "i like to talk about computation with ppl! but it is important for me that
+   you know: i am new to all this! i did not think computers or software were
+   ^for me^ and then i had to get good at spreadsheets at my first email-factory
+   job and then i got curious about webdev and now i have reached terminal
+   velocity down a very λ.particular.rabbit[hole]")
+ (p
+  "i think computation is both fascinating on its own terms and as a substrate
+   for pro-social infrastructure. i am motivated to work on projects that
+   engage with this possiblity")
+ (p
+  "i'm not very good at many things. i don't even have a math education or a
+   degree in anything. have you ever met someone who *is* good at _all_ ^this^
+   ~stuff~ ???")
+ (p
+  "i like thinking in public, but please be patient! with me and with
+   everyone else you talk about things you care about with")
+ (p "let's hold our strong opinions loosely!")
+ (p "and first assume good faith from each other!")
+ (br)
+ (br)
+ (p ((class "ascii but-normal-size"))
+    "   ⃔‥̺⃝⃕")
+ (br))

modify.rkt

@@ -0,0 +1,401 @@
+#lang cli
+
+(require (only-in racket/date current-date date->string date-display-format)
+         (only-in racket/string string-join non-empty-string?)
+         (only-in racket/list first second third fourth fifth last take drop flatten add-between)
+         (only-in racket/format ~a)
+         (only-in racket/exn exn->string)
+         (only-in racket/function thunk identity)
+         (only-in csv-reading csv->list)
+         (only-in xml read-xml)
+         (only-in "./tool/utils.rkt" list->csv resource-link atom-table-entry add-atom-entry make-feed))
+
+(define-namespace-anchor anc)
+(define ns (namespace-anchor->namespace anc))
+
+(define homepage "https://sorrel.dev")
+
+
+;; modify needs to
+
+;: - take an input file (from archive/), build a source file in the appropriate place in source/
+
+;; - update the line for the resource in the read-table for resource type, adding the modified date
+;; this will not! (for now) update the <resource>/index or tagged/<tag>/index pages !
+;; (these pages do not currently show post history)
+
+;; - update the atom.txt feed
+
+;; example
+;; modify -input-file in-progress/beginning-latl.txt --resource-type unsettled
+;; --headline "Beginning LATL" 
+;; publish -i in-progress/beginning-latl.txt -r unsettled -l "Beginning LATL"
+
+(help (usage "modify is here to update existing posts with new content."))
+
+
+(flag (resource-type #:param [resource-type ""] t)
+      ("-r" "--resource-type" "Type of resource [settled|unsettled|root]")
+      (resource-type (cond
+                       [(equal? t "settled") "settled"]
+                       [(equal? t "unsettled") "unsettled"]
+                       [(equal? t "root") "root"]
+                       [else (error 'failure "couldn't recognize resource. please use one of 'settled' 'unsettled' 'root'")])))
+       
+(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 (test-mode)
+      ("-x" "--test-mode" "updates only in test directory")
+      (test-mode #t))
+
+(program
+ (modify)
+ (let ([n-in (input)]
+       [r-type (resource-type)]
+       [l-head (headline)]
+       [x-test (test-mode)]
+       [update-time (date->string (current-date) (date-display-format 'iso-8601))]
+       [rollback-thunks (list)])
+   (displayln "running modify")
+   
+   
+   ;; getting existing file ports
+   ;; ---------------------------
+   ;; if any of these fail to match, exit modify
+   ;; must use #:exists 'update
+   ;; this throws an exception if the file does not exist, but it must be manually
+   ;; truncated. using #:exists 'must-truncate guarantees file exists, but truncates
+   ;; prior to data being read from file
+   
+   ;; locate existing post in source
+   ;; (. -> . input-port? output-port?)
+   (define (get-source-ports)
+     (let ([file-handle  (path-add-extension
+       (if (eq? r-type "root")
+           (if x-test
+               (build-path "publish-test" "source" l-head)
+               (build-path "source" l-head))
+           (if x-test
+               (build-path "publish-test" "source" r-type l-head)
+               (build-path "source" r-type l-head)))
+       #".txt")])
+       (values
+        (open-input-file file-handle)
+        (open-output-file file-handle #:exists 'update))))
+
+   ;; locate data/resource table
+   ;; (. -> . input-port? output-port?)
+   (define (get-res-table-ports)
+     (let ([file-handle (path-add-extension
+                         (if x-test
+                             (build-path "publish-test" "data" r-type)
+                             (build-path "data" r-type))
+                         #".csv")])
+        (values
+         (open-input-file file-handle)
+         (open-output-file file-handle #:exists 'update))))
+
+   ;; locate data/atom table
+   ;; (. -> . input-port? output-port?)
+   (define (get-atom-table-ports)
+     (let ([file-handle (path-add-extension
+                         (if x-test
+                             (build-path "publish-test" "data" "atom")
+                             (build-path "data" "atom"))
+                         #".csv")])
+       (values
+        (open-input-file file-handle)
+        (open-output-file file-handle #:exists 'update))))
+
+   ;; locate source/feed.atom feed
+   ;; (. -> . input-port? output-port?)
+   (define (get-atom-feed-ports)
+     (let ([file-handle (path-add-extension
+                         (if x-test
+                             (build-path "publish-test" "source" "feed")
+                             (build-path "source" "feed"))
+                         #".atom")])
+       (values
+        (open-input-file file-handle)
+        (open-output-file file-handle #:exists 'update))))
+
+   ;; get make-atom.txt input-port
+   ;; (. -> . input-port?)
+   (define (get-make-atom-input-port)
+     (let ([file-handle (path-add-extension
+                         (if x-test
+                             (build-path "publish-test" "data" "make-atom")
+                             (build-path "data" "make-atom"))
+                         #".txt")])
+       (open-input-file file-handle)))
+     
+   
+   (define (handle-error-getting-file expn)
+     (displayln "handle-error-getting-file")
+     (displayln expn)
+        (raise expn))
+   ;; ---------------------------
+
+   ;; other let-bindings expressions
+   ;; ------------------------------
+   (define (get-res-table-and-id res-table-input-port)
+     (let ([res-table (csv->list res-table-input-port)])
+       (values
+        res-table
+        (first
+        ;; need to handle errors
+        (findf
+         (lambda (row)
+           (equal? (second row)
+                   l-head))
+         res-table)))))
+
+
+   (define (get-tags type id)
+     (let* ([tag-file-handle (path-add-extension
+                              (if x-test
+                                  (build-path "publish-test" "data" "tagged")
+                                  (build-path "data" "tagged"))
+                              #".csv")]
+            [tag-table (csv->list (open-input-file tag-file-handle))]
+            ;; id in tagged.csv is <res>/<id>
+            [match-id (string-append type "/" id)])
+       (map
+        first
+        (filter
+         (lambda (tag-row)
+           (member match-id tag-row))
+         tag-table))))
+        
+   ;; ------------------------------
+   
+   ;; rollback execution
+   ;; ------------------
+   ;; all handlers of any exception raised after writes start occurring must evaluate
+   ;; all rollback thunks registered up to the point of exception to ensure the
+   ;; file system returns to its pre-script execution state. this is written to handle
+   ;; any exceptions raised in rollback thunks and retry indefinitely. if there is an
+   ;; unresolvable issue, the script will need to be manually exited and the resulting
+   ;; mess cleaned up.
+   (define (rollback-exec rb-thunks)
+     (for-each
+      (lambda (th)
+        (call-with-exception-handler
+         (lambda (expn)
+           (displayln (~a "encountered error" (exn->string expn)))
+           (displayln (~a "running " th " again"))
+           (th)))
+         th)
+      rb-thunks))
+   ;; ------------------
+
+   ;; file-writing
+   ;; ------------
+   ;; generic file writing and exceptions
+   (struct file-write-exception exn:fail:filesystem (rb-thunks))
+
+   ;; handler must unwrap file-write-exception, evaluate all rb-thunks, and raise
+   ;; exception value
+   (define (handle-file-write-exception expn)
+     (let ([rb-thunks (file-write-exception-rb-thunks expn)])
+       (rollback-exec rb-thunks)
+       (raise (exn:fail (exn-message expn) (current-continuation-marks)))))
+
+   ;; write-to-file must manually truncate since out-ports do not truncate
+   ;; (output-port? xexpr? xexpr? rb-thunks? . -> . rb-thunks?)
+   (define (write-to-file out-port new-content old-content accumulator)
+     (let ([rb-thunks (cons (thunk (write-to-file-with-retries out-port old-content))
+                            (hash-ref accumulator 'rb-thunks))])
+       (if (port-try-file-lock? out-port 'exclusive)
+           ;; wrap in handler that raises file-write-exception
+           (begin
+             (call-with-exception-handler
+              (lambda (expn)
+                (raise (file-write-exception (exn-message expn)
+                                             (current-continuation-marks)
+                                             rb-thunks)))
+              (thunk
+               (file-truncate out-port 0)
+               (display new-content out-port)
+               (port-file-unlock out-port)
+               (close-output-port out-port)))
+             (hash-update accumulator 'rb-thunks
+                          (lambda (r) rb-thunks)))
+           (raise (file-write-exception
+                   (~a "couldn't obtain file lock on " out-port)
+                   (current-continuation-marks)
+                   rb-thunks)))))
+
+   (define (write-to-file-with-retries out-port content)
+     (with-handlers
+         ([file-write-exception? (lambda (expn)
+                                   (displayln "filewrite failed with" expn)
+                                   (displayln "retrying")
+                                   (write-to-file-with-retries out-port content))])
+       (write-to-file out-port content)))
+   ;; ------------
+    
+   ;; resource-replacement
+   ;; --------------------
+   ;; replace resource in source/<type>/id
+   (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))))
+
+
+   ;; returns lambda that takes res-table to be passed into replace-resource
+   ;; as make-new-content
+   (define (get-new-content source-input-port tag-list id)
+     (let ([new-content-sans-footer (read (open-input-file n-in))])
+       (lambda (res-table)
+         (let ([history-list (drop
+                              (findf (lambda (row) (equal? (first row) id))
+                                     res-table)
+                              3)])
+           (append-post-footer new-content-sans-footer tag-list history-list)))))
+   
+
+   ;; replace-resource compose chain expression
+   (define (replace-resource source-input-port source-output-port make-new-content id)
+     (let ([old-content (read source-input-port)])
+       (lambda (accumulator)
+         (let ([res-table (hash-ref accumulator 'res-table)])
+         (hash-update
+          (hash-remove
+          (write-to-file
+           source-output-port
+           (make-new-content res-table)
+           old-content accumulator)
+          'res-table)
+         'resource
+         identity
+         (findf (lambda (row) (equal? (first row) id)) res-table))))))
+   ;; --------------------
+
+
+   ;; res-table update
+   ;; ----------------
+   (define (update-res-table-with-modification old-res-table id)
+     (map
+      (lambda (row)
+        (if (equal? (first row) id)
+            (flatten (list (take row 3)
+                 update-time
+                 (drop row 3)))
+            row))
+      old-res-table))
+
+   (define (get-publish-time res-table id)
+     (last (findf (lambda (row) (equal? (first row) id))
+                    res-table)))
+   
+   ;; update-res-table compose chain expression
+   (define (update-res-table old-table rt-output-port id)
+     (let* ([new-table (update-res-table-with-modification old-table id)]
+            [new-content (list->csv new-table)]
+            [publish-time (get-publish-time old-table id)])
+       (lambda (accumulator)
+         (hash-update
+          (hash-update
+           (write-to-file rt-output-port new-content old-table accumulator)
+           'res-table
+           identity
+           new-table)
+          'publish-time
+          identity
+          publish-time))))
+   ;; ----------------
+
+   ;; atom-table update
+   ;; -----------------
+   (define (update-atom-table at-input-port at-output-port res-link)
+     (let ([old-table (csv->list at-input-port)])                                       
+       (lambda (accumulator)
+         (let* ([res-row (hash-ref accumulator 'resource)]
+                [desc (third res-row)]
+                [publish-time (hash-ref accumulator 'publish-time)]
+                [new-table (add-atom-entry old-table
+                                       (atom-table-entry l-head res-link desc publish-time update-time))])
+           (hash-remove
+            (hash-remove
+             (hash-update
+              (write-to-file at-output-port (list->csv new-table) old-table accumulator)
+              'atom-table
+              identity
+              new-table)
+             'resource)
+            'publish-time)))))
+   ;; -----------------
+
+   ;; atom feed update
+   ;; ----------------
+   (define (update-atom-feed af-input-port af-output-port make-af-input-port)
+     (let* ([old-feed (read-xml af-input-port)])
+       (lambda (accumulator)
+         (let* ([atom-table (hash-ref accumulator 'atom-table)]
+                [new-feed (make-feed ns make-af-input-port atom-table update-time #:homepage homepage)])
+           (write-to-file af-output-port new-feed old-feed accumulator)))))
+
+   ;; ----------------
+
+   ;; accumulator piped through compose chain
+   ;; needed for passing data as well as for accumulating rollback thunks
+   (define (compose-accumulator rb-thunks)
+     (hash 'rb-thunks rb-thunks))
+
+     
+
+   ;; run modify with exception handlers
+   ;; ----------------------------------
+   ;; handlers evaluate rollback thunks in order before raising exception
+   ;; to terminate script
+   (with-handlers
+       ;; failure to locate one of the necessary existing files
+       ([exn:fail:filesystem? handle-error-getting-file]
+        ;; failure to write updates to existing file
+        [file-write-exception? handle-file-write-exception])
+     (let*-values
+         ;; none of the expressions in let-bindings mutate the filesystem
+         ([(source-input-port source-output-port) (get-source-ports)]
+          [(res-table-input-port res-table-output-port) (get-res-table-ports)]
+          [(atom-table-input-port atom-table-output-port) (get-atom-table-ports)]
+          [(atom-feed-input-port atom-feed-output-port) (get-atom-feed-ports)]
+          [(make-atom-input-port) (get-make-atom-input-port)]
+          [(old-res-table id) (get-res-table-and-id res-table-input-port)]
+          [(res-link) (resource-link r-type id #:homepage homepage)]
+          [(tags) (get-tags r-type id)]
+          [(new-content) (get-new-content source-input-port tags id)])
+
+
+       ;; compose chain pipes (hash? accumulator) through each expression
+       ;; at minimum accumulator must contain k-v ('rb-thunks . (list proc? . rest)
+       ((compose
+         (update-atom-feed atom-feed-input-port atom-feed-output-port make-atom-input-port)
+         (update-atom-table atom-table-input-port atom-table-output-port res-link)
+         ;; see above
+         (replace-resource source-input-port source-output-port new-content id)
+         (update-res-table old-res-table res-table-output-port id))
+        (compose-accumulator rollback-thunks)))) 
+       
+   ;; 
+   ))
+
+;(run modify)
+
+(run modify #("-i" "in-progress/now.txt"
+              "-l" "now"
+              "-r" "root"
+              "-x"))

source/about.txt

@@ -1,101 +1,52 @@
-(main
+(section
- (p "what do you want to know?")
+ (h2 "a λ.functional λ.gay")
- (section
+ (p "i'm a gay lil nerd who's learning everyday about community, and ecology,
-  (h1 "about sorrel")
-  (p "i'm a gay lil nerd who's learning everyday about community, and ecology,
      and computer; and trying hard to be good for the world with my gay lil
-     friends.")
+     friends")
-  (p "i was named after "
+ (p "i was named after "
-   (a ((href "https://plants.usda.gov/home/plantProfile?symbol=OXOR"))
+    (a ((href "https://plants.usda.gov/home/plantProfile?symbol=OXOR"))
-      "a plant called sorrel")
+       "a plant called sorrel")
-   " and i live in the mountains of southern appalachia on "
+    " and i live in the mountains of southern appalachia on "
-   (span ((lang "chr")) "ᏣᎳᎩ")
+    (span ((lang "chr")) "ᏣᎳᎩ")
-   " (tsalagi/cherokee) land. i live with some cats and a whole mess of plants
+    " (tsalagi/cherokee) land. i live with some cats and a whole mess of plants
-    (most of them food) and a cordswain and i have sweet neighbors.")
+    (most of them food) and a cordswain and i have sweet neighbors")
-  (p
+ (p
-   "i have never identified with the term 'hacker' but i have learned, in the
+  "i have never identified with the term 'hacker' but i have learned, in the
-    past few years, that i do like to orchestrate computer machines and i do
+   past few years, that i do like to orchestrate computer machines and i do
-    that with some cute friends at "
+   that with some cute friends at "
-   (a ((href "https://bunk.computer"))
+  (a ((href "https://bunk.computer"))
-      "bunk computer club"))
+     "bunk computer club"))
-  (p "some random things i believe/ i like/ i am/etc (in no particular order")
+ (p "some random things i believe/ i like/ i am/etc (in no particular order")
-;; about me bullets
+ ;; about me bullets
-  (ul
+ (ul
-   ;; language bullet
+  ;; language bullet
-   (li (p "i like linguistics a whole lot. "
+  (li (p "i like linguistics a whole lot. "
-          (span
+         (span
-           ((class "hx-target"))
+          ((class "hx-target"))
-           (a ((href "/tagged/conlang")
+          (a ((href "/tagged/conlang")
-               (hx-get "/hx/tagged/conlang")
+              (hx-get "/hx/tagged/conlang")
-               (hx-target "closest span.hx-target")
+              (hx-target "closest span.hx-target")
-               ; swap for a tag? just a lil list inside a list?
+              ; swap for a tag? just a lil list inside a list?
-               (hx-swap "innerHTML"))
+              (hx-swap "innerHTML"))
-              "i make languages (the human kind) for fun."))
+             "i make languages (the human kind) for fun."))
-          " there's a whole bunch of people who do this! "
+         " there's a whole bunch of people who do this! "
-          (a ((href "https://conlang.org/"))
+         (a ((href "https://conlang.org/"))
-             "the language creation society")
+            "the language creation society")
-          " i'm even working on a "
+         " i'm even working on a "
-          (span
+         (span
-           ((class "hx-target"))
+          ((class "hx-target"))
-           (a ((href "/tagged/latl")
+          (a ((href "/tagged/latl")
-               (hx-get "/hx/tagged/latl")
+              (hx-get "/hx/tagged/latl")
-               (hx-target "closest span.hx-target")
+              (hx-target "closest span.hx-target")
-               (hx-swap "innerHTML"))
+              (hx-swap "innerHTML"))
-              "language (computer) to make languages (human)."))))
+             "language (computer) to make languages (human)"))))
-   ;; mmt bullet
+  ;; mmt bullet
-   (li (p "mmt, but make it anarchist "
+  (li (p "mmt, but make it anarchist "
-          (small "and get rid of all that \"sovereignty\" stuff, ew")))
+         (small "and get rid of all that \"sovereignty\" stuff, ew")))
-   ;; nd bullet
+  ;; neuroqueer bullet
-   (li (p "the autistic-contiguous position: object-relations theory or gay
+  (li (p "got a spicy brained, trans lady-fied experience. 
-           sex act? "
+          i have feelings about these things that inevitably weave thru
-          (span
+          my projects and art and all that"))
-           ((class "hx-target"))
+  ;; art bullet
-           (small "a " (em "niche") " joke about having "
+  (li (p "i used to make a lot more visual art than i do these days. some
-                  (a ((href "/tagged/brain")
+          sort of smth'll wind up here at some point"))))
-                      (hx-get "/hx/tagged/brain")
-                      (hx-target "closest span.hx-target")
-                      (hx-swap "innerHTML"))
-                     "a ~type~ of experience")))))
-   ;; queer bullet
-   (li (p "she's a gay trans lady, harold"))
-   ;; art bullet
-   (li (p "i used to make a lot more visual art than i do these days. some
-           sort of smth'll wind up here at some point."))))
-;; contact section
- (section
-  (h2 "contact")
-  (p "- e - m- "
-     (span " a - i ")
-     (span " -l [ at ")
-     (span "] s - o- ")
-     (span "r - r- e - l [ d o")
-     (span "t ] d -e")
-     (span "-v is a good place to do the email"))
-  (p
-   "i have avoided 'online' for a long time, but i'm getting hip to it. i'll
-    add some more socials here for to socially network in the future,
-    promise."))
-;; getting earnest section
- (section
-  (h2 "a very earnest disclaimer")
-  (p
-   "i like to talk about computation with ppl! but it is important for me that
-    you know: i am new to all this! i did not think computers or software were
-    ^for me^ and then i had to get good at spreadsheets at my first email-factory
-    job and then i got curious about webdev and now i have reached terminal
-    velocity down a very λ.particular.rabbit[hole]")
-  (p
-   "i'm not very good at many things. i don't even have a math education or a
-    degree in anything. have you ever met someone who *is* good at _all_ ^this^
-    ~stuff~ ???")
-  (p
-   "i like thinking in public, but please be patient! with me and with
-    everyone else you talk about things you care about with.")
-  (p "let's hold our strong opinions loosely!")
-  (p "and first assume good faith from each other!")
-  (br)
-  (br)
-  (p ((class "ascii but-normal-size"))
-     "   ⃔‥̺⃝⃕")
-  (br)))
-

source/header.txt

@@ -47,12 +47,6 @@
  ░▒▓ ▓▒▒▒▒▒▓▒▒▒▒▒▒▒▒▒▒▒▒▒▒▓▒▓▒▒▒      ▒░▓                 ░▒░▒           ░░                                         
   ▒▓ ░▒▒▒▒▒▓▒▒▓▒▒▒▒▒▒▒▒▒▒▓▒▓▓▓▒▒       ▓░                 ░▒            ░▓                                          "))
  (nav
-  (a
-   ((href "/about")
-    (hx-get "/hx/about")
-    (hx-target "main")
-    (hx-swap "innerHTML"))
-   "about sorrel (the bitch who made this)")
   (a
    ((href "/unsettled")
     (hx-get "/hx/unsettled")

source/index.txt

@@ -1,4 +1,4 @@
-(article
+(main
  (noscript
   (span
    ((class "noscript"))
@@ -21,14 +21,48 @@
  (p "hey! i'm sorrel.")
  (p "(called like the plant up there)")
  (p "this is my new-fangled website computer page on the world wide web. i had
-     a nice time building this little thing "
+     a nice time building this little thing ")
-    (span ((class "hx-target"))
+ (p " i hope you have  a nice time looking at things here")
+ (hr)
+ (p (span ((class "hx-target"))
           (a ((href "/this")
               (hx-get "/hx/this")
               (hx-target "closest span")
               (hx-swap "innerHTML"))
-             "(how i build this little page.)")))
+             "(how i build this little page)")))
- (p " i hope you have  a nice time looking at things here.")
+ (p (span ((class "hx-target"))
+          (a ((href "/now")
+              (hx-get "/hx/now")
+              (hx-target "closest span")
+              (hx-swap "innerHTML"))
+          "(what i'm doing)")))
+ (p (span ((class "hx-target"))
+          (a ((href "/about")
+              (hx-get "/hx/about")
+              (hx-target "closest span")
+              (hx-swap "innerHTML"))
+             "(who i am)")))
+ (p (span ((class "hx-target"))
+          (a ((href "/contact")
+              (hx-get "/hx/contact")
+              (hx-target "closest span")
+              (hx-swap "innerHTML"))
+          "(how to say hi to me)")))
+ (p (span ((class "hx-target"))
+          (a ((href "/very-earnest-disclaimer")
+              (hx-get "/hx/very-earnest-disclaimer")
+              (hx-target "closest span")
+              (hx-swap "innerHTML"))
+          "(a very earnest disclaimer)")))
+; (p (span ((class "hx-target"))
+;          (a ((href "/links")
+;              (hx-get "/hx/links")
+;              (hx-target "closest span")
+;              (hx-swap "innerHTML"))
+;          "(some things i think are neat)")))
+ (p (a ((href "/tagged"))
+          "-> all of the kinds of things on here so far"))
+ 
  (p ((class "ascii but-normal-size"))
 "︿︿
  〰"))