refactor: Split out AsciiDoctor rendering

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

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

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 "<help for %s>\n" (str/join " " dispatch))
-          (pprint *cli-table*))
+      (render-docs-for-command (find-dispatched dispatch))
       (command-fn opts))))
 
 (def command

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