git.iko.soy/rowtype-yoga/purescript-yoga-om-layer
on main help sign in
24 files changed+2330−685
since splitsnapshots
unifiedsplit
.psc-ide-port+1−1 .spec-results+296 README.md+1 compile-fail-tests/CombineDuplicateProv.purs+13 compile-fail-tests/CombineOverlappingProv.purs+15 compile-fail-tests/ProvideWrongType.purs+16 compile-fail-tests/RunLayerMissingDep.purs+15 compile-fail-tests/RunLayerOpenRowMissingDep.purs+19 compile-fail-tests/RunLayerPartialDep.purs+13 compile-fail-tests/WireLayersMissingDep.purs+16 compile-fail-tests/run.sh+38 spago.lock+350−12 spago.yaml+12−6 src/Yoga/Om/Layer.purs+538−7 test/Test/Main.purs+6−659 test/Test/Yoga/Om/Layer/CompositionSpec.purs+59 test/Test/Yoga/Om/Layer/ErrorChannelSpec.purs+167 test/Test/Yoga/Om/Layer/InstancesSpec.purs+163 test/Test/Yoga/Om/Layer/MemoizationSpec.purs+114 test/Test/Yoga/Om/Layer/PureInferenceSpec.purs+22 test/Test/Yoga/Om/Layer/RecoveringSpec.purs+128 test/Test/Yoga/Om/Layer/RepeatingSpec.purs+49 test/Test/Yoga/Om/Layer/ScopedSpec.purs+146 test/Test/Yoga/Om/Layer/WireLayersSpec.purs+133
.psc-ide-port+1−1
@@ -1 +1 @@
1−15887
1+15500
.spec-resultsnew file+296
@@ -0,0 +1,296 @@
1+[
2+ [
3+ "Alt falls back to second layer on failure",
4+ {
5+ "timestamp": "1775221839085.0",
6+ "success": true
7+ }
8+ ],
9+ [
10+ "Automatic Memoization builds the same layer only once when used in two branches",
11+ {
12+ "timestamp": "1775221839085.0",
13+ "success": true
14+ }
15+ ],
16+ [
17+ "Automatic Memoization memoized bracketLayer acquires and releases only once",
18+ {
19+ "timestamp": "1775221839085.0",
20+ "success": true
21+ }
22+ ],
23+ [
24+ "Automatic Memoization memoized scoped layer runs finalizer only once",
25+ {
26+ "timestamp": "1775221839085.0",
27+ "success": true
28+ }
29+ ],
30+ [
31+ "Composition proves Row.Nub deduplicates shared requirements at type level",
32+ {
33+ "timestamp": "1775221839085.0",
34+ "success": true
35+ }
36+ ],
37+ [
38+ "Composition proves deduplication at runtime via shared Ref",
39+ {
40+ "timestamp": "1775221839085.0",
41+ "success": true
42+ }
43+ ],
44+ [
45+ "Error Channel composes layers with different error types",
46+ {
47+ "timestamp": "1775221839085.0",
48+ "success": true
49+ }
50+ ],
51+ [
52+ "Error Channel propagates errors from the first layer",
53+ {
54+ "timestamp": "1775221839085.0",
55+ "success": true
56+ }
57+ ],
58+ [
59+ "Error Channel propagates errors from the second layer",
60+ {
61+ "timestamp": "1775221839085.0",
62+ "success": true
63+ }
64+ ],
65+ [
66+ "Error Channel propagates errors through vertical composition",
67+ {
68+ "timestamp": "1775221839085.0",
69+ "success": true
70+ }
71+ ],
72+ [
73+ "Error Channel scoped layer error triggers finalizers",
74+ {
75+ "timestamp": "1775221839085.0",
76+ "success": true
77+ }
78+ ],
79+ [
80+ "Error Channel scoped layers with errors run via runScopedWith",
81+ {
82+ "timestamp": "1775221839085.0",
83+ "success": true
84+ }
85+ ],
86+ [
87+ "Functor / Apply / Bind applies two layers",
88+ {
89+ "timestamp": "1775221839085.0",
90+ "success": true
91+ }
92+ ],
93+ [
94+ "Functor / Apply / Bind binds layers sequentially",
95+ {
96+ "timestamp": "1775221839085.0",
97+ "success": true
98+ }
99+ ],
100+ [
101+ "Functor / Apply / Bind maps over layer output",
102+ {
103+ "timestamp": "1775221839085.0",
104+ "success": true
105+ }
106+ ],
107+ [
108+ "Functor / Apply / Bind runs layers against a superset context",
109+ {
110+ "timestamp": "1775221839085.0",
111+ "success": true
112+ }
113+ ],
114+ [
115+ "Layer recovering does not retry on non-matching errors",
116+ {
117+ "timestamp": "1775221839085.0",
118+ "success": true
119+ }
120+ ],
121+ [
122+ "Layer recovering only retries the specified error in a multi-error layer",
123+ {
124+ "timestamp": "1775221839085.0",
125+ "success": true
126+ }
127+ ],
128+ [
129+ "Layer recovering preserves the error when retries are exhausted",
130+ {
131+ "timestamp": "1775221839085.0",
132+ "success": true
133+ }
134+ ],
135+ [
136+ "Layer recovering retries layer construction on matching errors",
137+ {
138+ "timestamp": "1775221839085.0",
139+ "success": true
140+ }
141+ ],
142+ [
143+ "Layer recovering uses RetryStatus in the check",
144+ {
145+ "timestamp": "1775221839085.0",
146+ "success": true
147+ }
148+ ],
149+ [
150+ "Layer repeating repeats layer construction while condition holds",
151+ {
152+ "timestamp": "1775221839085.0",
153+ "success": true
154+ }
155+ ],
156+ [
157+ "Layer repeating stops when policy exhausted",
158+ {
159+ "timestamp": "1775221839085.0",
160+ "success": true
161+ }
162+ ],
163+ [
164+ "MonadAsk / MonadReader ask reads the context directly",
165+ {
166+ "timestamp": "1775221839085.0",
167+ "success": true
168+ }
169+ ],
170+ [
171+ "MonadAsk / MonadReader local modifies context for a layer",
172+ {
173+ "timestamp": "1775221839085.0",
174+ "success": true
175+ }
176+ ],
177+ [
178+ "MonadEffect / MonadAff liftEffect works directly in layer bind",
179+ {
180+ "timestamp": "1775221839085.0",
181+ "success": true
182+ }
183+ ],
184+ [
185+ "MonadThrow / MonadError throwError raises into the error channel",
186+ {
187+ "timestamp": "1775221839085.0",
188+ "success": true
189+ }
190+ ],
191+ [
192+ "Parallel runs layers in parallel via parApply",
193+ {
194+ "timestamp": "1775221839085.0",
195+ "success": true
196+ }
197+ ],
198+ [
199+ "Scoped Layers combines scoped and non-scoped layers",
200+ {
201+ "timestamp": "1775221839085.0",
202+ "success": true
203+ }
204+ ],
205+ [
206+ "Scoped Layers fresh layer builds twice even when same base layer",
207+ {
208+ "timestamp": "1775221839085.0",
209+ "success": true
210+ }
211+ ],
212+ [
213+ "Scoped Layers runs finalizers in reverse order on success",
214+ {
215+ "timestamp": "1775221839085.0",
216+ "success": true
217+ }
218+ ],
219+ [
220+ "Scoped Layers runs finalizers when the callback throws",
221+ {
222+ "timestamp": "1775221839085.0",
223+ "success": true
224+ }
225+ ],
226+ [
227+ "Scoped Layers threads finalizers through vertical composition (provide)",
228+ {
229+ "timestamp": "1775221839085.0",
230+ "success": true
231+ }
232+ ],
233+ [
234+ "Scoped Layers works with bracketLayer",
235+ {
236+ "timestamp": "1775221839085.0",
237+ "success": true
238+ }
239+ ],
240+ [
241+ "Semigroup appends layer outputs",
242+ {
243+ "timestamp": "1775221839085.0",
244+ "success": true
245+ }
246+ ],
247+ [
248+ "combinePure combines a plain record with a layer without needing VTA",
249+ {
250+ "timestamp": "1775214062703.0",
251+ "success": true
252+ }
253+ ],
254+ [
255+ "wireLayers memoizes shared dependencies within wireLayers",
256+ {
257+ "timestamp": "1775221839085.0",
258+ "success": true
259+ }
260+ ],
261+ [
262+ "wireLayers wireLayersDebug emits dependency graph as compiler warning",
263+ {
264+ "timestamp": "1775221839085.0",
265+ "success": true
266+ }
267+ ],
268+ [
269+ "wireLayers wires a diamond dependency",
270+ {
271+ "timestamp": "1775221839085.0",
272+ "success": true
273+ }
274+ ],
275+ [
276+ "wireLayers wires a simple linear chain (A -> B -> C)",
277+ {
278+ "timestamp": "1775221839085.0",
279+ "success": true
280+ }
281+ ],
282+ [
283+ "wireLayers wires independent layers with no inter-dependencies",
284+ {
285+ "timestamp": "1775221839085.0",
286+ "success": true
287+ }
288+ ],
289+ [
290+ "withValue combines a plain record with a layer without needing VTA",
291+ {
292+ "timestamp": "1775221839085.0",
293+ "success": true
294+ }
295+ ]
296+]
README.md+1
@@ -240,3 +240,4 @@ combineRequirements (OmLayer build1) (OmLayer build2) = makeLayer do
240240
241241**Status**: Proof of concept complete ✓ with working runtime implementation
242242**Next**: Implement full instance-resolution based layer system with provideLayers API
243+
compile-fail-tests/CombineDuplicateProv.pursnew file+13
@@ -0,0 +1,13 @@
1+-- EXPECT: TypesDoNotUnify
2+module Yoga.Om.Layer.CompileFailTest where
3+
4+import Prelude
5+import Yoga.Om.Layer (OmLayer, Scope, makeLayer, combineRequirements, runScoped)
6+
7+layer1 :: OmLayer (scope :: Scope) () { value :: Int }
8+layer1 = makeLayer (pure { value: 1 })
9+
10+layer2 :: OmLayer (scope :: Scope) () { value :: Int }
11+layer2 = makeLayer (pure { value: 2 })
12+
13+bad = runScoped (combineRequirements layer1 layer2)
compile-fail-tests/CombineOverlappingProv.pursnew file+15
@@ -0,0 +1,15 @@
1+-- EXPECT: TypesDoNotUnify
2+module Yoga.Om.Layer.CompileFailTest where
3+
4+import Prelude
5+import Yoga.Om.Layer (OmLayer, Scope, makeLayer, combineRequirements, runScoped)
6+import Effect.Aff (Aff)
7+
8+layer1 :: OmLayer (scope :: Scope) () { value :: Int }
9+layer1 = makeLayer (pure { value: 1 })
10+
11+layer2 :: OmLayer (scope :: Scope) () { value :: String }
12+layer2 = makeLayer (pure { value: "two" })
13+
14+bad :: Aff { value :: Int, value :: String }
15+bad = runScoped (combineRequirements layer1 layer2)
compile-fail-tests/ProvideWrongType.pursnew file+16
@@ -0,0 +1,16 @@
1+-- EXPECT: TypesDoNotUnify
2+module Yoga.Om.Layer.CompileFailTest where
3+
4+import Prelude
5+import Yoga.Om as Om
6+import Yoga.Om.Layer (OmLayer, makeLayer, provide)
7+
8+base :: OmLayer () () { value :: Int }
9+base = makeLayer (pure { value: 42 })
10+
11+upper :: OmLayer (value :: String) () { out :: String }
12+upper = makeLayer do
13+ { value } <- Om.ask
14+ pure { out: value }
15+
16+bad = upper `provide` base
compile-fail-tests/RunLayerMissingDep.pursnew file+15
@@ -0,0 +1,15 @@
1+-- EXPECT: Missing required dependency
2+module Yoga.Om.Layer.CompileFailTest where
3+
4+import Prelude
5+import Yoga.Om as Om
6+import Yoga.Om.Layer (OmLayer, makeLayer, runLayer)
7+
8+type Database = { query :: String -> Array String }
9+
10+dbLayer :: OmLayer (config :: { host :: String }) () { db :: Database }
11+dbLayer = makeLayer do
12+ { config } <- Om.ask
13+ pure { db: { query: \_ -> [ config.host ] } }
14+
15+bad = runLayer {} dbLayer
compile-fail-tests/RunLayerOpenRowMissingDep.pursnew file+19
@@ -0,0 +1,19 @@
1+-- EXPECT: Prim.RowList.RowToList
2+module Yoga.Om.Layer.CompileFailTest where
3+
4+import Prelude
5+
6+import Yoga.Om as Om
7+import Yoga.Om.Layer (OmLayer, makeLayer, runLayer)
8+
9+type Fastify = String
10+type Connection = String
11+
12+apiLayer :: forall r. OmLayer (fastify :: Fastify, sqlite :: Connection | r) () {}
13+apiLayer = makeLayer do
14+ { fastify, sqlite } <- Om.ask
15+ let _ = fastify <> sqlite
16+ pure {}
17+
18+bad :: Om.Om { fastify :: Fastify } () {}
19+bad = runLayer { fastify: "server" } apiLayer
compile-fail-tests/RunLayerPartialDep.pursnew file+13
@@ -0,0 +1,13 @@
1+-- EXPECT: Missing required dependency
2+module Yoga.Om.Layer.CompileFailTest where
3+
4+import Prelude
5+import Yoga.Om as Om
6+import Yoga.Om.Layer (OmLayer, makeLayer, runLayer)
7+
8+layer :: OmLayer (a :: Int, b :: String) () { out :: String }
9+layer = makeLayer do
10+ { a, b } <- Om.ask
11+ pure { out: show a <> b }
12+
13+bad = runLayer { a: 42 } layer
compile-fail-tests/WireLayersMissingDep.pursnew file+16
@@ -0,0 +1,16 @@
1+-- EXPECT: Dependency not provided!
2+module Yoga.Om.Layer.CompileFailTest where
3+
4+import Prelude
5+import Yoga.Om as Om
6+import Yoga.Om.Layer (OmLayer, Scope, makeLayer, wireLayers)
7+
8+a_base :: OmLayer (scope :: Scope) () { base :: String }
9+a_base = makeLayer (pure { base: "ok" })
10+
11+b_upper :: OmLayer (scope :: Scope, port :: Int) () { upper :: String }
12+b_upper = makeLayer do
13+ { port } <- Om.ask
14+ pure { upper: show port }
15+
16+bad = wireLayers { a_base, b_upper }
compile-fail-tests/run.shnew file+38
@@ -0,0 +1,38 @@
1+#!/bin/bash
2+cd "$(dirname "$0")/.."
3+
4+# Build the library first
5+bunx spago build > /dev/null 2>&1
6+
7+PASS=0
8+FAIL=0
9+TOTAL=0
10+
11+for f in compile-fail-tests/*.purs; do
12+ EXPECT=$(head -1 "$f" | sed 's/-- EXPECT: //')
13+ NAME=$(basename "$f" .purs)
14+ TOTAL=$((TOTAL + 1))
15+
16+ cp "$f" "src/_CompileFailTest.purs"
17+ OUTPUT=$(bunx spago build 2>&1) || true
18+ rm -f "src/_CompileFailTest.purs"
19+
20+ if echo "$OUTPUT" | grep -q "Build succeeded"; then
21+ echo "FAIL $NAME — compiled successfully (should have failed)"
22+ FAIL=$((FAIL + 1))
23+ elif echo "$OUTPUT" | grep -q "$EXPECT"; then
24+ echo "PASS $NAME — failed with expected: $EXPECT"
25+ PASS=$((PASS + 1))
26+ else
27+ echo "FAIL $NAME — failed but without expected '$EXPECT'"
28+ echo " Got: $(echo "$OUTPUT" | grep "ERROR\|error" | head -3)"
29+ FAIL=$((FAIL + 1))
30+ fi
31+done
32+
33+echo ""
34+echo "$PASS passed, $FAIL failed out of $TOTAL compile-fail tests"
35+
36+if [ "$FAIL" -ne 0 ]; then
37+ exit 1
38+fi
spago.lock+350−12
@@ -6,7 +6,7 @@
66 "core": {
77 "dependencies": [
88 {
9− "aff": ">=7.1.0 <8.0.0"
9+ "aff": ">=8.0.0 <9.0.0"
1010 },
1111 {
1212 "aff-retry": ">=2.0.0 <3.0.0"
@@ -14,6 +14,9 @@
1414 {
1515 "arrays": ">=7.3.0 <8.0.0"
1616 },
17+ {
18+ "control": ">=6.0.0 <7.0.0"
19+ },
1720 {
1821 "effect": ">=4.0.0 <5.0.0"
1922 },
@@ -23,9 +26,6 @@
2326 {
2427 "foldable-traversable": ">=6.0.0 <7.0.0"
2528 },
26− {
27− "integers": ">=6.0.0 <7.0.0"
28− },
2929 {
3030 "maybe": ">=6.0.0 <7.0.0"
3131 },
@@ -35,6 +35,9 @@
3535 {
3636 "ordered-collections": ">=3.2.0 <4.0.0"
3737 },
38+ {
39+ "parallel": ">=7.0.0 <8.0.0"
40+ },
3841 {
3942 "prelude": ">=6.0.2 <7.0.0"
4043 },
@@ -44,9 +47,21 @@
4447 {
4548 "record-studio": ">=1.0.4 <2.0.0"
4649 },
50+ {
51+ "refs": ">=6.0.0 <7.0.0"
52+ },
53+ {
54+ "tailrec": ">=6.1.0 <7.0.0"
55+ },
56+ {
57+ "transformers": ">=6.1.0 <7.0.0"
58+ },
4759 {
4860 "type-equality": ">=4.0.1 <5.0.0"
4961 },
62+ {
63+ "typelevel-prelude": ">=7.0.0 <8.0.0"
64+ },
5065 {
5166 "unsafe-coerce": ">=6.0.0 <7.0.0"
5267 },
@@ -54,7 +69,7 @@
5469 "variant": ">=8.0.0 <9.0.0"
5570 },
5671 {
57− "yoga-om": ">=1.2.2 <2.0.0"
72+ "yoga-om": ">=2.0.0 <3.0.0"
5873 }
5974 ]
6075 },
@@ -67,7 +82,13 @@
6782 "refs": ">=6.0.0 <7.0.0"
6883 },
6984 {
70− "spec": ">=7.0.0 <8.0.0"
85+ "spec": ">=7.0.0 <9.0.0"
86+ },
87+ {
88+ "spec-discovery": ">=8.0.0 <9.0.0"
89+ },
90+ {
91+ "spec-node": ">=0.0.3 <1.0.0"
7192 }
7293 ]
7394 }
@@ -78,8 +99,8 @@
7899 "packages": {
79100 "aff": {
80101 "type": "registry",
81− "version": "7.1.0",
82− "integrity": "sha256-/nOpDQVnKIoP1pQ1ZZBYpadK0TuMlG4WwufGzJpsfD0=",
102+ "version": "8.0.0",
103+ "integrity": "sha256-9BRIrSdRoYybfiUmBqgKJ66cPqxYHb277bVWQMn/9sg=",
83104 "dependencies": [
84105 "control",
85106 "datetime",
@@ -127,6 +148,53 @@
127148 "prelude"
128149 ]
129150 },
151+ "argonaut-codecs": {
152+ "type": "registry",
153+ "version": "9.1.0",
154+ "integrity": "sha256-K910SBrmYallESsm8pxJYThs7lig6hxX3M4PW33Cgew=",
155+ "dependencies": [
156+ "argonaut-core",
157+ "arrays",
158+ "bifunctors",
159+ "either",
160+ "foldable-traversable",
161+ "foreign-object",
162+ "identity",
163+ "integers",
164+ "lists",
165+ "maybe",
166+ "nonempty",
167+ "ordered-collections",
168+ "prelude",
169+ "record",
170+ "strings",
171+ "tuples"
172+ ]
173+ },
174+ "argonaut-core": {
175+ "type": "registry",
176+ "version": "7.0.0",
177+ "integrity": "sha256-gYZihtBIKthVuXXoiPphMookSf8M5aHyFYkcIWqlxTM=",
178+ "dependencies": [
179+ "arrays",
180+ "control",
181+ "either",
182+ "foreign-object",
183+ "functions",
184+ "gen",
185+ "maybe",
186+ "nonempty",
187+ "prelude",
188+ "strings",
189+ "tailrec"
190+ ]
191+ },
192+ "arraybuffer-types": {
193+ "type": "registry",
194+ "version": "3.0.2",
195+ "integrity": "sha256-p05cJnSkyeoB7VHzMyc2Eb1RwUaB7Nl0sQSqEGNEUD8=",
196+ "dependencies": []
197+ },
130198 "arrays": {
131199 "type": "registry",
132200 "version": "7.3.0",
@@ -318,6 +386,16 @@
318386 "unsafe-coerce"
319387 ]
320388 },
389+ "exitcodes": {
390+ "type": "registry",
391+ "version": "4.0.0",
392+ "integrity": "sha256-xBl4aFSEQ05Owp1ZvO6OxxvLK3LVzU35RSbj79SsePQ=",
393+ "dependencies": [
394+ "enums",
395+ "maybe",
396+ "prelude"
397+ ]
398+ },
321399 "foldable-traversable": {
322400 "type": "registry",
323401 "version": "6.0.0",
@@ -336,6 +414,42 @@
336414 "tuples"
337415 ]
338416 },
417+ "foreign": {
418+ "type": "registry",
419+ "version": "7.0.0",
420+ "integrity": "sha256-jiDRMVQfovGsbbA/FzbzYf6iWk9i2b5gNrIjz+gFfsI=",
421+ "dependencies": [
422+ "either",
423+ "functions",
424+ "integers",
425+ "lists",
426+ "maybe",
427+ "prelude",
428+ "strings",
429+ "transformers",
430+ "unsafe-coerce"
431+ ]
432+ },
433+ "foreign-object": {
434+ "type": "registry",
435+ "version": "4.1.0",
436+ "integrity": "sha256-x/Q7r80z/vmHRKvPwhYmHP/DnJciPtsyGfRTMzayKIU=",
437+ "dependencies": [
438+ "arrays",
439+ "foldable-traversable",
440+ "functions",
441+ "gen",
442+ "lists",
443+ "maybe",
444+ "prelude",
445+ "st",
446+ "tailrec",
447+ "tuples",
448+ "typelevel-prelude",
449+ "unfoldable",
450+ "unsafe-coerce"
451+ ]
452+ },
339453 "fork": {
340454 "type": "registry",
341455 "version": "6.0.0",
@@ -456,6 +570,21 @@
456570 "prelude"
457571 ]
458572 },
573+ "js-date": {
574+ "type": "registry",
575+ "version": "8.0.0",
576+ "integrity": "sha256-DNQrp4xYc8o80jtxo0aOkUeXGi6h0Xidkk2ZQ8Y4l5Y=",
577+ "dependencies": [
578+ "datetime",
579+ "effect",
580+ "enums",
581+ "foreign",
582+ "functions",
583+ "integers",
584+ "maybe",
585+ "prelude"
586+ ]
587+ },
459588 "lazy": {
460589 "type": "registry",
461590 "version": "6.0.0",
@@ -523,6 +652,107 @@
523652 "safe-coerce"
524653 ]
525654 },
655+ "node-buffer": {
656+ "type": "registry",
657+ "version": "9.0.0",
658+ "integrity": "sha256-RdQjilmEHqsT4fwpCr8Mavw8KTafYrS3ZM6zeAAVAl8=",
659+ "dependencies": [
660+ "arraybuffer-types",
661+ "effect",
662+ "functions",
663+ "maybe",
664+ "nullable",
665+ "partial",
666+ "prelude",
667+ "st",
668+ "unsafe-coerce"
669+ ]
670+ },
671+ "node-event-emitter": {
672+ "type": "registry",
673+ "version": "3.0.0",
674+ "integrity": "sha256-wodx71NxJBPXOaawFn01V1ByYB2vT+I3RuV2giOVKMg=",
675+ "dependencies": [
676+ "effect",
677+ "either",
678+ "functions",
679+ "maybe",
680+ "nullable",
681+ "prelude",
682+ "unsafe-coerce"
683+ ]
684+ },
685+ "node-fs": {
686+ "type": "registry",
687+ "version": "9.2.0",
688+ "integrity": "sha256-fxioTSm9y47WuYs9F/7nxCh/RVDCl3Kr3Hg779J4SJA=",
689+ "dependencies": [
690+ "aff",
691+ "datetime",
692+ "effect",
693+ "either",
694+ "enums",
695+ "exceptions",
696+ "functions",
697+ "integers",
698+ "js-date",
699+ "maybe",
700+ "node-buffer",
701+ "node-path",
702+ "node-streams",
703+ "nullable",
704+ "partial",
705+ "prelude",
706+ "strings"
707+ ]
708+ },
709+ "node-path": {
710+ "type": "registry",
711+ "version": "5.0.1",
712+ "integrity": "sha256-j7n/SmpVz0FOMJl4XZop3ofJ+MeIPkMNqUEUKHEL6Us=",
713+ "dependencies": [
714+ "effect"
715+ ]
716+ },
717+ "node-process": {
718+ "type": "registry",
719+ "version": "11.2.0",
720+ "integrity": "sha256-onzKeNmaeYfN3HSDPqSFTrrP2Yl9tnVsfKKhnf2plxM=",
721+ "dependencies": [
722+ "effect",
723+ "exceptions",
724+ "foreign",
725+ "foreign-object",
726+ "maybe",
727+ "node-event-emitter",
728+ "node-streams",
729+ "nullable",
730+ "posix-types",
731+ "prelude",
732+ "strings"
733+ ]
734+ },
735+ "node-streams": {
736+ "type": "registry",
737+ "version": "9.0.1",
738+ "integrity": "sha256-yuVGm/R/tBr4Nphi+a1a984Z0fkmN9Q5wWtSmbmJTpA=",
739+ "dependencies": [
740+ "aff",
741+ "arrays",
742+ "effect",
743+ "either",
744+ "exceptions",
745+ "maybe",
746+ "node-buffer",
747+ "node-event-emitter",
748+ "nullable",
749+ "prelude",
750+ "refs",
751+ "st",
752+ "tailrec",
753+ "unsafe-coerce"
754+ ]
755+ },
526756 "nonempty": {
527757 "type": "registry",
528758 "version": "7.0.0",
@@ -566,6 +796,56 @@
566796 "prelude"
567797 ]
568798 },
799+ "open-memoize": {
800+ "type": "registry",
801+ "version": "6.2.0",
802+ "integrity": "sha256-yJLuVYX8FocHIJ+6q7efH/Pj4S+e1Y57DZ5Dn7qf4ww=",
803+ "dependencies": [
804+ "either",
805+ "integers",
806+ "lazy",
807+ "lists",
808+ "maybe",
809+ "partial",
810+ "prelude",
811+ "strings",
812+ "tuples"
813+ ]
814+ },
815+ "optparse": {
816+ "type": "registry",
817+ "version": "5.0.1",
818+ "integrity": "sha256-2btDjHPRR0uujUQJuZAN9AzvVoXe7yG6IwnY5evERhQ=",
819+ "dependencies": [
820+ "arrays",
821+ "bifunctors",
822+ "control",
823+ "effect",
824+ "either",
825+ "enums",
826+ "exists",
827+ "exitcodes",
828+ "foldable-traversable",
829+ "free",
830+ "integers",
831+ "lazy",
832+ "lists",
833+ "maybe",
834+ "newtype",
835+ "node-buffer",
836+ "node-process",
837+ "node-streams",
838+ "nonempty",
839+ "numbers",
840+ "open-memoize",
841+ "partial",
842+ "prelude",
843+ "strings",
844+ "tailrec",
845+ "transformers",
846+ "tuples"
847+ ]
848+ },
569849 "ordered-collections": {
570850 "type": "registry",
571851 "version": "3.2.0",
@@ -641,6 +921,16 @@
641921 "tuples"
642922 ]
643923 },
924+ "posix-types": {
925+ "type": "registry",
926+ "version": "6.0.0",
927+ "integrity": "sha256-Je5jG439F/SFO/IvVevZnWVxDIonrehlKuJkefP2lHE=",
928+ "dependencies": [
929+ "maybe",
930+ "newtype",
931+ "prelude"
932+ ]
933+ },
644934 "prelude": {
645935 "type": "registry",
646936 "version": "6.0.2",
@@ -714,8 +1004,8 @@
7141004 },
7151005 "spec": {
7161006 "type": "registry",
717− "version": "7.6.1",
718− "integrity": "sha256-5GysDOS1gVbbGX75YXUdhww3h2S246Ck0sS6yt+ig+0=",
1007+ "version": "8.1.2",
1008+ "integrity": "sha256-klPPJ6lBQI1CGOAdLJ+ZoGRt8XZippkTKjn53BrSkL0=",
7191009 "dependencies": [
7201010 "aff",
7211011 "ansi",
@@ -746,6 +1036,51 @@
7461036 "tuples"
7471037 ]
7481038 },
1039+ "spec-discovery": {
1040+ "type": "registry",
1041+ "version": "8.4.0",
1042+ "integrity": "sha256-aFp8bllT/wrxQu8hMlDchQQY08dQAz+Xdq2hZi5z3yY=",
1043+ "dependencies": [
1044+ "aff",
1045+ "effect",
1046+ "foldable-traversable",
1047+ "prelude",
1048+ "spec",
1049+ "spec-node"
1050+ ]
1051+ },
1052+ "spec-node": {
1053+ "type": "registry",
1054+ "version": "0.0.3",
1055+ "integrity": "sha256-8/9+g0obbamV0YtqzmttbWs8HaWF7CEeW+eDtqzuAAo=",
1056+ "dependencies": [
1057+ "aff",
1058+ "argonaut-codecs",
1059+ "argonaut-core",
1060+ "arrays",
1061+ "control",
1062+ "datetime",
1063+ "effect",
1064+ "either",
1065+ "foldable-traversable",
1066+ "identity",
1067+ "integers",
1068+ "maybe",
1069+ "newtype",
1070+ "node-buffer",
1071+ "node-fs",
1072+ "node-process",
1073+ "now",
1074+ "numbers",
1075+ "optparse",
1076+ "ordered-collections",
1077+ "partial",
1078+ "prelude",
1079+ "spec",
1080+ "strings",
1081+ "tuples"
1082+ ]
1083+ },
7491084 "st": {
7501085 "type": "registry",
7511086 "version": "6.2.0",
@@ -896,10 +1231,11 @@
8961231 },
8971232 "yoga-om": {
8981233 "type": "registry",
899− "version": "1.2.2",
900− "integrity": "sha256-uDV3/o8mUOTIgSEQFqIATPyladzL8BcjURvfS901hgI=",
1234+ "version": "2.0.0",
1235+ "integrity": "sha256-eenoujD2rJzR6gYJbbIiqLhXHC1C5dagu91HZkAEt/Y=",
9011236 "dependencies": [
9021237 "aff",
1238+ "aff-retry",
9031239 "avar",
9041240 "console",
9051241 "control",
@@ -908,12 +1244,14 @@
9081244 "either",
9091245 "exceptions",
9101246 "functions",
1247+ "heterogeneous",
9111248 "maybe",
9121249 "newtype",
9131250 "parallel",
9141251 "prelude",
9151252 "record",
9161253 "record-studio",
1254+ "refs",
9171255 "tailrec",
9181256 "transformers",
9191257 "tuples",
spago.yaml+12−6
@@ -1,34 +1,40 @@
11workspace: {}
2−
32package:
43 name: yoga-om-layer
54 publish:
6− version: 1.0.6
5+ version: 2.1.0
76 license: MIT
87 location:
98 githubOwner: rowtype-yoga
109 githubRepo: purescript-yoga-om-layer
1110 dependencies:
12− - aff: ">=7.1.0 <8.0.0"
11+ - aff: ">=8.0.0 <9.0.0"
1312 - aff-retry: ">=2.0.0 <3.0.0"
1413 - arrays: ">=7.3.0 <8.0.0"
14+ - control: ">=6.0.0 <7.0.0"
1515 - effect: ">=4.0.0 <5.0.0"
1616 - exceptions: ">=6.1.0 <7.0.0"
1717 - foldable-traversable: ">=6.0.0 <7.0.0"
18− - integers: ">=6.0.0 <7.0.0"
1918 - maybe: ">=6.0.0 <7.0.0"
2019 - nullable: ">=6.0.0 <7.0.0"
2120 - ordered-collections: ">=3.2.0 <4.0.0"
21+ - parallel: ">=7.0.0 <8.0.0"
2222 - prelude: ">=6.0.2 <7.0.0"
2323 - record: ">=4.0.0 <5.0.0"
2424 - record-studio: ">=1.0.4 <2.0.0"
25+ - refs: ">=6.0.0 <7.0.0"
26+ - tailrec: ">=6.1.0 <7.0.0"
27+ - transformers: ">=6.1.0 <7.0.0"
2528 - type-equality: ">=4.0.1 <5.0.0"
29+ - typelevel-prelude: ">=7.0.0 <8.0.0"
2630 - unsafe-coerce: ">=6.0.0 <7.0.0"
2731 - variant: ">=8.0.0 <9.0.0"
28− - yoga-om: ">=1.2.2 <2.0.0"
32+ - yoga-om: ">=2.0.0 <3.0.0"
2933 test:
3034 main: Test.Main
3135 dependencies:
32− - spec: ">=7.0.0 <8.0.0"
36+ - spec: ">=7.0.0 <9.0.0"
37+ - spec-discovery: ">=8.0.0 <9.0.0"
38+ - spec-node: ">=0.0.3 <1.0.0"
3339 - console: ">=6.0.0 <7.0.0"
3440 - refs: ">=6.0.0 <7.0.0"
src/Yoga/Om/Layer.purs+538−7
@@ -13,21 +13,59 @@ module Yoga.Om.Layer
1313 , runScopedWith
1414 , withScoped
1515 , withScopedWith
16+ , scoped
1617 , combineRequirements
18+ , withValue
1719 , provide
1820 , (>->)
1921 , recovering
2022 , repeating
23+ , wireLayers
24+ , wireLayersDebug
25+ , class FilterScope
26+ , class FindProvider
27+ , class FindProviderMatch
28+ , class HasLabel
29+ , class EmitEdges
30+ , class DashesFor
31+ , class BoxTop, class BoxMid, class BoxBot
32+ , class RenderDepChildNode
33+ , class IsNotProvided
34+ , class HasDirectMissing, class HasDirectMissingOr
35+ , class FindLayerReqs
36+ , class RenderProviderDeps
37+ , class RenderDepTree
38+ , class FirstProvLabel
39+ , class PrintLayerDispatch
40+ , class PrintLayersRL
41+ , class PrintEdgesRL
42+ , class PrintLayersASCII
43+ , class PrintEdgesASCII
44+ , NotProvided
2145 , class CheckAllProvided
2246 , class CheckAllLabelsExist
2347 , class CheckLabelExists
48+ , class TopoWire, topoWire
49+ , class AllLabelsIn
50+ , class FindReady
51+ , class FindReadyDispatch
2452 ) where
2553
2654import Prelude
2755
28−import Control.Monad.Error.Class (catchError, throwError)
56+import Control.Alt (class Alt)
57+import Control.Alt as Alt
58+import Control.Alternative (class Alternative)
59+import Control.Monad.Error.Class (class MonadError, class MonadThrow, catchError, throwError)
60+import Control.Monad.Reader (class MonadAsk, class MonadReader)
61+import Control.Monad.Reader as Reader
62+import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
2963import Control.Parallel (class Parallel)
3064import Control.Parallel as Parallel
65+import Control.Plus (class Plus)
66+import Control.Plus as Plus
67+import Data.Symbol (class IsSymbol)
68+import Data.Variant (Variant)
3169import Data.Array as Array
3270import Data.Foldable (for_)
3371import Data.Map (Map)
@@ -38,20 +76,30 @@ import Data.Variant (class VariantMatchCases, onMatch)
3876import Effect (Effect)
3977import Effect.Aff (Aff, bracket)
4078import Effect.Aff.Retry (RetryPolicyM, RetryStatus, applyAndDelay, defaultRetryStatus)
41−import Effect.Class (liftEffect)
79+import Effect.Aff.Class (class MonadAff)
80+import Effect.Aff.Class as Aff
81+import Effect.Class (class MonadEffect, liftEffect)
82+import Effect.Class (class MonadEffect, liftEffect) as Effect
4283import Effect.Exception (Error)
4384import Effect.Ref (Ref)
4485import Effect.Ref as Ref
4586import Effect.Unsafe (unsafePerformEffect)
4687import Prim.Row (class Nub, class Union)
88+import Prim.Row as Row
89+import Type.Proxy (Proxy(..))
4790import Prim.RowList (class RowToList, Cons, Nil, RowList)
48−import Prim.TypeError (class Fail, Above, Quote, Text)
91+import Prim.Boolean (True, False)
92+import Prim.Symbol (class Append, class Cons)
93+import Type.Data.Boolean (class And)
94+import Type.RowList (class RowListAppend)
95+import Prim.TypeError (class Fail, class Warn, Above, Beside, Doc, Quote, Text)
4996import Record as Record
5097import Record.Studio (class Keys)
5198import Type.Equality (class TypeEquals)
5299import Unsafe.Coerce (unsafeCoerce)
53100import Yoga.Om (Om, ParOm)
54101import Yoga.Om as Om
102+import Yoga.Om.Error (Exception)
55103
56104-- =============================================================================
57105-- Scope — a first-class representation of resource lifetime
@@ -140,6 +188,36 @@ instance Bind (OmLayer req err) where
140188
141189instance Monad (OmLayer req err)
142190
191+instance MonadEffect (OmLayer req err) where
192+ liftEffect eff = OmLayer (freshId unit) (Effect.liftEffect eff)
193+
194+instance MonadAff (OmLayer req err) where
195+ liftAff aff = OmLayer (freshId unit) (Aff.liftAff aff)
196+
197+instance MonadAsk (Record req) (OmLayer req err) where
198+ ask = OmLayer (freshId unit) Reader.ask
199+
200+instance MonadReader (Record req) (OmLayer req err) where
201+ local f layer = OmLayer (freshId unit) (Reader.local f (buildLayer layer))
202+
203+instance MonadThrow (Variant (Exception err)) (OmLayer req err) where
204+ throwError e = OmLayer (freshId unit) (throwError e)
205+
206+instance MonadError (Variant (Exception err)) (OmLayer req err) where
207+ catchError layer handler = OmLayer (freshId unit) (catchError (buildLayer layer) (\e -> buildLayer (handler e)))
208+
209+instance MonadRec (OmLayer req err) where
210+ tailRecM f a = OmLayer (freshId unit) (tailRecM (\x -> buildLayer (f x)) a)
211+
212+instance Semigroup a => Semigroup (OmLayer req err a) where
213+ append a b = OmLayer (freshId unit) (append (buildLayer a) (buildLayer b))
214+
215+instance Alt (OmLayer req err) where
216+ alt a b = OmLayer (freshId unit) (Alt.alt (buildLayer a) (buildLayer b))
217+
218+instance Plus (OmLayer req err) where
219+ empty = OmLayer (freshId unit) Plus.empty
220+
143221instance Functor (ParOmLayer req err) where
144222 map f (ParOmLayer p) = ParOmLayer (map f p)
145223
@@ -149,6 +227,14 @@ instance Apply (ParOmLayer req err) where
149227instance Applicative (ParOmLayer req err) where
150228 pure a = ParOmLayer (pure a)
151229
230+instance Alt (ParOmLayer req err) where
231+ alt (ParOmLayer a) (ParOmLayer b) = ParOmLayer (Alt.alt a b)
232+
233+instance Plus (ParOmLayer req err) where
234+ empty = ParOmLayer Plus.empty
235+
236+instance Alternative (ParOmLayer req err)
237+
152238instance Parallel (ParOmLayer req err) (OmLayer req err) where
153239 parallel (OmLayer _ om) = ParOmLayer (Parallel.parallel om)
154240 sequential (ParOmLayer p) = OmLayer (freshId unit) (Parallel.sequential p)
@@ -306,9 +392,13 @@ else instance
306392-- =============================================================================
307393
308394-- | Run a layer with a given context, with custom error if requirements aren't met.
395+-- | `runLayer` requires a closed requirement row. If you have an open layer like
396+-- | `OmLayer (db :: Db | r) err a`, specialize it to a closed row before running
397+-- | it directly.
309398runLayer
310399 :: forall req err a available
311400 . CheckAllProvided req available
401+ => Keys req
312402 => Record available
313403 -> OmLayer req err a
314404 -> Om (Record available) err a
@@ -336,7 +426,7 @@ withScoped
336426 . OmLayer (scope :: Scope) () (Record prov)
337427 -> (Record prov -> Aff a)
338428 -> Aff a
339−withScoped = withScopedWith { exception: \_ -> pure (unsafeCoerce {}) }
429+withScoped = withScopedWith { exception: throwError }
340430
341431-- | Like `runScoped` but accepts error handlers for layers with typed errors.
342432runScopedWith
@@ -369,12 +459,23 @@ withScopedWith handlers layer callback = bracket acquire release use
369459 release { scope } = closeScope scope
370460 use { prov } = callback prov
371461
462+scoped
463+ :: forall prov a r rl err_ err
464+ . RowToList (exception :: Error -> Aff (Record prov) | r) rl
465+ => VariantMatchCases rl err_ (Aff (Record prov))
466+ => Union err_ () (exception :: Error | err)
467+ => { exception :: Error -> Aff (Record prov) | r }
468+ -> OmLayer (scope :: Scope) err (Record prov)
469+ -> (Record prov -> Aff a)
470+ -> Aff a
471+scoped = withScopedWith
472+
372473-- =============================================================================
373474-- Horizontal composition — combine two layers with automatic deduplication
374475-- =============================================================================
375476
376477combineRequirements
377− :: forall req1 req2 prov1 prov2 err1 err2 provMerged provMergedRaw reqMerged reqDeduped errMerged errDeduped _req1 _req2 _err1 _err2
478+ :: forall req1 req2 prov1 prov2 err1 err2 provMerged reqMerged reqDeduped errMerged errDeduped _req1 _req2 _err1 _err2
378479 . Union req1 req2 reqMerged
379480 => Nub reqMerged reqDeduped
380481 => Union req1 _req1 reqDeduped
@@ -383,8 +484,8 @@ combineRequirements
383484 => Nub errMerged errDeduped
384485 => Union err1 _err1 errDeduped
385486 => Union err2 _err2 errDeduped
386− => Union prov1 prov2 provMergedRaw
387− => Nub provMergedRaw provMerged
487+ => Union prov1 prov2 provMerged
488+ => Nub provMerged provMerged
388489 => Keys req1
389490 => Keys req2
390491 => OmLayer req1 err1 (Record prov1)
@@ -395,6 +496,17 @@ combineRequirements layer1 layer2 = OmLayer (freshId unit) do
395496 rec2 <- Om.expand (buildLayer layer2)
396497 pure (Record.merge rec1 rec2)
397498
499+withValue
500+ :: forall req err prov1 prov2 provMerged
501+ . Union prov1 prov2 provMerged
502+ => Nub provMerged provMerged
503+ => Record prov1
504+ -> OmLayer req err (Record prov2)
505+ -> OmLayer req err (Record provMerged)
506+withValue defaults layer = OmLayer (freshId unit) do
507+ rec <- buildLayer layer
508+ pure (Record.merge defaults rec)
509+
398510-- =============================================================================
399511-- Vertical composition — feed output of one layer into input of another
400512-- =============================================================================
@@ -464,3 +576,422 @@ repeating policy shouldRepeat (OmLayer layerId om) =
464576 ifM (shouldRepeat status result)
465577 (applyAndDelay policy status >>= maybe (pure result) go)
466578 (pure result)
579+
580+
581+-- =============================================================================
582+-- Topological auto-wiring (order-independent)
583+-- =============================================================================
584+
585+-- | Check if ALL labels in `needles` exist in `haystack`, returning a Boolean.
586+class AllLabelsIn (needles :: RowList Type) (haystack :: RowList Type) (result :: Boolean)
587+ | needles haystack -> result
588+
589+instance AllLabelsIn Nil haystack True
590+
591+instance
592+ ( HasLabel label haystack found
593+ , AllLabelsIn tail haystack tailResult
594+ , And found tailResult result
595+ ) =>
596+ AllLabelsIn (Cons label ty tail) haystack result
597+
598+-- | Dispatch based on whether a layer is ready (deps satisfied).
599+class FindReadyDispatch
600+ (ready :: Boolean)
601+ (sym :: Symbol)
602+ (layer :: Type)
603+ (tail :: RowList Type)
604+ (available :: RowList Type)
605+ (allLayersRL :: RowList Type)
606+ (foundSym :: Symbol)
607+ (foundLayer :: Type)
608+ (rest :: RowList Type)
609+ | ready sym layer tail available allLayersRL -> foundSym foundLayer rest
610+
611+instance FindReadyDispatch True sym layer tail available allLayersRL sym layer tail
612+
613+else instance
614+ FindReady tail available allLayersRL foundSym foundLayer rest' =>
615+ FindReadyDispatch False sym layer tail available allLayersRL foundSym foundLayer (Cons sym layer rest')
616+
617+-- | Scan candidates for the first layer whose requirements are satisfied.
618+class FindReady
619+ (candidates :: RowList Type)
620+ (available :: RowList Type)
621+ (allLayersRL :: RowList Type)
622+ (sym :: Symbol)
623+ (layer :: Type)
624+ (rest :: RowList Type)
625+ | candidates available allLayersRL -> sym layer rest
626+
627+instance
628+ ( PrintLayersASCII allLayersRL graphDoc
629+ , Fail
630+ ( Above (Text "")
631+ ( Above (Text "Dependency not provided!")
632+ ( Above (Text "")
633+ ( Above (Text "No remaining layer has all its dependencies satisfied.")
634+ ( Above (Text "")
635+ ( Above (Text "Dependency graph:") graphDoc
636+ )
637+ )
638+ )
639+ )
640+ )
641+ )
642+ ) =>
643+ FindReady Nil available allLayersRL sym layer rest
644+
645+else instance
646+ ( RowToList req reqRL
647+ , AllLabelsIn reqRL available isReady
648+ , FindReadyDispatch isReady sym (OmLayer req err (Record prov)) tail available allLayersRL foundSym foundLayer rest
649+ ) =>
650+ FindReady (Cons sym (OmLayer req err (Record prov)) tail) available allLayersRL foundSym foundLayer rest
651+
652+-- | Topologically sort and wire layers. Each iteration finds a layer whose
653+-- | dependencies are already satisfied, processes it, and adds its provisions.
654+class TopoWire
655+ (remaining :: RowList Type)
656+ (layers :: Row Type)
657+ (accReq :: Row Type)
658+ (accErr :: Row Type)
659+ (accProv :: Row Type)
660+ (resReq :: Row Type)
661+ (resErr :: Row Type)
662+ (resProv :: Row Type)
663+ | remaining layers accReq accErr accProv -> resReq resErr resProv
664+ where
665+ topoWire
666+ :: Proxy remaining
667+ -> Record layers
668+ -> OmLayer accReq accErr (Record accProv)
669+ -> OmLayer resReq resErr (Record resProv)
670+
671+instance TopoWire Nil layers accReq accErr accProv accReq accErr accProv where
672+ topoWire _ _ acc = acc
673+
674+else instance
675+ ( RowToList layers allLayersRL
676+ , RowToList accProv accProvRL
677+ , RowToList accReq accReqRL
678+ , RowListAppend accProvRL accReqRL availableRL
679+ , FindReady remaining availableRL allLayersRL readySym (OmLayer nextReq nextErr (Record nextProv)) rest
680+ , IsSymbol readySym
681+ , Row.Cons readySym (OmLayer nextReq nextErr (Record nextProv)) _rest layers
682+ -- next's requirements must be subset of (accProv + accReq)
683+ , Union accProv accReq provReqOut
684+ , Nub provReqOut provReqOut
685+ , Union nextReq _nextReqRest provReqOut
686+ , Keys nextReq
687+ , Keys accReq
688+ , Keys accProv
689+ -- merge errors
690+ , Union accErr nextErr errMergedRaw
691+ , Nub errMergedRaw errMerged
692+ , Union accErr _e1 errMerged
693+ , Union nextErr _e2 errMerged
694+ -- merge provisions
695+ , Union accProv nextProv provMerged
696+ , Nub provMerged provMerged
697+ -- recurse
698+ , TopoWire rest layers accReq errMerged provMerged resReq resErr resProv
699+ ) =>
700+ TopoWire remaining layers accReq accErr accProv resReq resErr resProv where
701+ topoWire _ layers acc =
702+ topoWire (Proxy :: Proxy rest) layers combined
703+ where
704+ next :: OmLayer nextReq nextErr (Record nextProv)
705+ next = Record.get (Proxy :: Proxy readySym) layers
706+
707+ combined :: OmLayer accReq errMerged (Record provMerged)
708+ combined = OmLayer (freshId unit) do
709+ accProv <- Om.expandErr (buildLayer acc)
710+ nextProv <- Om.expand (buildLayer next) # Om.widenCtx accProv
711+ pure (Record.merge accProv nextProv)
712+
713+wireLayers
714+ :: forall layers rl req err prov
715+ . RowToList layers rl
716+ => TopoWire rl layers (scope :: Scope) () () req err prov
717+ => Record layers
718+ -> OmLayer req err (Record prov)
719+wireLayers layers =
720+ topoWire (Proxy :: Proxy rl) layers seed
721+ where
722+ seed = pure {} :: OmLayer (scope :: Scope) () (Record ())
723+
724+-- =============================================================================
725+-- Debug graph printing (D2 diagram)
726+-- =============================================================================
727+
728+-- | Remove `scope :: Scope` from a RowList (it's always present, just noise).
729+class FilterScope (rl :: RowList Type) (out :: RowList Type) | rl -> out
730+
731+instance FilterScope Nil Nil
732+instance FilterScope (Cons "scope" Scope tail) tail
733+else instance FilterScope tail out => FilterScope (Cons sym ty tail) (Cons sym ty out)
734+
735+-- | Marker symbol for unresolved dependencies.
736+type NotProvided :: Symbol
737+type NotProvided = "???"
738+
739+-- | Given a label, find which layer in the RowList provides it.
740+class FindProvider (label :: Symbol) (rl :: RowList Type) (provider :: Symbol) | label rl -> provider
741+
742+instance FindProvider label Nil NotProvided
743+
744+else instance
745+ ( RowToList prov provRL
746+ , HasLabel label provRL hasIt
747+ , FindProviderMatch hasIt label sym (Cons sym (OmLayer req err (Record prov)) tail) provider
748+ ) =>
749+ FindProvider label (Cons sym (OmLayer req err (Record prov)) tail) provider
750+
751+-- | Dispatch based on whether the current layer has the label.
752+class FindProviderMatch (hasIt :: Boolean) (label :: Symbol) (sym :: Symbol) (rl :: RowList Type) (provider :: Symbol) | hasIt label sym rl -> provider
753+
754+instance FindProviderMatch True label sym rl sym
755+
756+else instance
757+ FindProvider label tail provider =>
758+ FindProviderMatch False label sym (Cons sym ty tail) provider
759+
760+-- | Check if a RowList contains a given label.
761+class HasLabel (label :: Symbol) (rl :: RowList Type) (result :: Boolean) | label rl -> result
762+
763+instance HasLabel label Nil False
764+instance HasLabel label (Cons label ty tail) True
765+else instance HasLabel label tail result => HasLabel label (Cons sym ty tail) result
766+
767+-- | Emit D2 edges for one consumer: "provider -> consumer" per requirement.
768+class EmitEdges (consumer :: Symbol) (reqRL :: RowList Type) (allLayers :: RowList Type) (doc :: Doc) | consumer reqRL allLayers -> doc
769+
770+instance EmitEdges consumer Nil allLayers (Text "")
771+
772+else instance
773+ ( FindProvider label allLayers provider
774+ , Append " " provider s0
775+ , Append s0 " --> " s1
776+ , Append s1 consumer line
777+ , EmitEdges consumer tail allLayers restDoc
778+ ) =>
779+ EmitEdges consumer (Cons label ty tail) allLayers (Above (Text line) restDoc)
780+
781+-- | Walk all layers emitting D2 edges (mermaid format for wireLayersDebug).
782+class PrintLayersRL (rl :: RowList Type) (doc :: Doc) | rl -> doc
783+class PrintEdgesRL (rl :: RowList Type) (allLayers :: RowList Type) (doc :: Doc) | rl allLayers -> doc
784+
785+instance PrintLayersRL Nil (Text "")
786+else instance PrintEdgesRL rl rl doc => PrintLayersRL rl doc
787+
788+instance PrintEdgesRL Nil allLayers (Text "")
789+
790+else instance
791+ ( RowToList req reqRL
792+ , FilterScope reqRL filteredReqRL
793+ , EmitEdges sym filteredReqRL allLayers edgeDoc
794+ , PrintEdgesRL tail allLayers restDoc
795+ ) =>
796+ PrintEdgesRL (Cons sym (OmLayer req err (Record prov)) tail) allLayers (Above edgeDoc restDoc)
797+
798+-- | Map a symbol to same-length dashes (for box borders).
799+class DashesFor (sym :: Symbol) (dashes :: Symbol) | sym -> dashes
800+
801+instance DashesFor "" ""
802+
803+else instance
804+ ( Cons head tail sym
805+ , DashesFor tail rest
806+ , Append "─" rest dashes
807+ ) =>
808+ DashesFor sym dashes
809+
810+-- | Build box parts from a symbol.
811+class BoxTop (sym :: Symbol) (result :: Symbol) | sym -> result
812+
813+instance
814+ ( DashesFor sym dashes
815+ , Append "╭─" dashes s0
816+ , Append s0 "─╮" result
817+ ) =>
818+ BoxTop sym result
819+
820+class BoxMid (sym :: Symbol) (result :: Symbol) | sym -> result
821+
822+instance
823+ ( Append "│ " sym s0
824+ , Append s0 " │" result
825+ ) =>
826+ BoxMid sym result
827+
828+class BoxBot (sym :: Symbol) (result :: Symbol) | sym -> result
829+
830+instance
831+ ( DashesFor sym dashes
832+ , Append "╰─" dashes s0
833+ , Append s0 "─╯" result
834+ ) =>
835+ BoxBot sym result
836+
837+-- | Render a single dependency child node (dispatches on provided vs missing).
838+class RenderDepChildNode
839+ (isNotProvided :: Boolean) (provider :: Symbol) (label :: Symbol) (ty :: Type)
840+ (prePrefix :: Symbol) (contPrefix :: Symbol) (branchPrefix :: Symbol)
841+ (allLayers :: RowList Type) (doc :: Doc)
842+ | isNotProvided provider label ty prePrefix contPrefix branchPrefix allLayers -> doc
843+
844+-- Missing dep: boxed label, type outside
845+instance
846+ ( BoxTop label topLine, BoxMid label midLine, BoxBot label botLine
847+ , Append prePrefix topLine topFull
848+ , Append branchPrefix midLine midFull
849+ , Append contPrefix botLine botFull
850+ ) =>
851+ RenderDepChildNode True provider label ty prePrefix contPrefix branchPrefix allLayers
852+ (Above (Text topFull) (Above (Beside (Text midFull) (Beside (Text " :: ") (Beside (Quote ty) (Text " <-- ⚠️ not provided")))) (Text botFull)))
853+
854+-- Provided dep: boxed label, then recurse into provider's sub-tree
855+instance
856+ ( BoxTop label topLine, BoxMid label midLine, BoxBot label botLine
857+ , Append prePrefix topLine topFull
858+ , Append branchPrefix midLine midFull
859+ , Append contPrefix botLine botFull
860+ , Append contPrefix " " subTreePrefix
861+ , RenderProviderDeps provider subTreePrefix allLayers subDoc
862+ ) =>
863+ RenderDepChildNode False provider label ty prePrefix contPrefix branchPrefix allLayers
864+ (Above (Text topFull) (Above (Text midFull) (Above (Text botFull) subDoc)))
865+
866+-- | Is this provider the NotProvided marker?
867+class IsNotProvided (provider :: Symbol) (result :: Boolean) | provider -> result
868+instance IsNotProvided NotProvided True
869+else instance IsNotProvided other False
870+
871+-- | Does any requirement in this RowList resolve to NotProvided?
872+class HasDirectMissing (reqRL :: RowList Type) (allLayers :: RowList Type) (result :: Boolean)
873+ | reqRL allLayers -> result
874+
875+instance HasDirectMissing Nil allLayers False
876+
877+else instance
878+ ( FindProvider label allLayers provider
879+ , IsNotProvided provider isMissing
880+ , HasDirectMissingOr isMissing tail allLayers result
881+ ) =>
882+ HasDirectMissing (Cons label ty tail) allLayers result
883+
884+class HasDirectMissingOr (found :: Boolean) (tail :: RowList Type) (allLayers :: RowList Type) (result :: Boolean)
885+ | found tail allLayers -> result
886+
887+instance HasDirectMissingOr True tail allLayers True
888+
889+else instance
890+ HasDirectMissing tail allLayers result =>
891+ HasDirectMissingOr False tail allLayers result
892+
893+-- | Look up a layer's requirements by name.
894+class FindLayerReqs (sym :: Symbol) (allLayers :: RowList Type) (reqRL :: RowList Type)
895+ | sym allLayers -> reqRL
896+
897+instance
898+ RowToList req reqRL =>
899+ FindLayerReqs sym (Cons sym (OmLayer req err (Record prov)) tail) reqRL
900+
901+else instance
902+ FindLayerReqs sym tail reqRL =>
903+ FindLayerReqs sym (Cons other otherLayer tail) reqRL
904+
905+-- | Render a provider's sub-tree (stops at NotProvided or roots).
906+class RenderProviderDeps
907+ (provider :: Symbol) (prefix :: Symbol) (allLayers :: RowList Type) (doc :: Doc)
908+ | provider prefix allLayers -> doc
909+
910+instance RenderProviderDeps NotProvided prefix allLayers (Text "")
911+
912+else instance
913+ ( FindLayerReqs provider allLayers reqRL
914+ , FilterScope reqRL filteredReqRL
915+ , RenderDepTree prefix filteredReqRL allLayers doc
916+ ) =>
917+ RenderProviderDeps provider prefix allLayers doc
918+
919+-- | Render a dependency tree with tree connectors.
920+class RenderDepTree
921+ (prefix :: Symbol) (reqRL :: RowList Type) (allLayers :: RowList Type) (doc :: Doc)
922+ | prefix reqRL allLayers -> doc
923+
924+instance RenderDepTree prefix Nil allLayers (Text "")
925+
926+-- Last child: └───
927+else instance
928+ ( FindProvider label allLayers provider
929+ , IsNotProvided provider isNP
930+ , Append prefix "│ " prePrefix
931+ , Append prefix " " contPrefix
932+ , Append prefix "└───" branchPrefix
933+ , RenderDepChildNode isNP provider label ty prePrefix contPrefix branchPrefix allLayers doc
934+ ) =>
935+ RenderDepTree prefix (Cons label ty Nil) allLayers doc
936+
937+-- Non-last child: ├───
938+else instance
939+ ( FindProvider label allLayers provider
940+ , IsNotProvided provider isNP
941+ , Append prefix "│ " contPrefix
942+ , Append prefix "├───" branchPrefix
943+ , RenderDepChildNode isNP provider label ty contPrefix contPrefix branchPrefix allLayers childDoc
944+ , RenderDepTree prefix tail allLayers restDoc
945+ ) =>
946+ RenderDepTree prefix (Cons label ty tail) allLayers (Above childDoc restDoc)
947+
948+-- | Extract the first label from a RowList.
949+class FirstProvLabel (rl :: RowList Type) (label :: Symbol) | rl -> label
950+instance FirstProvLabel (Cons label ty tail) label
951+
952+-- | Dispatch: skip layers without missing deps, render tree for others.
953+class PrintLayerDispatch
954+ (show :: Boolean) (displayName :: Symbol) (filteredReqRL :: RowList Type)
955+ (tail :: RowList Type) (allLayers :: RowList Type) (doc :: Doc)
956+ | show displayName filteredReqRL tail allLayers -> doc
957+
958+instance
959+ PrintEdgesASCII tail allLayers doc =>
960+ PrintLayerDispatch False displayName filteredReqRL tail allLayers doc
961+
962+else instance
963+ ( BoxTop displayName topLine, BoxMid displayName midLine, BoxBot displayName botLine
964+ , RenderDepTree " " filteredReqRL allLayers treeDoc
965+ , PrintEdgesASCII tail allLayers restDoc
966+ ) =>
967+ PrintLayerDispatch True displayName filteredReqRL tail allLayers
968+ (Above (Text topLine) (Above (Text midLine) (Above (Text botLine) (Above treeDoc (Above (Text "") restDoc)))))
969+
970+-- | Walk all layers emitting ASCII dependency trees (for error messages).
971+class PrintLayersASCII (rl :: RowList Type) (doc :: Doc) | rl -> doc
972+class PrintEdgesASCII (rl :: RowList Type) (allLayers :: RowList Type) (doc :: Doc) | rl allLayers -> doc
973+
974+instance PrintLayersASCII Nil (Text "")
975+else instance PrintEdgesASCII rl rl doc => PrintLayersASCII rl doc
976+
977+instance PrintEdgesASCII Nil allLayers (Text "")
978+
979+else instance
980+ ( RowToList req reqRL
981+ , FilterScope reqRL filteredReqRL
982+ , RowToList prov provRL
983+ , FirstProvLabel provRL displayName
984+ , HasDirectMissing filteredReqRL allLayers hasMissing
985+ , PrintLayerDispatch hasMissing displayName filteredReqRL tail allLayers doc
986+ ) =>
987+ PrintEdgesASCII (Cons sym (OmLayer req err (Record prov)) tail) allLayers doc
988+
989+wireLayersDebug
990+ :: forall layers rl req err prov doc
991+ . RowToList layers rl
992+ => PrintLayersRL rl doc
993+ => Warn (Above (Text "") (Above (Text "%%{init: {\"flowchart\": {\"defaultRenderer\": \"elk\"}} }%%") (Above (Text "flowchart LR") doc)))
994+ => TopoWire rl layers (scope :: Scope) () () req err prov
995+ => Record layers
996+ -> OmLayer req err (Record prov)
997+wireLayersDebug = wireLayers
test/Test/Main.purs+6−659
@@ -2,667 +2,14 @@ module Test.Main where
22
33import Prelude
44
5−import Control.Parallel (parApply)
65import Effect (Effect)
7−import Effect.Aff (launchAff_, throwError, try)
8−import Effect.Aff.Class (liftAff)
9−import Effect.Exception (error)
6+import Effect.Aff (launchAff_)
107import Effect.Class (liftEffect)
11−import Effect.Class.Console as Console
12−import Effect.Ref as Ref
13−import Test.Spec (describe, it)
14−import Test.Spec.Assertions (shouldEqual)
8+import Test.Spec.Discovery (discover)
159import Test.Spec.Reporter (consoleReporter)
16−import Test.Spec.Runner (runSpec)
17−import Data.Either (Either(..))
18−import Data.Variant (match)
19−import Yoga.Om as Om
20−import Data.Time.Duration (Milliseconds(..))
21−import Effect.Aff.Retry (RetryStatus(..), limitRetries, constantDelay)
22−import Yoga.Om.Layer (OmLayer, Scope, makeLayer, makeScopedLayer, bracketLayer, fresh, combineRequirements, runLayer, runScoped, runScopedWith, withScoped, provide, recovering, repeating)
23−
24−-- Example types
25−type Config = { port :: Int, host :: String }
26−type Logger = { log :: String -> Effect Unit }
27−type Database = { query :: String -> Effect (Array String) }
10+import Test.Spec.Runner.Node (runSpecAndExitProcess)
2811
2912main :: Effect Unit
30−main = launchAff_ $ runSpec [ consoleReporter ] do
31− describe "OmLayer - Proof of Concept: Type-Level Deduplication" do
32−
33− it "proves Row.Nub deduplicates shared requirements at type level" do
34− let
35− loggerLayer :: OmLayer (config :: Config) () { logger :: Logger }
36− loggerLayer = makeLayer do
37− { config } <- Om.ask
38− pure { logger: { log: \msg -> Console.log $ "[" <> config.host <> "] " <> msg } }
39−
40− databaseLayer :: OmLayer (config :: Config) () { database :: Database }
41− databaseLayer = makeLayer do
42− { config } <- Om.ask
43− pure { database: { query: \q -> pure [ "Result from " <> config.host ] } }
44−
45− let
46− _proofOfDeduplication :: OmLayer (config :: Config) _ _
47− _proofOfDeduplication = combineRequirements loggerLayer databaseLayer
48−
49− Console.log "Type-level deduplication works: (config, config) -> (config)"
50− pure unit
51−
52− it "proves deduplication at runtime via shared Ref" do
53− accessLog <- liftEffect $ Ref.new ""
54− let
55− combinedLayer :: OmLayer (config :: Config, accessLog :: Ref.Ref String) () { logger :: Logger, database :: Database }
56− combinedLayer = makeLayer do
57− { config, accessLog: log } <- Om.ask
58− liftEffect $ Ref.modify_ (_ <> "config-accessed-by-logger ") log
59− let logger = { log: \msg -> Console.log $ "[" <> config.host <> "] " <> msg }
60− liftEffect $ Ref.modify_ (_ <> "config-accessed-by-database ") log
61− let database = { query: \q -> pure [ "Result from " <> config.host ] }
62− pure { logger, database }
63−
64− let
65− ctx =
66− { config: { port: 5432, host: "localhost" }
67− , accessLog: accessLog
68− }
69− result <- runLayer ctx combinedLayer
70− # Om.runOm ctx
71− { exception: \_ -> pure { logger: { log: \_ -> pure unit }, database: { query: \_ -> pure [] } } }
72−
73− finalLog <- liftEffect $ Ref.read accessLog
74− finalLog `shouldEqual` "config-accessed-by-logger config-accessed-by-database "
75−
76− liftEffect $ result.logger.log "Testing logger from combined layer"
77− queryResult <- liftEffect $ result.database.query "SELECT *"
78− queryResult `shouldEqual` [ "Result from localhost" ]
79−
80− describe "Scoped Layers" do
81−
82− it "runs finalizers in reverse order on success" do
83− log <- liftEffect $ Ref.new []
84− let
85− layerA :: OmLayer (scope :: Scope) () { a :: String }
86− layerA = makeScopedLayer
87− (pure { a: "A" })
88− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-A" ]) log)
89−
90− layerB :: OmLayer (scope :: Scope) () { b :: String }
91− layerB = makeScopedLayer
92− (pure { b: "B" })
93− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-B" ]) log)
94−
95− layerC :: OmLayer (scope :: Scope) () { c :: String }
96− layerC = makeScopedLayer
97− (pure { c: "C" })
98− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-C" ]) log)
99−
100− layerBC :: OmLayer (scope :: Scope) () { b :: String, c :: String }
101− layerBC = combineRequirements layerB layerC
102−
103− combined = combineRequirements layerA layerBC
104−
105− _ <- liftAff $ runScoped combined
106− finalLog <- liftEffect $ Ref.read log
107− finalLog `shouldEqual` [ "release-C", "release-B", "release-A" ]
108−
109− it "runs finalizers when the callback throws" do
110− log <- liftEffect $ Ref.new []
111− let
112− layer :: OmLayer (scope :: Scope) () { value :: String }
113− layer = makeScopedLayer
114− (pure { value: "acquired" })
115− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "released" ]) log)
116−
117− _ <- liftAff $ try $ withScoped layer \_ ->
118− throwError (error "callback failed")
119− finalLog <- liftEffect $ Ref.read log
120− finalLog `shouldEqual` [ "released" ]
121−
122− it "threads finalizers through vertical composition (provide)" do
123− log <- liftEffect $ Ref.new []
124− let
125− baseLayer :: OmLayer (scope :: Scope) () { base :: String }
126− baseLayer = makeScopedLayer
127− (pure { base: "base-value" })
128− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-base" ]) log)
129−
130− upperLayer :: OmLayer (scope :: Scope, base :: String) () { upper :: String }
131− upperLayer = makeScopedLayer
132− ( do
133− { base } <- Om.ask
134− pure { upper: base <> "-extended" }
135− )
136− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-upper" ]) log)
137−
138− composed = upperLayer `provide` baseLayer
139−
140− result <- liftAff $ runScoped composed
141− result.upper `shouldEqual` "base-value-extended"
142− finalLog <- liftEffect $ Ref.read log
143− finalLog `shouldEqual` [ "release-upper", "release-base" ]
144−
145− it "works with bracketLayer" do
146− log <- liftEffect $ Ref.new []
147− let
148− layer = bracketLayer
149− ( do
150− liftEffect $ Ref.modify_ (_ <> [ "acquire" ]) log
151− pure 42
152− )
153− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release" ]) log)
154− (\n -> pure { value: n })
155−
156− result <- liftAff $ runScoped layer
157− result.value `shouldEqual` 42
158− finalLog <- liftEffect $ Ref.read log
159− finalLog `shouldEqual` [ "acquire", "release" ]
160−
161− it "fresh layer builds twice even when same base layer" do
162− counter <- liftEffect $ Ref.new 0
163− let
164− baseLayer :: OmLayer (scope :: Scope) () { value :: String }
165− baseLayer = makeLayer do
166− liftEffect $ Ref.modify_ (_ + 1) counter
167− pure { value: "built" }
168−
169− branch1 :: OmLayer (scope :: Scope) () { out1 :: String }
170− branch1 = consumer `provide` fresh baseLayer
171− where
172− consumer :: OmLayer (scope :: Scope, value :: String) () { out1 :: String }
173− consumer = makeLayer do
174− { value } <- Om.ask
175− pure { out1: value <> "-1" }
176−
177− branch2 :: OmLayer (scope :: Scope) () { out2 :: String }
178− branch2 = consumer `provide` fresh baseLayer
179− where
180− consumer :: OmLayer (scope :: Scope, value :: String) () { out2 :: String }
181− consumer = makeLayer do
182− { value } <- Om.ask
183− pure { out2: value <> "-2" }
184−
185− app = combineRequirements branch1 branch2
186−
187− result <- liftAff $ runScoped app
188− result.out1 `shouldEqual` "built-1"
189− result.out2 `shouldEqual` "built-2"
190− count <- liftEffect $ Ref.read counter
191− count `shouldEqual` 2
192−
193− it "combines scoped and non-scoped layers" do
194− log <- liftEffect $ Ref.new []
195− let
196− scopedLayer :: OmLayer (scope :: Scope) () { scoped :: String }
197− scopedLayer = makeScopedLayer
198− (pure { scoped: "yes" })
199− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-scoped" ]) log)
200−
201− plainLayer :: OmLayer () () { plain :: String }
202− plainLayer = makeLayer (pure { plain: "no-finalizer" })
203−
204− combined = combineRequirements scopedLayer plainLayer
205−
206− result <- liftAff $ runScoped combined
207− result.scoped `shouldEqual` "yes"
208− result.plain `shouldEqual` "no-finalizer"
209− finalLog <- liftEffect $ Ref.read log
210− finalLog `shouldEqual` [ "release-scoped" ]
211−
212− describe "Automatic Memoization" do
213−
214− it "builds the same layer only once when used in two branches" do
215− counter <- liftEffect $ Ref.new 0
216− let
217− expensiveLayer :: OmLayer (scope :: Scope) () { value :: String }
218− expensiveLayer = makeLayer do
219− liftEffect $ Ref.modify_ (_ + 1) counter
220− pure { value: "built" }
221−
222− branch1 :: OmLayer (scope :: Scope) () { out1 :: String }
223− branch1 = consumer `provide` expensiveLayer
224− where
225− consumer :: OmLayer (scope :: Scope, value :: String) () { out1 :: String }
226− consumer = makeLayer do
227− { value } <- Om.ask
228− pure { out1: value <> "-1" }
229−
230− branch2 :: OmLayer (scope :: Scope) () { out2 :: String }
231− branch2 = consumer `provide` expensiveLayer
232− where
233− consumer :: OmLayer (scope :: Scope, value :: String) () { out2 :: String }
234− consumer = makeLayer do
235− { value } <- Om.ask
236− pure { out2: value <> "-2" }
237−
238− app = combineRequirements branch1 branch2
239−
240− result <- liftAff $ runScoped app
241− result.out1 `shouldEqual` "built-1"
242− result.out2 `shouldEqual` "built-2"
243− count <- liftEffect $ Ref.read counter
244− count `shouldEqual` 1
245−
246− it "memoized scoped layer runs finalizer only once" do
247− log <- liftEffect $ Ref.new []
248− let
249− dbLayer :: OmLayer (scope :: Scope) () { db :: String }
250− dbLayer = makeScopedLayer
251− (pure { db: "connected" })
252− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "db-closed" ]) log)
253−
254− repoBranch :: OmLayer (scope :: Scope) () { repo :: String }
255− repoBranch = repo `provide` dbLayer
256− where
257− repo :: OmLayer (scope :: Scope, db :: String) () { repo :: String }
258− repo = makeLayer do
259− { db } <- Om.ask
260− pure { repo: db <> "-repo" }
261−
262− analyticsBranch :: OmLayer (scope :: Scope) () { analytics :: String }
263− analyticsBranch = analytics `provide` dbLayer
264− where
265− analytics :: OmLayer (scope :: Scope, db :: String) () { analytics :: String }
266− analytics = makeLayer do
267− { db } <- Om.ask
268− pure { analytics: db <> "-analytics" }
269−
270− app = combineRequirements repoBranch analyticsBranch
271−
272− result <- liftAff $ runScoped app
273− result.repo `shouldEqual` "connected-repo"
274− result.analytics `shouldEqual` "connected-analytics"
275− finalLog <- liftEffect $ Ref.read log
276− finalLog `shouldEqual` [ "db-closed" ]
277−
278− it "memoized bracketLayer acquires and releases only once" do
279− log <- liftEffect $ Ref.new []
280− let
281− connLayer :: OmLayer (scope :: Scope) () { conn :: Int }
282− connLayer = bracketLayer
283− ( do
284− liftEffect $ Ref.modify_ (_ <> [ "acquire" ]) log
285− pure 42
286− )
287− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release" ]) log)
288− (\n -> pure { conn: n })
289−
290− branch1 :: OmLayer (scope :: Scope) () { x :: String }
291− branch1 = upper `provide` connLayer
292− where
293− upper :: OmLayer (scope :: Scope, conn :: Int) () { x :: String }
294− upper = makeLayer do
295− { conn } <- Om.ask
296− pure { x: show conn }
297−
298− branch2 :: OmLayer (scope :: Scope) () { y :: String }
299− branch2 = upper `provide` connLayer
300− where
301− upper :: OmLayer (scope :: Scope, conn :: Int) () { y :: String }
302− upper = makeLayer do
303− { conn } <- Om.ask
304− pure { y: show (conn + 1) }
305−
306− app = combineRequirements branch1 branch2
307−
308− result <- liftAff $ runScoped app
309− result.x `shouldEqual` "42"
310− result.y `shouldEqual` "43"
311− finalLog <- liftEffect $ Ref.read log
312− finalLog `shouldEqual` [ "acquire", "release" ]
313−
314− describe "Error Channel" do
315−
316− it "composes layers with different error types" do
317− let
318− dbLayer :: OmLayer () (dbError :: String) { db :: String }
319− dbLayer = makeLayer do
320− pure { db: "connected" }
321−
322− cacheLayer :: OmLayer () (cacheError :: String) { cache :: String }
323− cacheLayer = makeLayer do
324− pure { cache: "ready" }
325−
326− combined :: OmLayer () (dbError :: String, cacheError :: String) { db :: String, cache :: String }
327− combined = combineRequirements dbLayer cacheLayer
328−
329− result <- Om.runOm {}
330− { exception: \_ -> pure { db: "", cache: "" }
331− , dbError: \_ -> pure { db: "", cache: "" }
332− , cacheError: \_ -> pure { db: "", cache: "" }
333− }
334− (runLayer {} combined)
335− result.db `shouldEqual` "connected"
336− result.cache `shouldEqual` "ready"
337−
338− it "propagates errors from the first layer" do
339− let
340− failingLayer :: OmLayer () (dbError :: String) { db :: String }
341− failingLayer = makeLayer do
342− Om.throw { dbError: "connection refused" }
343−
344− okLayer :: OmLayer () () { cache :: String }
345− okLayer = makeLayer do
346− pure { cache: "ready" }
347−
348− combined = combineRequirements failingLayer okLayer
349−
350− result <- Om.runReader {} (runLayer {} combined)
351− # liftAff
352− case result of
353− Left err -> do
354− let
355− msg = err # match
356− { exception: \_ -> "exception"
357− , dbError: \e -> e
358− }
359− msg `shouldEqual` "connection refused"
360− Right _ -> "should have failed" `shouldEqual` "but succeeded"
361−
362− it "propagates errors from the second layer" do
363− let
364− okLayer :: OmLayer () () { db :: String }
365− okLayer = makeLayer do
366− pure { db: "connected" }
367−
368− failingLayer :: OmLayer () (cacheError :: String) { cache :: String }
369− failingLayer = makeLayer do
370− Om.throw { cacheError: "cache unavailable" }
371−
372− combined = combineRequirements okLayer failingLayer
373−
374− result <- Om.runReader {} (runLayer {} combined)
375− # liftAff
376− case result of
377− Left err -> do
378− let
379− msg = err # match
380− { exception: \_ -> "exception"
381− , cacheError: \e -> e
382− }
383− msg `shouldEqual` "cache unavailable"
384− Right _ -> "should have failed" `shouldEqual` "but succeeded"
385−
386− it "propagates errors through vertical composition" do
387− let
388− baseLayer :: OmLayer () (baseError :: String) { base :: String }
389− baseLayer = makeLayer do
390− Om.throw { baseError: "base failed" }
391−
392− upperLayer :: OmLayer (base :: String) (upperError :: String) { upper :: String }
393− upperLayer = makeLayer do
394− { base } <- Om.ask
395− pure { upper: base <> "-extended" }
396−
397− composed = upperLayer `provide` baseLayer
398−
399− result <- Om.runReader {} (runLayer {} composed)
400− # liftAff
401− case result of
402− Left err -> do
403− let
404− msg = err # match
405− { exception: \_ -> "exception"
406− , baseError: \e -> e
407− , upperError: \_ -> "upper"
408− }
409− msg `shouldEqual` "base failed"
410− Right _ -> "should have failed" `shouldEqual` "but succeeded"
411−
412− it "scoped layers with errors run via runScopedWith" do
413− log <- liftEffect $ Ref.new []
414− let
415− dbLayer :: OmLayer (scope :: Scope) (dbError :: String) { db :: String }
416− dbLayer = makeScopedLayer
417− (pure { db: "connected" })
418− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "db-closed" ]) log)
419−
420− cacheLayer :: OmLayer (scope :: Scope) (cacheError :: String) { cache :: String }
421− cacheLayer = makeScopedLayer
422− (pure { cache: "ready" })
423− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "cache-closed" ]) log)
424−
425− combined = combineRequirements dbLayer cacheLayer
426−
427− let
428− handlers =
429− { exception: \_ -> pure { db: "", cache: "" }
430− , dbError: \_ -> pure { db: "", cache: "" }
431− , cacheError: \_ -> pure { db: "", cache: "" }
432− }
433− result <- liftAff $ runScopedWith handlers combined
434− result.db `shouldEqual` "connected"
435− result.cache `shouldEqual` "ready"
436− finalLog <- liftEffect $ Ref.read log
437− finalLog `shouldEqual` [ "cache-closed", "db-closed" ]
438−
439− it "scoped layer error triggers finalizers" do
440− log <- liftEffect $ Ref.new []
441− let
442− goodLayer :: OmLayer (scope :: Scope) () { good :: String }
443− goodLayer = makeScopedLayer
444− (pure { good: "ok" })
445− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "good-closed" ]) log)
446−
447− failLayer :: OmLayer (scope :: Scope) (buildError :: String) { bad :: String }
448− failLayer = makeScopedLayer
449− (Om.throw { buildError: "build failed" })
450− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "bad-closed" ]) log)
451−
452− combined = combineRequirements goodLayer failLayer
453−
454− let
455− handlers =
456− { exception: \_ -> pure { good: "", bad: "" }
457− , buildError: \_ -> pure { good: "", bad: "" }
458− }
459− result <- liftAff $ try $ runScopedWith handlers combined
460− case result of
461− Right r -> r.good `shouldEqual` ""
462− Left _ -> pure unit
463− finalLog <- liftEffect $ Ref.read log
464− finalLog `shouldEqual` [ "good-closed" ]
465−
466− describe "Functor / Apply / Bind" do
467−
468− it "maps over layer output" do
469− let
470− layer :: OmLayer () () { value :: Int }
471− layer = makeLayer (pure { value: 10 })
472−
473− mapped = layer <#> \r -> { doubled: r.value * 2 }
474−
475− result <- Om.runOm {} { exception: \_ -> pure { doubled: 0 } } (runLayer {} mapped)
476− result.doubled `shouldEqual` 20
477−
478− it "applies two layers" do
479− let
480− fLayer :: OmLayer () () ({ a :: Int } -> { a :: Int, b :: String })
481− fLayer = makeLayer (pure \r -> { a: r.a, b: show r.a })
482−
483− aLayer :: OmLayer () () { a :: Int }
484− aLayer = makeLayer (pure { a: 42 })
485−
486− result <- Om.runOm {} { exception: \_ -> pure { a: 0, b: "" } } (runLayer {} (fLayer <*> aLayer))
487− result.a `shouldEqual` 42
488− result.b `shouldEqual` "42"
489−
490− it "binds layers sequentially" do
491− let
492− layer = do
493− r <- makeLayer (pure { x: 5 }) :: OmLayer () () { x :: Int }
494− makeLayer (pure { result: r.x + 10 })
495−
496− result <- Om.runOm {} { exception: \_ -> pure { result: 0 } } (runLayer {} layer)
497− result.result `shouldEqual` 15
498−
499− describe "Parallel" do
500−
501− it "runs layers in parallel via parApply" do
502− log <- liftEffect $ Ref.new []
503− let
504− layerA :: OmLayer () () { a :: String }
505− layerA = makeLayer do
506− liftEffect $ Ref.modify_ (_ <> [ "a" ]) log
507− pure { a: "A" }
508−
509− layerB :: OmLayer () () { b :: String }
510− layerB = makeLayer do
511− liftEffect $ Ref.modify_ (_ <> [ "b" ]) log
512− pure { b: "B" }
513−
514− combined = parApply (map (\ra rb -> { a: ra.a, b: rb.b }) layerA) layerB
515−
516− result <- Om.runOm {} { exception: \_ -> pure { a: "", b: "" } } (runLayer {} combined)
517− result.a `shouldEqual` "A"
518− result.b `shouldEqual` "B"
519− finalLog <- liftEffect $ Ref.read log
520− finalLog `shouldEqual` [ "a", "b" ]
521−
522− describe "Layer recovering" do
523−
524− it "retries layer construction on matching errors" do
525− attemptsRef <- liftEffect $ Ref.new 0
526− let
527− layer :: OmLayer () (dbError :: String) { db :: String }
528− layer = makeLayer do
529− attempts <- Ref.modify (_ + 1) attemptsRef # liftEffect
530− when (attempts < 3) do
531− Om.throw { dbError: "connection refused" }
532− pure { db: "connected" }
533−
534− retried = layer
535− # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 5)
536− \_ -> { dbError: \_ -> pure true }
537−
538− result <- Om.runOm {}
539− { exception: \_ -> pure { db: "" }, dbError: \_ -> pure { db: "" } }
540− (runLayer {} retried)
541− result.db `shouldEqual` "connected"
542− attempts <- liftEffect $ Ref.read attemptsRef
543− attempts `shouldEqual` 3
544−
545− it "does not retry on non-matching errors" do
546− attemptsRef <- liftEffect $ Ref.new 0
547− let
548− layer :: OmLayer () (dbError :: String, authError :: String) { db :: String }
549− layer = makeLayer do
550− Ref.modify_ (_ + 1) attemptsRef # liftEffect
551− Om.throw { authError: "unauthorized" }
552−
553− retried = layer
554− # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 3)
555− \_ -> { dbError: \_ -> pure true }
556−
557− _ <- Om.runOm {}
558− { exception: \_ -> pure { db: "" }
559− , dbError: \_ -> pure { db: "" }
560− , authError: \_ -> pure { db: "" }
561− }
562− (runLayer {} retried)
563− attempts <- liftEffect $ Ref.read attemptsRef
564− attempts `shouldEqual` 1
565−
566− it "preserves the error when retries are exhausted" do
567− let
568− layer :: OmLayer () (dbError :: String) { db :: String }
569− layer = makeLayer do
570− Om.throw { dbError: "connection refused" }
571−
572− retried = layer
573− # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 2)
574− \_ -> { dbError: \_ -> pure true }
575−
576− result <- Om.runReader {} (runLayer {} retried)
577− # liftAff
578− case result of
579− Left err -> do
580− let
581− msg = err # match
582− { exception: \_ -> "exception"
583− , dbError: \e -> e
584− }
585− msg `shouldEqual` "connection refused"
586− Right _ -> "should have failed" `shouldEqual` "but succeeded"
587−
588− it "only retries the specified error in a multi-error layer" do
589− attemptsRef <- liftEffect $ Ref.new 0
590− let
591− layer :: OmLayer () (dbError :: String, cacheError :: String) { db :: String }
592− layer = makeLayer do
593− attempts <- Ref.modify (_ + 1) attemptsRef # liftEffect
594− if attempts <= 2 then Om.throw { dbError: "db down" }
595− else Om.throw { cacheError: "cache miss" }
596−
597− retried = layer
598− # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 5)
599− \_ -> { dbError: \_ -> pure true }
600−
601− result <- Om.runReader {} (runLayer {} retried)
602− # liftAff
603− case result of
604− Left err -> do
605− let
606− msg = err # match
607− { exception: \_ -> "exception"
608− , dbError: \e -> e
609− , cacheError: \e -> e
610− }
611− msg `shouldEqual` "cache miss"
612− Right _ -> "should have failed" `shouldEqual` "but succeeded"
613− attempts <- liftEffect $ Ref.read attemptsRef
614− attempts `shouldEqual` 3
615−
616− it "uses RetryStatus in the check" do
617− attemptsRef <- liftEffect $ Ref.new 0
618− let
619− layer :: OmLayer () (dbError :: String) { db :: String }
620− layer = makeLayer do
621− Ref.modify_ (_ + 1) attemptsRef # liftEffect
622− Om.throw { dbError: "fail" }
623−
624− retried = layer
625− # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 10)
626− \(RetryStatus s) -> { dbError: \_ -> pure (s.iterNumber < 2) }
627−
628− _ <- Om.runOm {}
629− { exception: \_ -> pure { db: "" }, dbError: \_ -> pure { db: "" } }
630− (runLayer {} retried)
631− attempts <- liftEffect $ Ref.read attemptsRef
632− attempts `shouldEqual` 3
633−
634− describe "Layer repeating" do
635−
636− it "repeats layer construction while condition holds" do
637− counterRef <- liftEffect $ Ref.new 0
638− let
639− layer :: OmLayer () () { count :: Int }
640− layer = makeLayer do
641− count <- Ref.modify (_ + 1) counterRef # liftEffect
642− pure { count }
643−
644− repeated = layer
645− # repeating (constantDelay (Milliseconds 0.0) <> limitRetries 10)
646− \_ r -> pure (r.count < 5)
647−
648− result <- Om.runOm {}
649− { exception: \_ -> pure { count: 0 } }
650− (runLayer {} repeated)
651− result.count `shouldEqual` 5
652−
653− it "stops when policy exhausted" do
654− counterRef <- liftEffect $ Ref.new 0
655− let
656− layer :: OmLayer () () { count :: Int }
657− layer = makeLayer do
658− count <- Ref.modify (_ + 1) counterRef # liftEffect
659− pure { count }
660−
661− repeated = layer
662− # repeating (constantDelay (Milliseconds 0.0) <> limitRetries 3)
663− \_ _ -> pure true
664−
665− result <- Om.runOm {}
666− { exception: \_ -> pure { count: 0 } }
667− (runLayer {} repeated)
668− result.count `shouldEqual` 4
13+main = launchAff_ do
14+ specs <- discover "Test\\.Yoga\\.Om\\.Layer\\..*Spec"
15+ liftEffect $ runSpecAndExitProcess [ consoleReporter ] specs
test/Test/Yoga/Om/Layer/CompositionSpec.pursnew file+59
@@ -0,0 +1,59 @@
1+module Test.Yoga.Om.Layer.CompositionSpec where
2+
3+import Prelude
4+
5+import Effect (Effect)
6+import Effect.Class (liftEffect)
7+import Effect.Class.Console as Console
8+import Effect.Ref as Ref
9+import Test.Spec (Spec, describe, it)
10+import Test.Spec.Assertions (shouldEqual)
11+import Yoga.Om as Om
12+import Yoga.Om.Layer (OmLayer, makeLayer, combineRequirements, runLayer)
13+
14+type Config = { port :: Int, host :: String }
15+type Logger = { log :: String -> Effect Unit }
16+type Database = { query :: String -> Effect (Array String) }
17+
18+loggerLayer :: OmLayer (config :: Config) () { logger :: Logger }
19+loggerLayer = makeLayer do
20+ { config } <- Om.ask
21+ pure { logger: { log: \msg -> Console.log $ "[" <> config.host <> "] " <> msg } }
22+
23+databaseLayer :: OmLayer (config :: Config) () { database :: Database }
24+databaseLayer = makeLayer do
25+ { config } <- Om.ask
26+ pure { database: { query: \_ -> pure [ "Result from " <> config.host ] } }
27+
28+spec :: Spec Unit
29+spec = describe "Composition" do
30+
31+ it "proves Row.Nub deduplicates shared requirements at type level" do
32+ let
33+ _proofOfDeduplication :: OmLayer (config :: Config) _ _
34+ _proofOfDeduplication = combineRequirements loggerLayer databaseLayer
35+ Console.log "Type-level deduplication works: (config, config) -> (config)"
36+
37+ it "proves deduplication at runtime via shared Ref" do
38+ accessLog <- liftEffect $ Ref.new ""
39+ let
40+ combinedLayer :: OmLayer (config :: Config, accessLog :: Ref.Ref String) () { logger :: Logger, database :: Database }
41+ combinedLayer = makeLayer do
42+ { config, accessLog: log } <- Om.ask
43+ liftEffect $ Ref.modify_ (_ <> "config-accessed-by-logger ") log
44+ let logger = { log: \msg -> Console.log $ "[" <> config.host <> "] " <> msg }
45+ liftEffect $ Ref.modify_ (_ <> "config-accessed-by-database ") log
46+ let database = { query: \_ -> pure [ "Result from " <> config.host ] }
47+ pure { logger, database }
48+
49+ let ctx = { config: { port: 5432, host: "localhost" }, accessLog: accessLog }
50+ result <- runLayer ctx combinedLayer
51+ # Om.runOm ctx
52+ { exception: \_ -> pure { logger: { log: \_ -> pure unit }, database: { query: \_ -> pure [] } } }
53+
54+ finalLog <- liftEffect $ Ref.read accessLog
55+ finalLog `shouldEqual` "config-accessed-by-logger config-accessed-by-database "
56+
57+ liftEffect $ result.logger.log "Testing logger from combined layer"
58+ queryResult <- liftEffect $ result.database.query "SELECT *"
59+ queryResult `shouldEqual` [ "Result from localhost" ]
test/Test/Yoga/Om/Layer/ErrorChannelSpec.pursnew file+167
@@ -0,0 +1,167 @@
1+module Test.Yoga.Om.Layer.ErrorChannelSpec where
2+
3+import Prelude
4+
5+import Effect.Aff (try)
6+import Effect.Aff.Class (liftAff)
7+import Effect.Class (liftEffect)
8+import Effect.Ref as Ref
9+import Data.Either (Either(..))
10+import Data.Variant (match)
11+import Test.Spec (Spec, describe, it)
12+import Test.Spec.Assertions (shouldEqual)
13+import Yoga.Om as Om
14+import Yoga.Om.Layer (OmLayer, Scope, makeLayer, makeScopedLayer, combineRequirements, runLayer, runScopedWith, provide)
15+
16+spec :: Spec Unit
17+spec = describe "Error Channel" do
18+
19+ it "composes layers with different error types" do
20+ let
21+ dbLayer :: OmLayer () (dbError :: String) { db :: String }
22+ dbLayer = makeLayer do
23+ pure { db: "connected" }
24+
25+ cacheLayer :: OmLayer () (cacheError :: String) { cache :: String }
26+ cacheLayer = makeLayer do
27+ pure { cache: "ready" }
28+
29+ combined :: OmLayer () (dbError :: String, cacheError :: String) { db :: String, cache :: String }
30+ combined = combineRequirements dbLayer cacheLayer
31+
32+ result <- Om.runOm {}
33+ { exception: \_ -> pure { db: "", cache: "" }
34+ , dbError: \_ -> pure { db: "", cache: "" }
35+ , cacheError: \_ -> pure { db: "", cache: "" }
36+ }
37+ (runLayer {} combined)
38+ result.db `shouldEqual` "connected"
39+ result.cache `shouldEqual` "ready"
40+
41+ it "propagates errors from the first layer" do
42+ let
43+ failingLayer :: OmLayer () (dbError :: String) { db :: String }
44+ failingLayer = makeLayer do
45+ Om.throw { dbError: "connection refused" }
46+
47+ okLayer :: OmLayer () () { cache :: String }
48+ okLayer = makeLayer do
49+ pure { cache: "ready" }
50+
51+ combined = combineRequirements failingLayer okLayer
52+
53+ result <- Om.runReader {} (runLayer {} combined)
54+ # liftAff
55+ case result of
56+ Left err -> do
57+ let
58+ msg = err # match
59+ { exception: \_ -> "exception"
60+ , dbError: \e -> e
61+ }
62+ msg `shouldEqual` "connection refused"
63+ Right _ -> "should have failed" `shouldEqual` "but succeeded"
64+
65+ it "propagates errors from the second layer" do
66+ let
67+ okLayer :: OmLayer () () { db :: String }
68+ okLayer = makeLayer do
69+ pure { db: "connected" }
70+
71+ failingLayer :: OmLayer () (cacheError :: String) { cache :: String }
72+ failingLayer = makeLayer do
73+ Om.throw { cacheError: "cache unavailable" }
74+
75+ combined = combineRequirements okLayer failingLayer
76+
77+ result <- Om.runReader {} (runLayer {} combined)
78+ # liftAff
79+ case result of
80+ Left err -> do
81+ let
82+ msg = err # match
83+ { exception: \_ -> "exception"
84+ , cacheError: \e -> e
85+ }
86+ msg `shouldEqual` "cache unavailable"
87+ Right _ -> "should have failed" `shouldEqual` "but succeeded"
88+
89+ it "propagates errors through vertical composition" do
90+ let
91+ baseLayer :: OmLayer () (baseError :: String) { base :: String }
92+ baseLayer = makeLayer do
93+ Om.throw { baseError: "base failed" }
94+
95+ upperLayer :: OmLayer (base :: String) (upperError :: String) { upper :: String }
96+ upperLayer = makeLayer do
97+ { base } <- Om.ask
98+ pure { upper: base <> "-extended" }
99+
100+ composed = upperLayer `provide` baseLayer
101+
102+ result <- Om.runReader {} (runLayer {} composed)
103+ # liftAff
104+ case result of
105+ Left err -> do
106+ let
107+ msg = err # match
108+ { exception: \_ -> "exception"
109+ , baseError: \e -> e
110+ , upperError: \_ -> "upper"
111+ }
112+ msg `shouldEqual` "base failed"
113+ Right _ -> "should have failed" `shouldEqual` "but succeeded"
114+
115+ it "scoped layers with errors run via runScopedWith" do
116+ log <- liftEffect $ Ref.new []
117+ let
118+ dbLayer :: OmLayer (scope :: Scope) (dbError :: String) { db :: String }
119+ dbLayer = makeScopedLayer
120+ (pure { db: "connected" })
121+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "db-closed" ]) log)
122+
123+ cacheLayer :: OmLayer (scope :: Scope) (cacheError :: String) { cache :: String }
124+ cacheLayer = makeScopedLayer
125+ (pure { cache: "ready" })
126+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "cache-closed" ]) log)
127+
128+ combined = combineRequirements dbLayer cacheLayer
129+
130+ let
131+ handlers =
132+ { exception: \_ -> pure { db: "", cache: "" }
133+ , dbError: \_ -> pure { db: "", cache: "" }
134+ , cacheError: \_ -> pure { db: "", cache: "" }
135+ }
136+ result <- liftAff $ runScopedWith handlers combined
137+ result.db `shouldEqual` "connected"
138+ result.cache `shouldEqual` "ready"
139+ finalLog <- liftEffect $ Ref.read log
140+ finalLog `shouldEqual` [ "cache-closed", "db-closed" ]
141+
142+ it "scoped layer error triggers finalizers" do
143+ log <- liftEffect $ Ref.new []
144+ let
145+ goodLayer :: OmLayer (scope :: Scope) () { good :: String }
146+ goodLayer = makeScopedLayer
147+ (pure { good: "ok" })
148+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "good-closed" ]) log)
149+
150+ failLayer :: OmLayer (scope :: Scope) (buildError :: String) { bad :: String }
151+ failLayer = makeScopedLayer
152+ (Om.throw { buildError: "build failed" })
153+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "bad-closed" ]) log)
154+
155+ combined = combineRequirements goodLayer failLayer
156+
157+ let
158+ handlers =
159+ { exception: \_ -> pure { good: "", bad: "" }
160+ , buildError: \_ -> pure { good: "", bad: "" }
161+ }
162+ result <- liftAff $ try $ runScopedWith handlers combined
163+ case result of
164+ Right r -> r.good `shouldEqual` ""
165+ Left _ -> pure unit
166+ finalLog <- liftEffect $ Ref.read log
167+ finalLog `shouldEqual` [ "good-closed" ]
test/Test/Yoga/Om/Layer/InstancesSpec.pursnew file+163
@@ -0,0 +1,163 @@
1+module Test.Yoga.Om.Layer.InstancesSpec where
2+
3+import Prelude
4+
5+import Control.Alt ((<|>))
6+import Control.Monad.Reader (ask, local)
7+import Control.Parallel (parApply)
8+import Effect.Class (liftEffect)
9+import Effect.Ref as Ref
10+import Test.Spec (Spec, describe, it)
11+import Test.Spec.Assertions (shouldEqual)
12+import Effect.Exception as Exception
13+import Yoga.Om as Om
14+import Yoga.Om.Layer (OmLayer, makeLayer, runLayer)
15+
16+spec :: Spec Unit
17+spec = do
18+
19+ describe "Functor / Apply / Bind" do
20+
21+ it "maps over layer output" do
22+ let
23+ layer :: OmLayer () () { value :: Int }
24+ layer = makeLayer (pure { value: 10 })
25+
26+ mapped = layer <#> \r -> { doubled: r.value * 2 }
27+
28+ result <- Om.runOm {} { exception: \_ -> pure { doubled: 0 } } (runLayer {} mapped)
29+ result.doubled `shouldEqual` 20
30+
31+ it "applies two layers" do
32+ let
33+ fLayer :: OmLayer () () ({ a :: Int } -> { a :: Int, b :: String })
34+ fLayer = makeLayer (pure \r -> { a: r.a, b: show r.a })
35+
36+ aLayer :: OmLayer () () { a :: Int }
37+ aLayer = makeLayer (pure { a: 42 })
38+
39+ result <- Om.runOm {} { exception: \_ -> pure { a: 0, b: "" } } (runLayer {} (fLayer <*> aLayer))
40+ result.a `shouldEqual` 42
41+ result.b `shouldEqual` "42"
42+
43+ it "binds layers sequentially" do
44+ let
45+ layer = do
46+ r <- makeLayer (pure { x: 5 }) :: OmLayer () () { x :: Int }
47+ makeLayer (pure { result: r.x + 10 })
48+
49+ result <- Om.runOm {} { exception: \_ -> pure { result: 0 } } (runLayer {} layer)
50+ result.result `shouldEqual` 15
51+
52+ it "runs layers against a superset context" do
53+ let
54+ layer :: OmLayer (a :: Int) () { out :: Int }
55+ layer = makeLayer do
56+ { a } <- Om.ask
57+ pure { out: a + 1 }
58+
59+ ctx = { a: 41, extra: "ok" }
60+
61+ result <- Om.runOm ctx { exception: \_ -> pure { out: 0 } } (runLayer ctx layer)
62+ result.out `shouldEqual` 42
63+
64+ describe "MonadEffect / MonadAff" do
65+
66+ it "liftEffect works directly in layer bind" do
67+ ref <- liftEffect $ Ref.new 0
68+ let
69+ layer :: OmLayer () () Int
70+ layer = do
71+ liftEffect $ Ref.write 42 ref
72+ liftEffect $ Ref.read ref
73+
74+ result <- Om.runOm {} { exception: \_ -> pure 0 } (runLayer {} layer)
75+ result `shouldEqual` 42
76+
77+ describe "MonadAsk / MonadReader" do
78+
79+ it "ask reads the context directly" do
80+ let
81+ layer :: OmLayer (port :: Int) () Int
82+ layer = do
83+ ctx <- ask
84+ pure ctx.port
85+
86+ result <- Om.runOm { port: 8080 } { exception: \_ -> pure 0 } (runLayer { port: 8080 } layer)
87+ result `shouldEqual` 8080
88+
89+ it "local modifies context for a layer" do
90+ let
91+ inner :: OmLayer (port :: Int) () Int
92+ inner = do
93+ ctx <- ask
94+ pure ctx.port
95+
96+ layer :: OmLayer (port :: Int) () Int
97+ layer = local (\r -> r { port = r.port + 1 }) inner
98+
99+ result <- Om.runOm { port: 8080 } { exception: \_ -> pure 0 } (runLayer { port: 8080 } layer)
100+ result `shouldEqual` 8081
101+
102+ describe "MonadThrow / MonadError" do
103+
104+ it "throwError raises into the error channel" do
105+ let
106+ layer :: OmLayer () (myErr :: String) Int
107+ layer = Om.throw { myErr: "boom" }
108+
109+ result <- Om.runOm {}
110+ { exception: \_ -> pure (-1), myErr: \_ -> pure (-2) }
111+ (runLayer {} layer)
112+ result `shouldEqual` (-2)
113+
114+ describe "Alt" do
115+
116+ it "falls back to second layer on failure" do
117+ let
118+ failing :: OmLayer () () Int
119+ failing = Om.throw { exception: Exception.error "nope" }
120+
121+ fallback :: OmLayer () () Int
122+ fallback = pure 99
123+
124+ layer = failing <|> fallback
125+
126+ result <- Om.runOm {} { exception: \_ -> pure (-1) } (runLayer {} layer)
127+ result `shouldEqual` 99
128+
129+ describe "Semigroup" do
130+
131+ it "appends layer outputs" do
132+ let
133+ a :: OmLayer () () String
134+ a = pure "hello"
135+
136+ b :: OmLayer () () String
137+ b = pure " world"
138+
139+ result <- Om.runOm {} { exception: \_ -> pure "" } (runLayer {} (a <> b))
140+ result `shouldEqual` "hello world"
141+
142+ describe "Parallel" do
143+
144+ it "runs layers in parallel via parApply" do
145+ log <- liftEffect $ Ref.new []
146+ let
147+ layerA :: OmLayer () () { a :: String }
148+ layerA = makeLayer do
149+ liftEffect $ Ref.modify_ (_ <> [ "a" ]) log
150+ pure { a: "A" }
151+
152+ layerB :: OmLayer () () { b :: String }
153+ layerB = makeLayer do
154+ liftEffect $ Ref.modify_ (_ <> [ "b" ]) log
155+ pure { b: "B" }
156+
157+ combined = parApply (map (\ra rb -> { a: ra.a, b: rb.b }) layerA) layerB
158+
159+ result <- Om.runOm {} { exception: \_ -> pure { a: "", b: "" } } (runLayer {} combined)
160+ result.a `shouldEqual` "A"
161+ result.b `shouldEqual` "B"
162+ finalLog <- liftEffect $ Ref.read log
163+ finalLog `shouldEqual` [ "a", "b" ]
test/Test/Yoga/Om/Layer/MemoizationSpec.pursnew file+114
@@ -0,0 +1,114 @@
1+module Test.Yoga.Om.Layer.MemoizationSpec where
2+
3+import Prelude
4+
5+import Effect.Aff.Class (liftAff)
6+import Effect.Class (liftEffect)
7+import Effect.Ref as Ref
8+import Test.Spec (Spec, describe, it)
9+import Test.Spec.Assertions (shouldEqual)
10+import Yoga.Om as Om
11+import Yoga.Om.Layer (OmLayer, Scope, makeLayer, makeScopedLayer, bracketLayer, combineRequirements, runScoped, provide)
12+
13+spec :: Spec Unit
14+spec = describe "Automatic Memoization" do
15+
16+ it "builds the same layer only once when used in two branches" do
17+ counter <- liftEffect $ Ref.new 0
18+ let
19+ expensiveLayer :: OmLayer (scope :: Scope) () { value :: String }
20+ expensiveLayer = makeLayer do
21+ liftEffect $ Ref.modify_ (_ + 1) counter
22+ pure { value: "built" }
23+
24+ branch1 :: OmLayer (scope :: Scope) () { out1 :: String }
25+ branch1 = consumer `provide` expensiveLayer
26+ where
27+ consumer :: OmLayer (scope :: Scope, value :: String) () { out1 :: String }
28+ consumer = makeLayer do
29+ { value } <- Om.ask
30+ pure { out1: value <> "-1" }
31+
32+ branch2 :: OmLayer (scope :: Scope) () { out2 :: String }
33+ branch2 = consumer `provide` expensiveLayer
34+ where
35+ consumer :: OmLayer (scope :: Scope, value :: String) () { out2 :: String }
36+ consumer = makeLayer do
37+ { value } <- Om.ask
38+ pure { out2: value <> "-2" }
39+
40+ app = combineRequirements branch1 branch2
41+
42+ result <- liftAff $ runScoped app
43+ result.out1 `shouldEqual` "built-1"
44+ result.out2 `shouldEqual` "built-2"
45+ count <- liftEffect $ Ref.read counter
46+ count `shouldEqual` 1
47+
48+ it "memoized scoped layer runs finalizer only once" do
49+ log <- liftEffect $ Ref.new []
50+ let
51+ dbLayer :: OmLayer (scope :: Scope) () { db :: String }
52+ dbLayer = makeScopedLayer
53+ (pure { db: "connected" })
54+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "db-closed" ]) log)
55+
56+ repoBranch :: OmLayer (scope :: Scope) () { repo :: String }
57+ repoBranch = repo `provide` dbLayer
58+ where
59+ repo :: OmLayer (scope :: Scope, db :: String) () { repo :: String }
60+ repo = makeLayer do
61+ { db } <- Om.ask
62+ pure { repo: db <> "-repo" }
63+
64+ analyticsBranch :: OmLayer (scope :: Scope) () { analytics :: String }
65+ analyticsBranch = analytics `provide` dbLayer
66+ where
67+ analytics :: OmLayer (scope :: Scope, db :: String) () { analytics :: String }
68+ analytics = makeLayer do
69+ { db } <- Om.ask
70+ pure { analytics: db <> "-analytics" }
71+
72+ app = combineRequirements repoBranch analyticsBranch
73+
74+ result <- liftAff $ runScoped app
75+ result.repo `shouldEqual` "connected-repo"
76+ result.analytics `shouldEqual` "connected-analytics"
77+ finalLog <- liftEffect $ Ref.read log
78+ finalLog `shouldEqual` [ "db-closed" ]
79+
80+ it "memoized bracketLayer acquires and releases only once" do
81+ log <- liftEffect $ Ref.new []
82+ let
83+ connLayer :: OmLayer (scope :: Scope) () { conn :: Int }
84+ connLayer = bracketLayer
85+ ( do
86+ liftEffect $ Ref.modify_ (_ <> [ "acquire" ]) log
87+ pure 42
88+ )
89+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release" ]) log)
90+ (\n -> pure { conn: n })
91+
92+ branch1 :: OmLayer (scope :: Scope) () { x :: String }
93+ branch1 = upper `provide` connLayer
94+ where
95+ upper :: OmLayer (scope :: Scope, conn :: Int) () { x :: String }
96+ upper = makeLayer do
97+ { conn } <- Om.ask
98+ pure { x: show conn }
99+
100+ branch2 :: OmLayer (scope :: Scope) () { y :: String }
101+ branch2 = upper `provide` connLayer
102+ where
103+ upper :: OmLayer (scope :: Scope, conn :: Int) () { y :: String }
104+ upper = makeLayer do
105+ { conn } <- Om.ask
106+ pure { y: show (conn + 1) }
107+
108+ app = combineRequirements branch1 branch2
109+
110+ result <- liftAff $ runScoped app
111+ result.x `shouldEqual` "42"
112+ result.y `shouldEqual` "43"
113+ finalLog <- liftEffect $ Ref.read log
114+ finalLog `shouldEqual` [ "acquire", "release" ]
test/Test/Yoga/Om/Layer/PureInferenceSpec.pursnew file+22
@@ -0,0 +1,22 @@
1+module Test.Yoga.Om.Layer.PureInferenceSpec where
2+
3+import Prelude
4+
5+import Test.Spec (Spec, describe, it)
6+import Test.Spec.Assertions (shouldEqual)
7+import Yoga.Om as Om
8+import Yoga.Om.Layer (OmLayer, withValue, makeLayer, runLayer)
9+
10+spec :: Spec Unit
11+spec = describe "withValue" do
12+
13+ it "combines a plain record with a layer without needing VTA" do
14+ let
15+ layer :: OmLayer () () { value :: Int }
16+ layer = makeLayer (pure { value: 42 })
17+
18+ result = layer # withValue { extra: "hello" }
19+
20+ out <- Om.runOm {} { exception: \_ -> pure { value: -1, extra: "" } } (runLayer {} result)
21+ out.value `shouldEqual` 42
22+ out.extra `shouldEqual` "hello"
test/Test/Yoga/Om/Layer/RecoveringSpec.pursnew file+128
@@ -0,0 +1,128 @@
1+module Test.Yoga.Om.Layer.RecoveringSpec where
2+
3+import Prelude
4+
5+import Effect.Aff.Class (liftAff)
6+import Effect.Class (liftEffect)
7+import Effect.Ref as Ref
8+import Data.Either (Either(..))
9+import Data.Variant (match)
10+import Data.Time.Duration (Milliseconds(..))
11+import Effect.Aff.Retry (RetryStatus(..), limitRetries, constantDelay)
12+import Test.Spec (Spec, describe, it)
13+import Test.Spec.Assertions (shouldEqual)
14+import Yoga.Om as Om
15+import Yoga.Om.Layer (OmLayer, makeLayer, runLayer, recovering)
16+
17+spec :: Spec Unit
18+spec = describe "Layer recovering" do
19+
20+ it "retries layer construction on matching errors" do
21+ attemptsRef <- liftEffect $ Ref.new 0
22+ let
23+ layer :: OmLayer () (dbError :: String) { db :: String }
24+ layer = makeLayer do
25+ attempts <- Ref.modify (_ + 1) attemptsRef # liftEffect
26+ when (attempts < 3) do
27+ Om.throw { dbError: "connection refused" }
28+ pure { db: "connected" }
29+
30+ retried = layer
31+ # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 5)
32+ \_ -> { dbError: \_ -> pure true }
33+
34+ result <- Om.runOm {}
35+ { exception: \_ -> pure { db: "" }, dbError: \_ -> pure { db: "" } }
36+ (runLayer {} retried)
37+ result.db `shouldEqual` "connected"
38+ attempts <- liftEffect $ Ref.read attemptsRef
39+ attempts `shouldEqual` 3
40+
41+ it "does not retry on non-matching errors" do
42+ attemptsRef <- liftEffect $ Ref.new 0
43+ let
44+ layer :: OmLayer () (dbError :: String, authError :: String) { db :: String }
45+ layer = makeLayer do
46+ Ref.modify_ (_ + 1) attemptsRef # liftEffect
47+ Om.throw { authError: "unauthorized" }
48+
49+ retried = layer
50+ # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 3)
51+ \_ -> { dbError: \_ -> pure true }
52+
53+ _ <- Om.runOm {}
54+ { exception: \_ -> pure { db: "" }
55+ , dbError: \_ -> pure { db: "" }
56+ , authError: \_ -> pure { db: "" }
57+ }
58+ (runLayer {} retried)
59+ attempts <- liftEffect $ Ref.read attemptsRef
60+ attempts `shouldEqual` 1
61+
62+ it "preserves the error when retries are exhausted" do
63+ let
64+ layer :: OmLayer () (dbError :: String) { db :: String }
65+ layer = makeLayer do
66+ Om.throw { dbError: "connection refused" }
67+
68+ retried = layer
69+ # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 2)
70+ \_ -> { dbError: \_ -> pure true }
71+
72+ result <- Om.runReader {} (runLayer {} retried)
73+ # liftAff
74+ case result of
75+ Left err -> do
76+ let
77+ msg = err # match
78+ { exception: \_ -> "exception"
79+ , dbError: \e -> e
80+ }
81+ msg `shouldEqual` "connection refused"
82+ Right _ -> "should have failed" `shouldEqual` "but succeeded"
83+
84+ it "only retries the specified error in a multi-error layer" do
85+ attemptsRef <- liftEffect $ Ref.new 0
86+ let
87+ layer :: OmLayer () (dbError :: String, cacheError :: String) { db :: String }
88+ layer = makeLayer do
89+ attempts <- Ref.modify (_ + 1) attemptsRef # liftEffect
90+ if attempts <= 2 then Om.throw { dbError: "db down" }
91+ else Om.throw { cacheError: "cache miss" }
92+
93+ retried = layer
94+ # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 5)
95+ \_ -> { dbError: \_ -> pure true }
96+
97+ result <- Om.runReader {} (runLayer {} retried)
98+ # liftAff
99+ case result of
100+ Left err -> do
101+ let
102+ msg = err # match
103+ { exception: \_ -> "exception"
104+ , dbError: \e -> e
105+ , cacheError: \e -> e
106+ }
107+ msg `shouldEqual` "cache miss"
108+ Right _ -> "should have failed" `shouldEqual` "but succeeded"
109+ attempts <- liftEffect $ Ref.read attemptsRef
110+ attempts `shouldEqual` 3
111+
112+ it "uses RetryStatus in the check" do
113+ attemptsRef <- liftEffect $ Ref.new 0
114+ let
115+ layer :: OmLayer () (dbError :: String) { db :: String }
116+ layer = makeLayer do
117+ Ref.modify_ (_ + 1) attemptsRef # liftEffect
118+ Om.throw { dbError: "fail" }
119+
120+ retried = layer
121+ # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 10)
122+ \(RetryStatus s) -> { dbError: \_ -> pure (s.iterNumber < 2) }
123+
124+ _ <- Om.runOm {}
125+ { exception: \_ -> pure { db: "" }, dbError: \_ -> pure { db: "" } }
126+ (runLayer {} retried)
127+ attempts <- liftEffect $ Ref.read attemptsRef
128+ attempts `shouldEqual` 3
test/Test/Yoga/Om/Layer/RepeatingSpec.pursnew file+49
@@ -0,0 +1,49 @@
1+module Test.Yoga.Om.Layer.RepeatingSpec where
2+
3+import Prelude
4+
5+import Effect.Class (liftEffect)
6+import Effect.Ref as Ref
7+import Data.Time.Duration (Milliseconds(..))
8+import Effect.Aff.Retry (limitRetries, constantDelay)
9+import Test.Spec (Spec, describe, it)
10+import Test.Spec.Assertions (shouldEqual)
11+import Yoga.Om as Om
12+import Yoga.Om.Layer (OmLayer, makeLayer, runLayer, repeating)
13+
14+spec :: Spec Unit
15+spec = describe "Layer repeating" do
16+
17+ it "repeats layer construction while condition holds" do
18+ counterRef <- liftEffect $ Ref.new 0
19+ let
20+ layer :: OmLayer () () { count :: Int }
21+ layer = makeLayer do
22+ count <- Ref.modify (_ + 1) counterRef # liftEffect
23+ pure { count }
24+
25+ repeated = layer
26+ # repeating (constantDelay (Milliseconds 0.0) <> limitRetries 10)
27+ \_ r -> pure (r.count < 5)
28+
29+ result <- Om.runOm {}
30+ { exception: \_ -> pure { count: 0 } }
31+ (runLayer {} repeated)
32+ result.count `shouldEqual` 5
33+
34+ it "stops when policy exhausted" do
35+ counterRef <- liftEffect $ Ref.new 0
36+ let
37+ layer :: OmLayer () () { count :: Int }
38+ layer = makeLayer do
39+ count <- Ref.modify (_ + 1) counterRef # liftEffect
40+ pure { count }
41+
42+ repeated = layer
43+ # repeating (constantDelay (Milliseconds 0.0) <> limitRetries 3)
44+ \_ _ -> pure true
45+
46+ result <- Om.runOm {}
47+ { exception: \_ -> pure { count: 0 } }
48+ (runLayer {} repeated)
49+ result.count `shouldEqual` 4
test/Test/Yoga/Om/Layer/ScopedSpec.pursnew file+146
@@ -0,0 +1,146 @@
1+module Test.Yoga.Om.Layer.ScopedSpec where
2+
3+import Prelude
4+
5+import Effect.Aff (throwError, try)
6+import Effect.Aff.Class (liftAff)
7+import Effect.Exception (error)
8+import Effect.Class (liftEffect)
9+import Effect.Ref as Ref
10+import Test.Spec (Spec, describe, it)
11+import Test.Spec.Assertions (shouldEqual)
12+import Yoga.Om as Om
13+import Yoga.Om.Layer (OmLayer, Scope, makeLayer, makeScopedLayer, bracketLayer, fresh, combineRequirements, runScoped, withScoped, provide)
14+
15+spec :: Spec Unit
16+spec = describe "Scoped Layers" do
17+
18+ it "runs finalizers in reverse order on success" do
19+ log <- liftEffect $ Ref.new []
20+ let
21+ layerA :: OmLayer (scope :: Scope) () { a :: String }
22+ layerA = makeScopedLayer
23+ (pure { a: "A" })
24+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-A" ]) log)
25+
26+ layerB :: OmLayer (scope :: Scope) () { b :: String }
27+ layerB = makeScopedLayer
28+ (pure { b: "B" })
29+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-B" ]) log)
30+
31+ layerC :: OmLayer (scope :: Scope) () { c :: String }
32+ layerC = makeScopedLayer
33+ (pure { c: "C" })
34+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-C" ]) log)
35+
36+ layerBC :: OmLayer (scope :: Scope) () { b :: String, c :: String }
37+ layerBC = combineRequirements layerB layerC
38+
39+ combined = combineRequirements layerA layerBC
40+
41+ _ <- liftAff $ runScoped combined
42+ finalLog <- liftEffect $ Ref.read log
43+ finalLog `shouldEqual` [ "release-C", "release-B", "release-A" ]
44+
45+ it "runs finalizers when the callback throws" do
46+ log <- liftEffect $ Ref.new []
47+ let
48+ layer :: OmLayer (scope :: Scope) () { value :: String }
49+ layer = makeScopedLayer
50+ (pure { value: "acquired" })
51+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "released" ]) log)
52+
53+ _ <- liftAff $ try $ withScoped layer \_ ->
54+ throwError (error "callback failed")
55+ finalLog <- liftEffect $ Ref.read log
56+ finalLog `shouldEqual` [ "released" ]
57+
58+ it "threads finalizers through vertical composition (provide)" do
59+ log <- liftEffect $ Ref.new []
60+ let
61+ baseLayer :: OmLayer (scope :: Scope) () { base :: String }
62+ baseLayer = makeScopedLayer
63+ (pure { base: "base-value" })
64+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-base" ]) log)
65+
66+ upperLayer :: OmLayer (scope :: Scope, base :: String) () { upper :: String }
67+ upperLayer = makeScopedLayer
68+ ( do
69+ { base } <- Om.ask
70+ pure { upper: base <> "-extended" }
71+ )
72+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-upper" ]) log)
73+
74+ composed = upperLayer `provide` baseLayer
75+
76+ result <- liftAff $ runScoped composed
77+ result.upper `shouldEqual` "base-value-extended"
78+ finalLog <- liftEffect $ Ref.read log
79+ finalLog `shouldEqual` [ "release-upper", "release-base" ]
80+
81+ it "works with bracketLayer" do
82+ log <- liftEffect $ Ref.new []
83+ let
84+ layer = bracketLayer
85+ ( do
86+ liftEffect $ Ref.modify_ (_ <> [ "acquire" ]) log
87+ pure 42
88+ )
89+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release" ]) log)
90+ (\n -> pure { value: n })
91+
92+ result <- liftAff $ runScoped layer
93+ result.value `shouldEqual` 42
94+ finalLog <- liftEffect $ Ref.read log
95+ finalLog `shouldEqual` [ "acquire", "release" ]
96+
97+ it "fresh layer builds twice even when same base layer" do
98+ counter <- liftEffect $ Ref.new 0
99+ let
100+ baseLayer :: OmLayer (scope :: Scope) () { value :: String }
101+ baseLayer = makeLayer do
102+ liftEffect $ Ref.modify_ (_ + 1) counter
103+ pure { value: "built" }
104+
105+ branch1 :: OmLayer (scope :: Scope) () { out1 :: String }
106+ branch1 = consumer `provide` fresh baseLayer
107+ where
108+ consumer :: OmLayer (scope :: Scope, value :: String) () { out1 :: String }
109+ consumer = makeLayer do
110+ { value } <- Om.ask
111+ pure { out1: value <> "-1" }
112+
113+ branch2 :: OmLayer (scope :: Scope) () { out2 :: String }
114+ branch2 = consumer `provide` fresh baseLayer
115+ where
116+ consumer :: OmLayer (scope :: Scope, value :: String) () { out2 :: String }
117+ consumer = makeLayer do
118+ { value } <- Om.ask
119+ pure { out2: value <> "-2" }
120+
121+ app = combineRequirements branch1 branch2
122+
123+ result <- liftAff $ runScoped app
124+ result.out1 `shouldEqual` "built-1"
125+ result.out2 `shouldEqual` "built-2"
126+ count <- liftEffect $ Ref.read counter
127+ count `shouldEqual` 2
128+
129+ it "combines scoped and non-scoped layers" do
130+ log <- liftEffect $ Ref.new []
131+ let
132+ scopedLayer :: OmLayer (scope :: Scope) () { scoped :: String }
133+ scopedLayer = makeScopedLayer
134+ (pure { scoped: "yes" })
135+ (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-scoped" ]) log)
136+
137+ plainLayer :: OmLayer () () { plain :: String }
138+ plainLayer = makeLayer (pure { plain: "no-finalizer" })
139+
140+ combined = combineRequirements scopedLayer plainLayer
141+
142+ result <- liftAff $ runScoped combined
143+ result.scoped `shouldEqual` "yes"
144+ result.plain `shouldEqual` "no-finalizer"
145+ finalLog <- liftEffect $ Ref.read log
146+ finalLog `shouldEqual` [ "release-scoped" ]
test/Test/Yoga/Om/Layer/WireLayersSpec.pursnew file+133
@@ -0,0 +1,133 @@
1+module Test.Yoga.Om.Layer.WireLayersSpec where
2+
3+import Prelude
4+
5+import Effect.Aff.Class (liftAff)
6+import Effect.Class (liftEffect)
7+import Effect.Ref as Ref
8+import Test.Spec (Spec, describe, it)
9+import Test.Spec.Assertions (shouldEqual)
10+import Yoga.Om as Om
11+import Yoga.Om.Layer (OmLayer, Scope, makeLayer, runScoped, wireLayers, wireLayersDebug)
12+
13+spec :: Spec Unit
14+spec = describe "wireLayers" do
15+
16+ it "wires a simple linear chain (A -> B -> C)" do
17+ let
18+ a_base :: OmLayer (scope :: Scope) () { base :: String }
19+ a_base = makeLayer (pure { base: "foundation" })
20+
21+ b_mid :: OmLayer (scope :: Scope, base :: String) () { mid :: String }
22+ b_mid = makeLayer do
23+ { base } <- Om.ask
24+ pure { mid: base <> "-middle" }
25+
26+ c_top :: OmLayer (scope :: Scope, mid :: String) () { top :: String }
27+ c_top = makeLayer do
28+ { mid } <- Om.ask
29+ pure { top: mid <> "-top" }
30+
31+ app = wireLayers { a_base, b_mid, c_top }
32+
33+ result <- liftAff $ runScoped app
34+ result.base `shouldEqual` "foundation"
35+ result.mid `shouldEqual` "foundation-middle"
36+ result.top `shouldEqual` "foundation-middle-top"
37+
38+ it "wires independent layers with no inter-dependencies" do
39+ let
40+ a_x :: OmLayer (scope :: Scope) () { x :: Int }
41+ a_x = makeLayer (pure { x: 1 })
42+
43+ b_y :: OmLayer (scope :: Scope) () { y :: Int }
44+ b_y = makeLayer (pure { y: 2 })
45+
46+ c_z :: OmLayer (scope :: Scope) () { z :: Int }
47+ c_z = makeLayer (pure { z: 3 })
48+
49+ app = wireLayers { a_x, b_y, c_z }
50+
51+ result <- liftAff $ runScoped app
52+ result.x `shouldEqual` 1
53+ result.y `shouldEqual` 2
54+ result.z `shouldEqual` 3
55+
56+ it "wires a diamond dependency" do
57+ let
58+ a_db :: OmLayer (scope :: Scope) () { db :: String }
59+ a_db = makeLayer (pure { db: "postgres" })
60+
61+ b_cache :: OmLayer (scope :: Scope, db :: String) () { cache :: String }
62+ b_cache = makeLayer do
63+ { db } <- Om.ask
64+ pure { cache: db <> "-cache" }
65+
66+ b_repo :: OmLayer (scope :: Scope, db :: String) () { repo :: String }
67+ b_repo = makeLayer do
68+ { db } <- Om.ask
69+ pure { repo: db <> "-repo" }
70+
71+ d_app :: OmLayer (scope :: Scope, cache :: String, repo :: String) () { app :: String }
72+ d_app = makeLayer do
73+ { cache, repo } <- Om.ask
74+ pure { app: cache <> "+" <> repo }
75+
76+ app = wireLayers { a_db, b_cache, b_repo, d_app }
77+
78+ result <- liftAff $ runScoped app
79+ result.db `shouldEqual` "postgres"
80+ result.cache `shouldEqual` "postgres-cache"
81+ result.repo `shouldEqual` "postgres-repo"
82+ result.app `shouldEqual` "postgres-cache+postgres-repo"
83+
84+ it "wireLayersDebug emits dependency graph as compiler warning" do
85+ let
86+ a_db :: OmLayer (scope :: Scope) () { db :: String }
87+ a_db = makeLayer (pure { db: "postgres" })
88+
89+ b_cache :: OmLayer (scope :: Scope, db :: String) () { cache :: String }
90+ b_cache = makeLayer do
91+ { db } <- Om.ask
92+ pure { cache: db <> "-cache" }
93+
94+ b_repo :: OmLayer (scope :: Scope, db :: String) () { repo :: String }
95+ b_repo = makeLayer do
96+ { db } <- Om.ask
97+ pure { repo: db <> "-repo" }
98+
99+ d_app :: OmLayer (scope :: Scope, cache :: String, repo :: String) () { app :: String }
100+ d_app = makeLayer do
101+ { cache, repo } <- Om.ask
102+ pure { app: cache <> "+" <> repo }
103+
104+ app = wireLayersDebug { a_db, b_cache, b_repo, d_app }
105+
106+ result <- liftAff $ runScoped app
107+ result.app `shouldEqual` "postgres-cache+postgres-repo"
108+
109+ it "memoizes shared dependencies within wireLayers" do
110+ counter <- liftEffect $ Ref.new 0
111+ let
112+ a_db :: OmLayer (scope :: Scope) () { db :: String }
113+ a_db = makeLayer do
114+ liftEffect $ Ref.modify_ (_ + 1) counter
115+ pure { db: "connected" }
116+
117+ b_cache :: OmLayer (scope :: Scope, db :: String) () { cache :: String }
118+ b_cache = makeLayer do
119+ { db } <- Om.ask
120+ pure { cache: db <> "-cache" }
121+
122+ b_repo :: OmLayer (scope :: Scope, db :: String) () { repo :: String }
123+ b_repo = makeLayer do
124+ { db } <- Om.ask
125+ pure { repo: db <> "-repo" }
126+
127+ app = wireLayers { a_db, b_cache, b_repo }
128+
129+ result <- liftAff $ runScoped app
130+ result.cache `shouldEqual` "connected-cache"
131+ result.repo `shouldEqual` "connected-repo"
132+ count <- liftEffect $ Ref.read counter
133+ count `shouldEqual` 1