-
Notifications
You must be signed in to change notification settings - Fork 10
/
doc.clj
173 lines (149 loc) · 7.34 KB
/
doc.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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
(ns leiningen.polylith.cmd.doc
(:require [clojure.java.browse :as browse]
[clojure.string :as str]
[leiningen.polylith.cmd.deps :as cdeps]
[leiningen.polylith.cmd.doc.crop :as crop]
[leiningen.polylith.cmd.doc.env-table :as env-table]
[leiningen.polylith.cmd.info :as info]
[leiningen.polylith.cmd.shared :as shared]
[leiningen.polylith.file :as file]
[leiningen.polylith.freemarker :as freemarker]
[leiningen.polylith.cmd.doc.env-belonging :as belonging]
[clojure.java.io :as io]))
(defn project-description
([ws-path entity-dir entity]
(project-description (str ws-path "/" entity-dir "/" entity)))
([path]
(let [content (read-string (slurp (str path "/project.clj")))
index (ffirst
(filter #(= :description (second %))
(map-indexed vector content)))]
(if index
(nth content (inc index))
"*** Couldn't find the :description key in project.clj ***"))))
(defn ->lib [[lib version]]
{"name" lib
"version" version})
(defn ->libs [libraries]
(mapv ->lib (sort (filter #(not= "interfaces" (-> % first name)) libraries))))
(defn entity-libs [ws-path type entity]
(->libs (shared/libs ws-path (str "/" type "s/") entity)))
(defn base-name [ws-path top-dir type-dir environment]
(let [dir (shared/full-name top-dir "/" "")
bases (shared/all-bases ws-path)
directories (file/directories (str ws-path type-dir environment "/src/" dir))]
(first (filterv #(contains? bases %) (map shared/path->file directories)))))
(defn ->name [name]
{"name" name})
(defn system-info [ws-path top-dir all-bases type-dir system]
(let [base (base-name ws-path top-dir type-dir system)]
(when base
(let [tree (crop/system-or-env-tree ws-path top-dir all-bases "systems" system base)
used-entities (set (env-table/entity-deps tree []))]
{"name" system
"description" (project-description ws-path "systems" system)
"libraries" (entity-libs ws-path "system" system)
"entities" (mapv ->name used-entities)}))))
(def sorting {"component" 1
"base" 2})
(defn ->entity [ws-path top-dir all-bases ifc-entity-deps entity->env entity]
(let [interface (shared/interface-of ws-path top-dir entity)
type (if (contains? all-bases entity)
"base"
"component")
table-defs (if (= "base" type)
(env-table/table-defs ws-path top-dir all-bases entity->env ifc-entity-deps type entity)
[])
environments (mapv (fn [[type name]] {"id" (str/replace (str entity "__" type "__" name) "-" "_")
"type" type,
"name" name})
(sort (set (map #(vector ((% "info") "type") ((% "info") "name")) table-defs))))]
{"name" entity
"description" (project-description ws-path (str type "s") entity)
"type" type
"environments" environments
"libraries" (entity-libs ws-path type entity)
"interface" interface
"tableDefs" table-defs
"sort-order" (str (sorting type) entity)}))
(defn base-or-component [bases components entity]
(or (contains? bases entity)
(contains? components entity)))
(defn ->entities [ws-path top-dir all-bases all-components entities]
(let [ifc-entity-deps (cdeps/interface-dependencies ws-path top-dir all-components all-bases)
entity->env (belonging/entity->environment ws-path top-dir)]
(sort-by #(% "sort-order")
(mapv #(->entity ws-path top-dir all-bases ifc-entity-deps entity->env %) entities))))
(defn env-libraries [ws-path top-dir environment all-bases all-components]
(let [root-dir (str ws-path "/environments/" environment)
dir (str root-dir "/src/" (shared/full-name top-dir "/" ""))
entities (sort (filter #(base-or-component all-bases all-components %)
(map file/path->dir-name (file/directories dir))))
description (project-description ws-path "environments" environment)]
{"name" environment
"description" description
"libraries" (entity-libs ws-path "environment" environment)
"entities" (->entities ws-path top-dir all-bases all-components entities)}))
(defn environments [ws-path top-dir all-bases all-components]
(mapv #(env-libraries ws-path top-dir % all-bases all-components)
(sort (shared/all-environments ws-path))))
(defn ->workspace [ws-path]
{"name" (last (str/split ws-path #"/"))
"description" (project-description ws-path)})
(defn template-data [ws-path top-dir github-url]
(let [libraries (->libs (shared/all-libraries ws-path))
interfaces (shared/all-interfaces ws-path top-dir)
all-bases (shared/all-bases ws-path)
all-components (shared/all-components ws-path)
systems (mapv #(system-info ws-path top-dir all-bases "/systems/" %) (sort (shared/all-systems ws-path)))
components (->entities ws-path top-dir all-bases all-components all-components)
envs (environments ws-path top-dir all-bases all-components)
bases (->entities ws-path top-dir all-bases all-components all-bases)]
{"workspace" (->workspace ws-path)
"githubUrl" github-url
"libraries" libraries
"interfaces" (vec (sort interfaces))
"components" components
"bases" bases
"systems" systems
"environments" envs}))
(def gen-doc-ok? (atom false))
(def in-out-files [{:template-file "workspace.ftl"
:output-file "workspace.html"}])
(defn html-file? [{:keys [output-file]}]
(or
(str/ends-with? output-file ".htm")
(str/ends-with? output-file ".html")))
(defn first-html-file []
(-> (filter html-file? in-out-files) first :output-file))
(defn generate-docs [doc-path data]
(let [templates-root-dir (str doc-path "/templates")
config (freemarker/configuration)]
(reset! gen-doc-ok? true)
(doseq [{:keys [template-file output-file]} in-out-files]
(when @gen-doc-ok?
(let [output-path (str doc-path "/" output-file)
[ok? message] (freemarker/write-file config templates-root-dir template-file output-path data)]
(when (not ok?)
(reset! gen-doc-ok? false)
(println (str " " message))))))))
(defn browse-file [browse? doc-path]
(let [out-path (str doc-path "/" (first-html-file))]
(when (and browse? (file/file-exists out-path))
(browse/browse-url (file/url out-path)))))
(defn copy-doc-files [ws-path]
(let [path (str ws-path "/doc/style.css")
content (-> "templates/style.css" io/resource slurp)]
(file/create-file path [content])
(file/copy-resource-file! "images/github.png" (str ws-path "/doc/github.png"))))
(defn execute [ws-path top-dir github-url args]
(if (info/has-circular-dependencies? ws-path top-dir)
(println (str " Cannot generate documentation. Circular dependencies detected. "
"Run the 'info' command for details."))
(let [browse? (not (shared/has-args? args "-browse"))
generate? (not (shared/has-args? args "-generate"))
doc-path (str ws-path "/doc")]
(when generate?
(generate-docs doc-path (template-data ws-path top-dir github-url)))
(copy-doc-files ws-path)
(browse-file browse? doc-path))))