Merge pull request #413 from jamiepratt/codex/rewrite-vocabulary-tutorial-series

Publish new Bayes-to-Lexibench vocabulary-estimation series improvements.

Author: jamiepratt

clay.edn

@@ -1,5 +1,9 @@
 {:base-target-path   "temp"
  :base-source-path   "src"
+ :watch-dirs         ["src"]
+ :format             [:quarto :html]
+ :run-quarto         true
+ :browse             false
  :quarto-target-path "site"
  :quarto             ^:replace {}
  :subdirs-to-sync    ["src"]

deps.edn

@@ -91,7 +91,7 @@
  :aliases
  {;; Build the site with `clojure -M:clay -A:markdown`
   ;; Run Clay in watch mode with `clojure -M:clay`
-  :clay       {:main-opts ["-m" "scicloj.clay.v2.main"]
+  :clay       {:main-opts ["-m" "civitas.clay-main"]
                :jvm-opts  ["-Dclojure.main.report=stderr"
                            "--add-opens=java.base/java.nio=ALL-UNNAMED"]}
   ;; When debugging libraries

src/civitas/clay_main.clj

@@ -0,0 +1,55 @@
+(ns civitas.clay-main
+  (:gen-class)
+  (:require [clojure.java.io :as io]
+            [clojure.string :as str]
+            [ring.util.mime-type :as mime-type]
+            [scicloj.clay.v2.main :as clay-main]
+            [scicloj.clay.v2.server :as clay-server]
+            [scicloj.clay.v2.server.state :as server-state])
+  (:import (java.io File)))
+
+(def default-preview-source
+  "language_learning/vocabulary_estimation/bayes_theorem_simulations.clj")
+
+(def preview-root "temp")
+(def published-root "site/_site")
+
+(defn- regular-file-under [root uri]
+  (when (and (string? uri) (str/starts-with? uri "/"))
+    (let [root-file (.getCanonicalFile (io/file root))
+          file (.getCanonicalFile (io/file root-file (subs uri 1)))
+          root-prefix (str (.getPath root-file) File/separator)]
+      (when (and (str/starts-with? (.getPath file) root-prefix)
+                 (.isFile file))
+        file))))
+
+(defn- current-preview-uri []
+  (let [{:keys [base-target-path full-target-path]}
+        (:last-rendered-spec @server-state/*state)]
+    (when (and base-target-path full-target-path)
+      (str "/" (clay-server/relative-url-path base-target-path
+                                              full-target-path)))))
+
+(defn preview-fallback-handler [{:keys [request-method uri]}]
+  (let [preview-file (regular-file-under preview-root uri)
+        linked-html? (and (str/ends-with? uri ".html")
+                          (not= uri (current-preview-uri)))]
+    (when (and (= :get request-method)
+               (or (nil? preview-file) linked-html?))
+      (when-let [file (regular-file-under published-root uri)]
+        {:status 200
+         :headers {"Content-Type"
+                   (or (mime-type/ext-mime-type uri)
+                       "application/octet-stream")}
+         :body (if (str/ends-with? uri ".html")
+                 (clay-server/wrap-html (slurp file) @server-state/*state)
+                 file)}))))
+
+(defn args-with-default-source [args]
+  (if (seq args)
+    args
+    [default-preview-source]))
+
+(defn -main [& args]
+  (clay-server/install-handler! #'preview-fallback-handler)
+  (apply clay-main/-main (args-with-default-source args)))

src/civitas/db.clj

@@ -3,16 +3,17 @@
   (:require [clojure.edn :as edn]
             [clojure.pprint :as pprint]
             [clojure.walk :as walk]
+            [scicloj.kindly.v4.api :as kindly]
             [tablecloth.api :as tc]
             [clj-yaml.core :as yaml]))
 
 (defn quarto []
   (walk/postwalk
-    (fn [x]
-      (cond (map? x) (into {} x)
-            (seq? x) (into [] x)
-            :else x))
-    (yaml/parse-string (slurp "site/_quarto.yml"))))
+   (fn [x]
+     (cond (map? x) (into {} x)
+           (seq? x) (into [] x)
+           :else x))
+   (yaml/parse-string (slurp "site/_quarto.yml"))))
 
 (def db-file "site/db.edn")
 
@@ -28,10 +29,10 @@
   "Return a map where a key is (f item) and a value is item."
   [f coll]
   (persistent!
-    (reduce
-      (fn [ret x]
-        (assoc! ret (f x) x))
-      (transient {}) coll)))
+   (reduce
+    (fn [ret x]
+      (assoc! ret (f x) x))
+    (transient {}) coll)))
 
 (defn author-replacements
   "Creates a map of author and affiliation keys to their full definition"
@@ -40,10 +41,29 @@
       (->> (index-by :id))
       (update-vals #(dissoc % :id))))
 
+(defn- ns-clay-config [ns-form]
+  (let [[_ sym ?doc ?attr] ns-form]
+    (kindly/deep-merge
+     (some-> ns-form meta :clay)
+     (some-> sym meta :clay)
+     (:clay (cond
+              (map? ?doc) ?doc
+              (map? ?attr) ?attr)))))
+
+(defn- restore-replaced-quarto-config [config]
+  (let [quarto (:quarto config)
+        ns-quarto (some-> config :ns-form ns-clay-config :quarto)]
+    (if (and ns-quarto (-> quarto meta :replace))
+      (assoc config :quarto
+             (kindly/deep-merge ns-quarto (with-meta quarto nil)))
+      config)))
+
 (defn expand-authors
   "Hook for Clay to update ns metadata configuration"
   [config]
-  (update config :quarto #(walk/prewalk-replace (author-replacements) %)))
+  (-> config
+      restore-replaced-quarto-config
+      (update :quarto #(walk/prewalk-replace (author-replacements) %))))
 
 ;; TODO: what if the front matter doesn't match existing?