From c1fb8923cec1b926196dbf52cc9da0591eb9f651 Mon Sep 17 00:00:00 2001 From: Madeleine Sydney Date: Fri, 10 Jan 2025 19:10:59 -0700 Subject: [PATCH] refactor: Split out AsciiDoctor rendering --- scripts/sydnix/src/asciidoc/render.clj | 78 ++++++++++ scripts/sydnix/src/asciidoc/types.clj | 47 ++++++ scripts/sydnix/src/sydnix/commands/help.clj | 141 ++++-------------- .../sydnix/src/sydnix/commands/rebuild.clj | 10 +- 4 files changed, 162 insertions(+), 114 deletions(-) create mode 100644 scripts/sydnix/src/asciidoc/render.clj create mode 100644 scripts/sydnix/src/asciidoc/types.clj diff --git a/scripts/sydnix/src/asciidoc/render.clj b/scripts/sydnix/src/asciidoc/render.clj new file mode 100644 index 0000000..ff9a8ec --- /dev/null +++ b/scripts/sydnix/src/asciidoc/render.clj @@ -0,0 +1,78 @@ +(ns asciidoc.render + (:require + [clojure.pprint :refer [pprint]] + [asciidoc.types :as types] + [clojure.spec.alpha :as s] + [clojure.zip :as zip])) + +(defn- block-zip [root-block] + (zip/zipper #(s/conform ::block %) + :content + (fn [block children] (assoc block :content children)) + root-block)) + +(defn- escape-line [line] + ;; TODO + line) + +(declare render*) + +(defn- render-attributes [attributes] + (let [sorted-attributes (->> attributes + seq + (sort-by first))] + (doseq [[k v] sorted-attributes] + (printf ":%s: %s\n" (name k) v)))) + +(defn- render-document-header [depth {:keys [arguments] :as block}] + (println "=" (:title arguments)) + (when-let [author (:author arguments)] + (println author) + (when-let [version (:version arguments)] + (println version))) + (when-let [attributes (:a arguments)] + (render-attributes attributes)) + (println) + (run! #(render* (inc depth) %) (:content block))) + +(defn- render-p [block] + (apply println (:content block))) + +(defn- render-section [depth {:keys [arguments] :as block}] + (print (apply str (repeat (inc depth) \=)) + (:title arguments) + "\n\n") + (run! render-p (:content block)) + (println)) + +(defn- render* [depth block] + (case (:context block) + :document (do (assert (zero? depth) + "Document block should only occur as root node.") + (render-document-header depth block)) + :section (render-section depth block) + :p (render-p block) + (throw (ex-info "no case" {:for (:context block) + :block block})))) + +(def my-manpage + [:document {:title "sydnix(1)" + :author "Madeleine Sydney Ślaga" + :a {:doctype "manpage" + :manmanual "SYDNIX" + :mansource "SYDNIX"}} + [:section {:title "Name"} + [:p "sydnix - Inspect and operate upon the system."]] + [:section {:title "Synopsis"} + [:p "*sydnix* [_COMMAND_]... [_OPTION_]... [_FILE_]..."]]]) + +(defn conform! [spec x] + (let [x' (s/conform spec x)] + (if (= x' :clojure.spec.alpha/invalid) + (throw (ex-info "invalid" (s/explain-data spec x))) + x'))) + +(defn render + "Render an AsciiDoc block to `*out*`." + [block] + (render* 0 (conform! :asciidoc.types/document block))) diff --git a/scripts/sydnix/src/asciidoc/types.clj b/scripts/sydnix/src/asciidoc/types.clj new file mode 100644 index 0000000..b61a365 --- /dev/null +++ b/scripts/sydnix/src/asciidoc/types.clj @@ -0,0 +1,47 @@ +(ns asciidoc.types + (:require + [clojure.spec.alpha :as s] + [spec-dict :refer [->opt dict]])) + +(defn- make-block-arguments [req opt] + (let [args (dict req + (->opt opt) + ^:opt {:a map?})] + (if (empty? req) + (s/? (s/and map? args)) + (s/& (s/? map?) args)))) + +(defn- make-block + [& {:keys [name required-args optional-args content-spec] + :or {required-args {} + optional-args {} + content-spec (s/* ::block)}}] + (s/and vector? + (s/cat :context (s/and keyword? #{name}) + :arguments (make-block-arguments required-args optional-args) + :content content-spec) + ;; Set arguments to {} if none were provided. + (s/conformer #(if (contains? % :arguments) + % + (assoc % :arguments {}))))) + +(s/def ::document + (make-block :name :document + :required-args {:title string?} + :optional-args {:author string? + :version string?})) + +(s/def ::p + (make-block :name :p + :content-spec (s/* string?))) + +(s/def ::section + (make-block :name :section + :required-args {:title string?})) + +(s/def ::block + (s/and (s/or :document ::document + :section ::section + :p ::p) + ;; `s/or` provides tagging that `make-block` already does. + (s/conformer #(nth % 1)))) diff --git a/scripts/sydnix/src/sydnix/commands/help.clj b/scripts/sydnix/src/sydnix/commands/help.clj index 7b43f5c..6079c67 100644 --- a/scripts/sydnix/src/sydnix/commands/help.clj +++ b/scripts/sydnix/src/sydnix/commands/help.clj @@ -1,135 +1,52 @@ (ns sydnix.commands.help (:require [clojure.pprint :refer [pprint]] + [asciidoc.render :as ar] [clojure.spec.alpha :as s] [clojure.string :as str] [clojure.zip :as zip] [spec-dict :refer [dict]] [sydnix.cli-table :refer [*cli-table*]])) -(s/def ::block-context - #{:document :section :paragraph}) +(defn- find-satisfying [p xs] + (->> xs (filter p) first)) -(s/def :block/arguments - (s/and map? - (dict ^:opt {:a map?}))) +(defn- find-dispatched [dispatch] + (find-satisfying #(= dispatch (:cmds %)) *cli-table*)) -(s/def ::block - (s/and vector? - (s/and (s/cat :context keyword? - :arguments (s/? :block/arguments) - :content (s/* (constantly true))) - ;; Set default fields. - (s/conformer #(if (contains? % :arguments) - % - (assoc % :arguments {})))))) +(defn- docs-for-command [command-spec] + (let [command (cons "sydnix" (:cmds command-spec))] + [:document {:title (str (str/join "-" command) + "(1)") + :author "Madeleine Sydney Ślaga" + :a {:doctype "manpage" + :manmanual "SYDNIX" + :mansource "SYDNIX"}} + [:section {:title "Name"} + [:p (format "%s - %s" + (str/join " " command) + (:desc command-spec))]] + [:section {:title "Synopsis"} + [:p (format "%s [_option_…]" + (str/join " " command))]] + [:section {:title "Options"} + [:p "synopsis"]]])) -(s/def :document/doctype #{:manpage}) -(s/def :document/manmanual string?) -(s/def :document/mansource string?) -(s/def :document/man-linkstyle string?) - -(s/def :block/attributes map?) - -#_ -(s/def :document/attributes - (s/keys :opt-un [:document/doctype - :document/manmanual - :document/mansource - :document/man-linkstyle])) - -(s/def :document/arguments - (s/and :block/arguments - (dict {:title string?} - ^:opt {:author string?} - ^:opt {:version string?}))) - -(s/def :document/content (s/coll-of ::block)) - -(s/def ::document - (s/and ::block - (dict {:context #{:document} - :content (s/coll-of ::block)}))) - -(defn- block-zip [root-block] - (zip/zipper #(s/conform ::block %) - :content - (fn [block children] (assoc block :content children)) - root-block)) - -(defn- escape-line [line] - ;; TODO - line) - -(defn- render-attributes [attributes] - (let [sorted-attributes (->> attributes - seq - (sort-by first))] - (doseq [[k v] sorted-attributes] - (printf ":%s: %s\n" (name k) v)))) - -(defn- render-document-header [{:keys [arguments]}] - (println "=" (:title arguments)) - (when-let [author (:author arguments)] - (println author) - (when-let [version (:version arguments)] - (println version))) - (when-let [attributes (:a arguments)] - (render-attributes attributes))) - -(defn- render-section [depth {:keys [arguments] :as block}] - (println (apply str (repeat (inc depth) \=)) - (:title arguments)) - (apply println (:content block))) - -(defn- render* [depth block-zipper] - #_ - (pprint block-zipper) - (let [block (zip/node block-zipper)] - (case (:context block) - :document (do (assert (zero? depth) - "Document block should only occur as root node.") - (render-document-header block) - (println) - (when-let [x (zip/left block-zipper)] - (render* (inc depth) x)) - (when-let [x (zip/down block-zipper)] - (recur (inc depth) x))) - :section (do (render-section depth block) - (println) - (when-let [l (zip/left block-zipper)] - (recur (inc depth) l))) - (throw (ex-info "no case" {:for (:context block) - :block block}))))) - -(defn- render - "Render an AsciiDoc block to `*out*`." - [block] - (render* 0 (block-zip (s/conform ::document block)))) - -(def my-manpage - [:document {:title "sydnix(1)" - :author "Madeleine Sydney Ślaga" - :a {:doctype "manpage" - :manmanual "SYDNIX" - :mansource "SYDNIX"}} - [:section {:title "Name"} - "sydnix - Inspect and operate upon the system."] - [:section {:title "Synopsis"} - "*sydnix* [_COMMAND_]... [_OPTION_]... [_FILE_]..."]]) +(defn- render-docs-for-command [command-spec] + (try (ar/render (docs-for-command command-spec)) + (catch Exception e + (prn e) + (throw e)))) -(defn- docs-for-command [command]) - (defn- command-fn [opts] (prn "help" opts)) (defn adorn-with-help-option [command-fn] - (fn [{:keys [opts dispatch]}] + (fn [{:keys [opts dispatch] :as w}] (if (:help opts) - (do (printf "\n" (str/join " " dispatch)) - (pprint *cli-table*)) + (render-docs-for-command (find-dispatched dispatch)) (command-fn opts)))) (def command diff --git a/scripts/sydnix/src/sydnix/commands/rebuild.clj b/scripts/sydnix/src/sydnix/commands/rebuild.clj index 01d1076..abcb7e7 100644 --- a/scripts/sydnix/src/sydnix/commands/rebuild.clj +++ b/scripts/sydnix/src/sydnix/commands/rebuild.clj @@ -3,6 +3,13 @@ [clojure.java.shell :refer [sh]] [sydnix.commands.help :refer [adorn-with-help-option]])) +(def command-options-spec + {:flake {:coerce :string + :ref "«URI»" + :desc "«URI» is a path to a Flake, which is passed to `nixos-rebuild + --flake «URI»` as is." + :default "path:///persist/dots"}}) + (defn- command-fn [{:keys [args opts]}] (let [rebuild-cmd (concat ["sudo" "nixos-rebuild"] @@ -15,5 +22,4 @@ {:cmds ["rebuild"] :desc "Rebuild the system NixOS and Home-manager configuration" :fn (adorn-with-help-option command-fn) - :spec {:flake {:coerce :string - :default "path:///persist/dots"}}}) + :spec command-options-spec})