|
| 1 | +(ns compojure.api.help |
| 2 | + (:require [schema.core :as s] |
| 3 | + [clojure.string :as str])) |
| 4 | + |
| 5 | +(def Topic (s/maybe s/Keyword)) |
| 6 | +(def Subject (s/maybe (s/cond-pre s/Str s/Keyword s/Symbol))) |
| 7 | + |
| 8 | +;; |
| 9 | +;; content formatting |
| 10 | +;; |
| 11 | + |
| 12 | +(defn text [& s] |
| 13 | + (->> s |
| 14 | + (map #(if (seq? %) (apply text %) %)) |
| 15 | + (str/join "\n"))) |
| 16 | + |
| 17 | +(defn title [& s] |
| 18 | + (str "\u001B[32m" (text s) "\u001B[0m")) |
| 19 | + |
| 20 | +(defn code [& s] |
| 21 | + (str "\u001B[33m" (text s) "\u001B[0m")) |
| 22 | + |
| 23 | +(defmulti help-for (fn [topic subject] [topic subject]) :default ::default) |
| 24 | + |
| 25 | +(defn- subject-text [topic subject] |
| 26 | + (text |
| 27 | + "" |
| 28 | + (title subject) |
| 29 | + "" |
| 30 | + (help-for topic subject) |
| 31 | + "")) |
| 32 | + |
| 33 | +(defn- topic-text [topic] |
| 34 | + (let [subjects (-> (methods help-for) |
| 35 | + (dissoc ::default) |
| 36 | + (keys) |
| 37 | + (->> (filter #(-> % first (= topic)))))] |
| 38 | + (text |
| 39 | + "Topic:\n" |
| 40 | + (title topic) |
| 41 | + "\nSubjects:" |
| 42 | + (->> subjects |
| 43 | + (map (partial apply subject-text)) |
| 44 | + (map (partial str "\n")))))) |
| 45 | + |
| 46 | +(defn- help-text [] |
| 47 | + (let [methods (dissoc (methods help-for) ::default)] |
| 48 | + (text |
| 49 | + "Usage:" |
| 50 | + "" |
| 51 | + (code |
| 52 | + "(help)" |
| 53 | + "(help topic)" |
| 54 | + "(help topic subject)") |
| 55 | + "\nTopics:\n" |
| 56 | + (title (->> methods keys (map first) (distinct) (sort))) |
| 57 | + "\nTopics & subjects:\n" |
| 58 | + (title (->> methods keys (map (partial str/join " ")) (sort)))))) |
| 59 | + |
| 60 | +(defmethod help-for ::default [_ _] (help-text)) |
| 61 | + |
| 62 | +(s/defn ^:always-validate help |
| 63 | + ([] |
| 64 | + (println "------------------------------------------------------------") |
| 65 | + (println (help-text))) |
| 66 | + ([topic :- Topic] |
| 67 | + (println "------------------------------------------------------------") |
| 68 | + (println (topic-text topic))) |
| 69 | + ([topic :- Topic, subject :- Subject] |
| 70 | + (println "------------------------------------------------------------") |
| 71 | + (println (subject-text topic subject)))) |
0 commit comments