[OCaml] High Intensity Training Online
test Enforce the Clean Architecture Dependency Rule
Add an executable guard over lib/ that fails the build if a dependency ever points outward. It checks two things per layer: the (libraries ...) a dune file declares, and that inner-circle sources name no outer-circle module or framework. core names no outer module and no framework (pure entities); app names no adapter and no framework (use cases + ports); persistence and web depend inward only, and web never depends on the concrete persistence adapter — the adapter is injected at the composition root. This turns the Dependency Rule from a convention into a verified invariant.
Changed files
test/dune
@@ -2,6 +2,7 @@
2
2
(name test_hito)
3
3
(modules
4
4
test_hito
5
Added:
test_architecture
5
6
test_exercise
6
7
test_recovery
7
8
test_prescription
test/test_architecture.ml
@@ -0,0 +1,213 @@
1
Added:
(** Architecture guard. Encodes the Clean Architecture Dependency Rule as an
2
Added:
executable invariant over [lib/], so a future change that points a
3
Added:
dependency outward fails the build rather than eroding the design silently.
4
Added:
5
Added:
The four concentric circles, innermost first:
6
Added:
7
Added:
- [lib/core] — entities. Enterprise business rules. No framework.
8
Added:
- [lib/app] — use cases and ports (Repository, Password_hash). Depends on
9
Added:
the entities only.
10
Added:
- [lib/persistence] — interface adapters. Implements the ports over Caqti,
11
Added:
the SQLite driver, and safepass.
12
Added:
- [lib/web] — frameworks and drivers. Dream and dream-html.
13
Added:
14
Added:
The Dependency Rule: source dependencies point inward only. An inner circle
15
Added:
names nothing from an outer circle — no module, no framework. *)
16
Added:
17
Added:
(* Resolve the project root by walking up from the test's run directory until a
18
Added:
[dune-project] file appears. Dune runs the test from deep inside [_build], so
19
Added:
the sources sit some ancestors up. *)
20
Added:
let project_root () =
21
Added:
let rec up dir depth =
22
Added:
if depth = 0 then Alcotest.fail "could not locate dune-project"
23
Added:
else if Sys.file_exists (Filename.concat dir "dune-project") then dir
24
Added:
else up (Filename.dirname dir) (depth - 1)
25
Added:
in
26
Added:
up (Sys.getcwd ()) 12
27
Added:
28
Added:
let read_file path =
29
Added:
let ic = open_in path in
30
Added:
Fun.protect
31
Added:
~finally:(fun () -> close_in ic)
32
Added:
(fun () -> really_input_string ic (in_channel_length ic))
33
Added:
34
Added:
(* Every [.ml] and [.mli] under [dir]. *)
35
Added:
let sources dir =
36
Added:
Sys.readdir dir |> Array.to_list
37
Added:
|> List.filter (fun f ->
38
Added:
Filename.check_suffix f ".ml" || Filename.check_suffix f ".mli")
39
Added:
|> List.map (Filename.concat dir)
40
Added:
41
Added:
let contains ~needle haystack =
42
Added:
let n = String.length needle and h = String.length haystack in
43
Added:
let rec at i =
44
Added:
if i + n > h then false
45
Added:
else if String.sub haystack i n = needle then true
46
Added:
else at (i + 1)
47
Added:
in
48
Added:
at 0
49
Added:
50
Added:
(* Assert that no source under [layer_dir] mentions any of [forbidden] as a
51
Added:
word. A word boundary keeps [Recovery] from matching inside [RecoveryFoo] and
52
Added:
avoids matching substrings of unrelated identifiers. *)
53
Added:
let assert_no_reference ~layer ~layer_dir ~forbidden =
54
Added:
let is_word_char c =
55
Added:
(c >= 'A' && c <= 'Z')
56
Added:
|| (c >= 'a' && c <= 'z')
57
Added:
|| (c >= '0' && c <= '9')
58
Added:
|| c = '_'
59
Added:
in
60
Added:
let mentions_word name text =
61
Added:
let n = String.length name and h = String.length text in
62
Added:
let rec scan i =
63
Added:
if i + n > h then false
64
Added:
else if String.sub text i n = name then
65
Added:
let before = i = 0 || not (is_word_char text.[i - 1]) in
66
Added:
let after = i + n >= h || not (is_word_char text.[i + n]) in
67
Added:
if before && after then true else scan (i + 1)
68
Added:
else scan (i + 1)
69
Added:
in
70
Added:
scan 0
71
Added:
in
72
Added:
List.iter
73
Added:
(fun path ->
74
Added:
let text = read_file path in
75
Added:
List.iter
76
Added:
(fun name ->
77
Added:
if mentions_word name text then
78
Added:
Alcotest.failf "%s layer (%s) names outer-circle %S" layer
79
Added:
(Filename.basename path) name)
80
Added:
forbidden)
81
Added:
(sources layer_dir)
82
Added:
83
Added:
(* The union of every [(libraries ...)] form in a dune file, as a flat token
84
Added:
list. A dune file may hold several stanzas (an executable and a library, say),
85
Added:
so we gather them all: for the Dependency Rule it is enough to know the full
86
Added:
set a file's build can see. *)
87
Added:
let declared_libraries dune_path =
88
Added:
let text = read_file dune_path in
89
Added:
let key = "(libraries" in
90
Added:
let klen = String.length key in
91
Added:
let acc = Buffer.create 128 in
92
Added:
let rec find_all i =
93
Added:
if i + klen > String.length text then ()
94
Added:
else if String.sub text i klen = key then begin
95
Added:
let buf = Buffer.create 64 in
96
Added:
let rec take j depth =
97
Added:
if j >= String.length text then j
98
Added:
else
99
Added:
match text.[j] with
100
Added:
| ')' when depth = 0 -> j + 1
101
Added:
| '(' ->
102
Added:
Buffer.add_char buf ' ';
103
Added:
take (j + 1) (depth + 1)
104
Added:
| ')' ->
105
Added:
Buffer.add_char buf ' ';
106
Added:
take (j + 1) (depth - 1)
107
Added:
| c ->
108
Added:
Buffer.add_char buf c;
109
Added:
take (j + 1) depth
110
Added:
in
111
Added:
let next = take (i + klen) 0 in
112
Added:
Buffer.add_char acc ' ';
113
Added:
Buffer.add_string acc (Buffer.contents buf);
114
Added:
find_all next
115
Added:
end
116
Added:
else find_all (i + 1)
117
Added:
in
118
Added:
find_all 0;
119
Added:
Buffer.contents acc |> String.split_on_char ' '
120
Added:
|> List.filter_map (fun s ->
121
Added:
let s = String.trim s in
122
Added:
if s = "" then None else Some s)
123
Added:
124
Added:
let root = project_root ()
125
Added:
let lib name = Filename.concat (Filename.concat root "lib") name
126
Added:
127
Added:
let dependency_rule =
128
Added:
[
129
Added:
( "core is pure entities: no outer module, no framework",
130
Added:
`Quick,
131
Added:
fun () ->
132
Added:
assert_no_reference ~layer:"core" ~layer_dir:(lib "core")
133
Added:
~forbidden:
134
Added:
[
135
Added:
"Repository";
136
Added:
"Service";
137
Added:
"Trainee";
138
Added:
"Catalog";
139
Added:
"Password_hash";
140
Added:
"Sqlite_repo";
141
Added:
"Memory_repo";
142
Added:
"Codec";
143
Added:
"Migrations";
144
Added:
"Bcrypt";
145
Added:
"Bcrypt_hash";
146
Added:
"Caqti";
147
Added:
"Dream";
148
Added:
"Dream_html";
149
Added:
"Handlers";
150
Added:
"Pages";
151
Added:
"Routes";
152
Added:
"Lwt";
153
Added:
"Uri";
154
Added:
"Unix";
155
Added:
] );
156
Added:
( "app use cases name no adapter and no framework",
157
Added:
`Quick,
158
Added:
fun () ->
159
Added:
assert_no_reference ~layer:"app" ~layer_dir:(lib "app")
160
Added:
~forbidden:
161
Added:
[
162
Added:
"Sqlite_repo";
163
Added:
"Memory_repo";
164
Added:
"Codec";
165
Added:
"Migrations";
166
Added:
"Bcrypt_hash";
167
Added:
"Caqti";
168
Added:
"Dream";
169
Added:
"Dream_html";
170
Added:
"Handlers";
171
Added:
"Pages";
172
Added:
"Routes";
173
Added:
] );
174
Added:
( "core declares no library dependency",
175
Added:
`Quick,
176
Added:
fun () ->
177
Added:
Alcotest.(check (list string))
178
Added:
"core libraries" []
179
Added:
(declared_libraries (Filename.concat (lib "core") "dune")) );
180
Added:
( "app depends inward on core and lwt only",
181
Added:
`Quick,
182
Added:
fun () ->
183
Added:
Alcotest.(check (list string))
184
Added:
"app libraries" [ "hito.core"; "lwt" ]
185
Added:
(declared_libraries (Filename.concat (lib "app") "dune")) );
186
Added:
( "persistence depends inward, never on web",
187
Added:
`Quick,
188
Added:
fun () ->
189
Added:
let libs =
190
Added:
declared_libraries (Filename.concat (lib "persistence") "dune")
191
Added:
in
192
Added:
Alcotest.(check bool)
193
Added:
"declares hito.core" true
194
Added:
(List.mem "hito.core" libs);
195
Added:
Alcotest.(check bool)
196
Added:
"declares hito.app" true (List.mem "hito.app" libs);
197
Added:
Alcotest.(check bool)
198
Added:
"does not depend on hito.web" false (List.mem "hito.web" libs) );
199
Added:
( "web depends inward, never on the concrete persistence adapter",
200
Added:
`Quick,
201
Added:
fun () ->
202
Added:
let libs = declared_libraries (Filename.concat (lib "web") "dune") in
203
Added:
Alcotest.(check bool)
204
Added:
"declares hito.core" true
205
Added:
(List.mem "hito.core" libs);
206
Added:
Alcotest.(check bool)
207
Added:
"declares hito.app" true (List.mem "hito.app" libs);
208
Added:
Alcotest.(check bool)
209
Added:
"does not depend on hito.persistence" false
210
Added:
(List.mem "hito.persistence" libs) );
211
Added:
]
212
Added:
213
Added:
let suite = [ ("architecture.dependency_rule", dependency_rule) ]
test/test_hito.ml
@@ -7,7 +7,7 @@
7
7
8
8
let () =
9
9
Alcotest.run "hito"
10
Removed:
(Test_exercise.suite @ Test_recovery.suite @ Test_prescription.suite
11
Removed:
@ Test_evidence.suite @ Test_progression.suite @ Test_service.suite
12
Removed:
@ Test_codec.suite @ Test_bcrypt_hash.suite @ Test_sqlite_repo.suite
13
Removed:
@ Test_decode.suite @ Test_web.suite)
10
Added:
(Test_architecture.suite @ Test_exercise.suite @ Test_recovery.suite
11
Added:
@ Test_prescription.suite @ Test_evidence.suite @ Test_progression.suite
12
Added:
@ Test_service.suite @ Test_codec.suite @ Test_bcrypt_hash.suite
13
Added:
@ Test_sqlite_repo.suite @ Test_decode.suite @ Test_web.suite)