-
-
Notifications
You must be signed in to change notification settings - Fork 7
/
devcards.clj
117 lines (103 loc) · 4.59 KB
/
devcards.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
(ns kamera.devcards
(:require [kamera.core :as k]
[figwheel.main.api :as fig-api]
[figwheel.main :as fig]
[hickory.core :as h]
[hickory.select :as s]
[clojure.string :as string]
[doo-chrome-devprotocol.core :as dcd]
[clojure.test :refer [deftest]]
[clojure.tools.logging :as log]
[clojure.edn :as edn])
(:import [io.webfolder.cdp.session Session]))
;; nice figwheel changes:
;; 1. make fig/start-build-arg->build-options public
;; 2. make the host/port easier to get at in a running server, currently hack the ws url
;; 3. ask if there's a better way to get the list of tests rather than scraping
;; 4. ask how to integrate to the point of {:kamera true} like devcards
(def build-arg->build-opts
#'fig/start-build-arg->build-options)
(defn- build-for [build-or-id {:keys [devcards-options]}]
(-> (build-arg->build-opts build-or-id)
(update :config merge
{:mode :serve
:open-url false
:connect-url (format "http://[[config-hostname]]:[[server-port]]/%s"
(:path devcards-options))})))
(defn start-devcards [build-or-id opts]
(let [build (build-for build-or-id opts)
build-id (:id build)]
(log/info "Starting figwheel" build-id)
(fig-api/start build)
;; looks like you have to look at the websocket url to know what the port and hostname are going to be, bit rubbish
(let [config (fig/config-for-id build-id)]
(try
(assert (get-in config [:options :devcards]) "Devcards must be enabled")
(let [connect-url (get-in config [:options :closure-defines 'figwheel.repl/connect-url])]
(assert connect-url "Could not detect a url to connect to")
connect-url)
(catch Exception e
(fig-api/stop build-id)
nil)))))
(defn stop-devcards [build-or-id]
(fig-api/stop (if (map? build-or-id)
(:id build-or-id)
build-or-id)))
(defn extract-links [content]
(->> (h/as-hickory (h/parse content))
(s/select (s/child (s/class "com-rigsomelight-devcards-list-group-item")
s/last-child))
(map (comp first :content))
(map string/trim)
(map #(str "#!/" %))))
(defn find-test-urls [^Session session]
(let [dom (.getDOM (.getCommand session))
root-node (.getDocument dom)
html (.getOuterHTML dom (.getNodeId root-node) nil nil)]
(extract-links html)))
(def devcards-list-ready?
(k/element-exists? ".com-rigsomelight-devcards-list-group"))
(def devcards-page-ready?
(k/element-exists? ".com-rigsomelight-devcard"))
(def default-opts
(-> k/default-opts
(assoc :devcards-options
{:path "devcards.html" ;; the relative path to the page where the devcards are hosted
:init-hook nil ;; (fn [session]) function run before attempting to scrape targets
:on-targets nil ;; (fn [targets]) function called to allow changing the targets before the test is run
:timeout 60000 ;; time to wait for any devcards page to load
})
;; wait for devcards div to appear before taking screenshot
(assoc-in [:default-target :ready?] devcards-page-ready?)))
(defn test-devcards
([build-or-id] (test-devcards build-or-id default-opts))
([build-or-id opts]
(dcd/with-chrome-session (:chrome-options opts)
(fn [session _]
(test-devcards session build-or-id opts))))
([^Session session build-or-id opts]
(let [devcards-url (start-devcards build-or-id opts)]
(try
(test-devcards devcards-url session build-or-id opts)
(finally
(stop-devcards build-or-id)))))
([devcards-url ^Session session _ {:keys [devcards-options] :as opts}]
(let [{:keys [init-hook on-targets]} devcards-options
load-timeout (get-in opts [:default-target :load-timeout])]
(log/info "Navigating to" devcards-url)
(.navigate session devcards-url)
(.waitDocumentReady session load-timeout)
(k/wait-for session devcards-list-ready?)
(Thread/sleep 500)
(when init-hook
(init-hook session))
(let [target-urls (find-test-urls session)
targets (map (fn [target-url]
{:url (str devcards-url target-url)
:reference-file (str (subs target-url 3) ".png")})
target-urls)
targets (if on-targets
(on-targets targets)
targets)]
(log/infof "Found %s devcards to test" (count target-urls))
(k/run-tests session targets opts)))))