Skip to content

Commit c0c072e

Browse files
committed
backport src/compojure/api/help.clj
1 parent 6e3b5d6 commit c0c072e

File tree

1 file changed

+71
-0
lines changed

1 file changed

+71
-0
lines changed

src/compojure/api/help.clj

+71
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,71 @@
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

Comments
 (0)