Skip to content

Commit

Permalink
Tweak bb doc task that offers cljdoc previews (#319)
Browse files Browse the repository at this point in the history 
The `doc` command has the same commands.
Workflow remains:

- `bb doc start` to start cljdoc docker image
- while verifying, repeat:
  1. make some edits
  2. commit and push edits to branch
  3. `bb doc ingest` to locally install jar and then ingest it into cljdoc
  4. `bb doc view` to bring up docs in your browser (or if already open
simply refresh them in browser)
- when done: `bb doc stop` to stop cljdoc docker image

Because polylith generates 2 artifacts the `ingest` and `view` commands optionally
take `poly` (the default) or `api` as an extra arg.

This effort was to get a preview flow working for polylith.
We can address other issues, such as not documenting internal namespaces
as a separate effort.

Some details:
- cleaned out unused gunk from `bb.edn`, wasn't sure if tasks other than
`doc` are needed, so left them in.
- added `install` and `version` commands to `build.clj`
- switched to modern bb-isms in `cljdoc-preview.clj`
  - switched from nubank/docopt to babashka/cli
  - switched from babashka/curl to babashka/http-client
  - took advantage of newer babashka/fs functions
  - turfed all my script helpers
  • Loading branch information
@lread @tengstrand
lread authored and tengstrand committed Aug 8, 2023
1 parent 88e7ab4 commit 53f3620
Show file tree
Hide file tree
Showing 7 changed files with 134 additions and 260 deletions.
16 changes: 5 additions & 11 deletions bb.edn
View file
Original file line number Diff line number Diff line change
@@ -1,17 +1,12 @@
{;; Parts of this script have been copied from: https://github.com/clj-commons/etaoin/blob/master/bb.edn

:min-bb-version "0.8.2"
:min-bb-version "1.3.182"
:paths ["." "scripts"]
:deps {doric/doric {:mvn/version "0.9.0"}
lread/status-line {:git/url "https://github.com/lread/status-line.git"
:sha "cf44c15f30ea3867227fa61ceb823e5e942c707f"}
dev.nubank/docopt {:mvn/version "0.6.1-fix7"}}
:deps {lread/status-line {:git/url "https://github.com/lread/status-line.git"
:sha "cf44c15f30ea3867227fa61ceb823e5e942c707f"}}
:tasks
{;; setup
:requires ([babashka.classpath :as cp]
[babashka.fs :as fs]
[clojure.string :as string]
[helper.shell :as shell]
:requires ([clojure.string :as string]
[lread.status-line :as status])
:enter (let [{:keys [name]} (current-task)]
(when-not (string/starts-with? name "-")
Expand All @@ -35,6 +30,5 @@
:depends [polyx-jar]
:task (shell/command "sudo cp projects/polyx/target/polyx.jar /usr/local/polylith/poly.jar")}

doc {:doc "preview what docs will look like on cljdoc, use --help for args"
:depends [jar]
doc {:doc "preview what docs will look like on cljdoc, use help for args"
:task cljdoc-preview/-main}}}
21 changes: 21 additions & 0 deletions build.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -231,6 +231,27 @@
(println "Uberjar is built.")
opts))))

(defn version
"Prints the current version"
[opts]
(println version/name))

(defn install
"Create and locally install library JAR files for the Polylith project
Options:
* :project - required, the name of the project to build"
[{:keys [project] :as opts}]
(let [project-opts (assoc opts
:project project
:installer (get opts :installer :local))]
(println (str "Starting install for " project " project."))
(-> project-opts
(jar)
(set/rename-keys {:jar-file :artifact})
(d/deploy))
(println (str "Local install completed for " project " project."))))

(defn deploy
"Create and deploy library JAR files for the Polylith project.
Expand Down
192 changes: 108 additions & 84 deletions scripts/cljdoc_preview.clj
View file
Original file line number Diff line number Diff line change
@@ -1,43 +1,30 @@
#!/usr/bin/env bb

;;
;; Copied from: https://github.com/clj-commons/etaoin/blob/master/script/cljdoc_preview.clj
;;

(ns cljdoc-preview
(:require [babashka.curl :as curl]
(:require [babashka.cli :as cli]
[babashka.fs :as fs]
[babashka.http-client :as http]
[babashka.process :as process]
[clojure.java.browse :as browse]
[clojure.string :as string]
[helper.main :as main]
[helper.shell :as shell]
[lread.status-line :as status]))

;;
;; helpers
;;

(defn- on-path? [prog-name]
(when-let [p (fs/which prog-name)]
(fs/executable? p)))

;;
;; constants
;;

(def project "polyfy/polylith")
(def cljdoc-root-temp-dir "/tmp/poly")
(def cljdoc-root-temp-dir "/tmp/cljdoc-preview")
(def cljdoc-db-dir (str cljdoc-root-temp-dir "/db"))
(def cljdoc-container {:name "poly-server"
:image "poly/poly"
(def cljdoc-container {:name "cljdoc-server"
:image "cljdoc/cljdoc"
:port 8000})

;;
;; Prerequisites
;;

(defn check-prerequisites []
(let [missing-cmds (doall (remove on-path? ["git" "docker"]))]
(let [missing-cmds (doall (remove fs/which ["git" "docker"]))]
(when (seq missing-cmds)
(status/die 1 (string/join "\n" ["Required commands not found:"
(string/join "\n" missing-cmds)])))))
Expand All @@ -46,19 +33,21 @@
;; project build info
;;

(defn local-install []
(status/line :head "installing thin jar")
(shell/clojure "-T:build install :version-suffix cljdoc-preview"))
(defn version []
(-> (process/shell {:out :string} "clojure -T:build version")
:out
string/trim))

(defn built-version []
(slurp "target/built-jar-version.txt"))
(defn local-install [short-lib-name]
(status/line :head "installing %s to local maven repo" short-lib-name)
(process/shell "clojure -T:build install :project" short-lib-name))

;;
;; git
;;

(defn git-sha []
(-> (shell/command {:out :string}
(-> (process/shell {:out :string}
"git rev-parse HEAD")
:out
string/trim))
Expand All @@ -80,21 +69,21 @@
(string/replace #"^(ssh///)*git@" "https://"))))

(defn git-origin-url-as-https []
(-> (shell/command {:out :string}
(-> (process/shell {:out :string}
"git config --get remote.origin.url")
:out
string/trim
https-uri))

(defn uncommitted-code? []
(-> (shell/command {:out :string}
(-> (process/shell {:out :string}
"git status --porcelain")
:out
string/trim
seq))

(defn unpushed-commits? []
(let [{:keys [:exit :out]} (shell/command {:continue true :out :string}
(let [{:keys [:exit :out]} (process/shell {:continue true :out :string}
"git cherry -v")]
(if (zero? exit)
(-> out string/trim seq)
Expand All @@ -104,26 +93,26 @@
;; docker
;;

(defn status-server [ container]
(let [container-id (-> (shell/command {:out :string}
(defn status-server [ container ]
(let [container-id (-> (process/shell {:out :string}
"docker ps -q -f" (str "name=" (:name container)))
:out
string/trim)]
(if (string/blank? container-id) "down" "up")))

(defn docker-pull-latest [ container]
(shell/command "docker pull" (:image container)))
(defn docker-pull-latest [ container ]
(process/shell "docker pull" (:image container)))

(defn stop-server [ container]
(defn stop-server [ container ]
(when (= "down" (status-server container))
(status/die 1
"%s does not appear to be running"
(:name container)))
(shell/command "docker" "stop" (:name container) "--time" "0"))
(process/shell "docker" "stop" (:name container) "--time" "0"))

(defn wait-for-server
"Wait for container's http server to become available, assumes server has valid root page"
[container]
[ container ]
(status/line :head "Waiting for %s to become available" (:name container))
(when (= "down" (status-server container))
(status/die 1
Expand All @@ -133,7 +122,7 @@
(let [url (str "http://localhost:" (:port container))]
(loop []
(if-not (try
(curl/get url)
(http/get url)
url
(catch Exception _e
(Thread/sleep 4000)))
Expand All @@ -150,13 +139,14 @@

(defn cljdoc-ingest [container project version]
(status/line :head "Ingesting project %s %s\ninto local cljdoc database" project version)
(shell/command "docker"
(process/shell "docker"
"run" "--rm"
"-v" (str cljdoc-db-dir ":/app/data")
"-v" (str (fs/home) "/.m2:/root/.m2")
"-v" (str (fs/cwd) ":" (fs/cwd) ":ro")
"--entrypoint" "clojure"
(:image container)
"-Sforce"
"-M:cli"
"ingest"
;; project and version are used to locate the maven artifact (presumably locally)
Expand All @@ -174,7 +164,7 @@
(status/line :head "Checking for updates")
(docker-pull-latest container)
(status/line :head "Starting %s on port %d" (:name container) (:port container))
(shell/command "docker"
(process/shell "docker"
"run" "--rm"
"--name" (:name container)
"-d"
Expand All @@ -186,11 +176,10 @@

(defn view-in-browser [url]
(status/line :head "opening %s in browser" url)
(when (not= 200 (:status (curl/get url {:throw false})))
(when (not= 200 (:status (http/get url {:throw false})))
(status/die 1 "Could not reach:\n%s\nDid you run the ingest command yet?" url))
(browse/browse-url url))


;;
;; main
;;
Expand All @@ -200,58 +189,93 @@
[(when (uncommitted-code?)
"There are changes that have not been committed, they will not be previewed")
(when (unpushed-commits?)
"There are commits that have not been pushed, they will not be previewed")])]
"There are commits that have not been pushed, articles will fail to import")])]
(when (seq warnings)
(status/line :warn (string/join "\n" warnings)))))

(defn cleanup-resources []
(when (fs/exists? cljdoc-db-dir)
(fs/delete-tree cljdoc-db-dir)))

(def args-usage "Valid args: (start|ingest|view|stop|status|--help)
(fs/delete-tree cljdoc-db-dir))

(def args-usage "
Commands:
start Start docker containers supporting cljdoc preview
ingest Locally publishes your project for cljdoc preview
view Opens cljdoc preview in your default browser
stop Stops docker containers supporting cljdoc preview
status Status of docker containers supporting cljdoc preview
Options:
--help Show this help
start Start docker containers supporting cljdoc preview
ingest [poly|api] Locally publishes lib for cljdoc preview (default: poly)
view [poly|api] Opens cljdoc preview in your default browser (default: poly)
stop Stops docker containers supporting cljdoc preview
status Status of docker containers supporting cljdoc preview
help Show this help
Must be run from project root directory.")

(defn short-lib->full-artifact-name [s]
(str "polylith/clj-" s))

;;
;; commands
;;

(defn cmd-fn
"A little wrapper for cmds for some extra validation that bb cli does not do."
[cmd]
(fn [{:keys [args] :as m}]
(when (seq args)
(status/die 1 "invalid args: %s\n%s"
(string/join " " args)
args-usage))
(cmd m)))

(defn cmd-start [_opts]
(start-cljdoc-server cljdoc-container))

(defn cmd-ingest [{:keys [opts] :as all}]
(let [short-lib-name (:lib opts)
lib (short-lib->full-artifact-name short-lib-name)
version (version)]
(git-warnings)
(local-install short-lib-name)
(cljdoc-ingest cljdoc-container lib version)))

(defn cmd-view [{:keys [opts]}]
(let [lib (short-lib->full-artifact-name (:lib opts))
version (version)]
(wait-for-server cljdoc-container)
(view-in-browser (str "http://localhost:" (:port cljdoc-container) "/d/" lib "/" version))))

(defn cmd-stop [_opts]
(stop-server cljdoc-container)
(cleanup-resources))

(defn cmd-status [_opts]
(status-server-print cljdoc-container))

(defn cmd-help [_opts]
(status/line :detail args-usage))

(defn unrecognized-cmd [opts]
(status/die 1
"Unrecognized command: %s\n%s" (string/join " " (:cmds opts))
args-usage))

(defn -main [& args]
(check-prerequisites)
(when-let [opts (main/doc-arg-opt args-usage args)]
(cond
(get opts "start")
(do
(start-cljdoc-server cljdoc-container)
nil)

(get opts "ingest")
(do
(git-warnings)
(local-install)
(cljdoc-ingest cljdoc-container project (built-version))
nil)

(get opts "view")
(do
(wait-for-server cljdoc-container)
(view-in-browser (str "http://localhost:" (:port cljdoc-container) "/d/" project "/" (built-version)))
nil)

(get opts "status")
(status-server-print cljdoc-container)

(get opts "stop")
(do
(stop-server cljdoc-container)
(cleanup-resources)
nil))))

(main/when-invoked-as-script
(let [valid-projects ["poly" "api"]
lib-spec {:lib {:default (first valid-projects)
:validate {:pred #(some #{%} valid-projects)
:ex-msg (fn [m] (format "Invalid lib: %s\nValid values: %s\nDefault: %s\n%s"
(:value m) (string/join ", " valid-projects)
(first valid-projects)
args-usage))}}}]
(cli/dispatch
[{:cmds ["start"] :fn (cmd-fn cmd-start)}
{:cmds ["ingest"] :fn (cmd-fn cmd-ingest) :args->opts [:lib] :spec lib-spec}
{:cmds ["view"] :fn (cmd-fn cmd-view) :args->opts [:lib] :spec lib-spec}
{:cmds ["stop"] :fn (cmd-fn cmd-stop)}
{:cmds ["status"] :fn (cmd-fn cmd-status)}
{:cmds ["help"] :fn (cmd-fn cmd-help)}
{:cmds [] :fn unrecognized-cmd}]
args
{:error-fn (fn [m] (status/die 1 (:msg m)))})))

;; when invoked as script (sometimes helpful when debugging)
(when (= *file* (System/getProperty "babashka.file"))
(apply -main *command-line-args*))
Loading

0 comments on commit 53f3620

Please sign in to comment.