b97f5c6...main · rowtype-yoga/purescript-yoga-om-layer

git.iko.soy/rowtype-yoga/purescript-yoga-om-layer

on main help sign in

.psc-ide-port+1−1

since splitsnapshots

unifiedsplit

@@ -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

240

241**Status**: Proof of concept complete ✓ with working runtime implementation

242**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

4+import Prelude

5+import Yoga.Om.Layer (OmLayer, Scope, makeLayer, combineRequirements, runScoped)

7+layer1 :: OmLayer (scope :: Scope) () { value :: Int }

8+layer1 = makeLayer (pure { value: 1 })

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

4+import Prelude

5+import Yoga.Om.Layer (OmLayer, Scope, makeLayer, combineRequirements, runScoped)

6+import Effect.Aff (Aff)

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

4+import Prelude

5+import Yoga.Om as Om

6+import Yoga.Om.Layer (OmLayer, makeLayer, provide)

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

4+import Prelude

5+import Yoga.Om as Om

6+import Yoga.Om.Layer (OmLayer, makeLayer, runLayer)

8+type Database = { query :: String -> Array String }

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

4+import Prelude

6+import Yoga.Om as Om

7+import Yoga.Om.Layer (OmLayer, makeLayer, runLayer)

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

4+import Prelude

5+import Yoga.Om as Om

6+import Yoga.Om.Layer (OmLayer, makeLayer, runLayer)

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

4+import Prelude

5+import Yoga.Om as Om

6+import Yoga.Om.Layer (OmLayer, Scope, makeLayer, wireLayers)

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")/.."

4+# Build the library first

5+bunx spago build > /dev/null 2>&1

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 @@

6 "core": {

7 "dependencies": [

8 {

9− "aff": ">=7.1.0 <8.0.0"

9+ "aff": ">=8.0.0 <9.0.0"

10 },

11 {

12 "aff-retry": ">=2.0.0 <3.0.0"

@@ -14,6 +14,9 @@

14 {

15 "arrays": ">=7.3.0 <8.0.0"

16 },

17+ {

18+ "control": ">=6.0.0 <7.0.0"

19+ },

17 {

20 {

18 "effect": ">=4.0.0 <5.0.0"

21 "effect": ">=4.0.0 <5.0.0"

19 },

22 },

@@ -23,9 +26,6 @@

23 {

26 {

24 "foldable-traversable": ">=6.0.0 <7.0.0"

27 "foldable-traversable": ">=6.0.0 <7.0.0"

25 },

28 },

26− {

27− "integers": ">=6.0.0 <7.0.0"

28− },

29 {

30 "maybe": ">=6.0.0 <7.0.0"

31 },

@@ -35,6 +35,9 @@

35 {

36 "ordered-collections": ">=3.2.0 <4.0.0"

37 },

38+ {

39+ "parallel": ">=7.0.0 <8.0.0"

40+ },

38 {

41 {

39 "prelude": ">=6.0.2 <7.0.0"

42 "prelude": ">=6.0.2 <7.0.0"

40 },

43 },

@@ -44,9 +47,21 @@

44 {

47 {

45 "record-studio": ">=1.0.4 <2.0.0"

48 "record-studio": ">=1.0.4 <2.0.0"

46 },

49 },

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+ },

47 {

59 {

48 "type-equality": ">=4.0.1 <5.0.0"

60 "type-equality": ">=4.0.1 <5.0.0"

49 },

61 },

62+ {

63+ "typelevel-prelude": ">=7.0.0 <8.0.0"

64+ },

50 {

65 {

51 "unsafe-coerce": ">=6.0.0 <7.0.0"

66 "unsafe-coerce": ">=6.0.0 <7.0.0"

52 },

67 },

@@ -54,7 +69,7 @@

54 "variant": ">=8.0.0 <9.0.0"

69 "variant": ">=8.0.0 <9.0.0"

55 },

70 },

56 {

71 {

57− "yoga-om": ">=1.2.2 <2.0.0"

72+ "yoga-om": ">=2.0.0 <3.0.0"

58 }

73 }

59 ]

74 ]

60 },

75 },

@@ -67,7 +82,13 @@

67 "refs": ">=6.0.0 <7.0.0"

82 "refs": ">=6.0.0 <7.0.0"

68 },

83 },

69 {

84 {

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"

71 }

92 }

72 ]

93 ]

73 }

94 }

@@ -78,8 +99,8 @@

78 "packages": {

99 "packages": {

79 "aff": {

100 "aff": {

80 "type": "registry",

101 "type": "registry",

81− "version": "7.1.0",

102+ "version": "8.0.0",

82− "integrity": "sha256-/nOpDQVnKIoP1pQ1ZZBYpadK0TuMlG4WwufGzJpsfD0=",

103+ "integrity": "sha256-9BRIrSdRoYybfiUmBqgKJ66cPqxYHb277bVWQMn/9sg=",

83 "dependencies": [

104 "dependencies": [

84 "control",

105 "control",

85 "datetime",

106 "datetime",

@@ -127,6 +148,53 @@

127 "prelude"

148 "prelude"

128 ]

149 ]

129 },

150 },

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+ },

130 "arrays": {

198 "arrays": {

131 "type": "registry",

199 "type": "registry",

132 "version": "7.3.0",

200 "version": "7.3.0",

@@ -318,6 +386,16 @@

318 "unsafe-coerce"

386 "unsafe-coerce"

319 ]

387 ]

320 },

388 },

389+ "exitcodes": {

390+ "type": "registry",

391+ "version": "4.0.0",

392+ "integrity": "sha256-xBl4aFSEQ05Owp1ZvO6OxxvLK3LVzU35RSbj79SsePQ=",

393+ "dependencies": [

394+ "enums",

395+ "maybe",

396+ "prelude"

397+ ]

398+ },

321 "foldable-traversable": {

399 "foldable-traversable": {

322 "type": "registry",

400 "type": "registry",

323 "version": "6.0.0",

401 "version": "6.0.0",

@@ -336,6 +414,42 @@

336 "tuples"

414 "tuples"

337 ]

415 ]

338 },

416 },

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+ },

339 "fork": {

453 "fork": {

340 "type": "registry",

454 "type": "registry",

341 "version": "6.0.0",

455 "version": "6.0.0",

@@ -456,6 +570,21 @@

456 "prelude"

570 "prelude"

457 ]

571 ]

458 },

572 },

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+ },

459 "lazy": {

588 "lazy": {

460 "type": "registry",

589 "type": "registry",

461 "version": "6.0.0",

590 "version": "6.0.0",

@@ -523,6 +652,107 @@

523 "safe-coerce"

652 "safe-coerce"

524 ]

653 ]

525 },

654 },

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+ },

526 "nonempty": {

756 "nonempty": {

527 "type": "registry",

757 "type": "registry",

528 "version": "7.0.0",

758 "version": "7.0.0",

@@ -566,6 +796,56 @@

566 "prelude"

796 "prelude"

567 ]

797 ]

568 },

798 },

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+ },

569 "ordered-collections": {

849 "ordered-collections": {

570 "type": "registry",

850 "type": "registry",

571 "version": "3.2.0",

851 "version": "3.2.0",

@@ -641,6 +921,16 @@

641 "tuples"

921 "tuples"

642 ]

922 ]

643 },

923 },

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+ },

644 "prelude": {

934 "prelude": {

645 "type": "registry",

935 "type": "registry",

646 "version": "6.0.2",

936 "version": "6.0.2",

@@ -714,8 +1004,8 @@

714 },

1004 },

715 "spec": {

1005 "spec": {

716 "type": "registry",

1006 "type": "registry",

717− "version": "7.6.1",

1007+ "version": "8.1.2",

718− "integrity": "sha256-5GysDOS1gVbbGX75YXUdhww3h2S246Ck0sS6yt+ig+0=",

1008+ "integrity": "sha256-klPPJ6lBQI1CGOAdLJ+ZoGRt8XZippkTKjn53BrSkL0=",

719 "dependencies": [

1009 "dependencies": [

720 "aff",

1010 "aff",

721 "ansi",

1011 "ansi",

@@ -746,6 +1036,51 @@

746 "tuples"

1036 "tuples"

747 ]

1037 ]

748 },

1038 },

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+ },

749 "st": {

1084 "st": {

750 "type": "registry",

1085 "type": "registry",

751 "version": "6.2.0",

1086 "version": "6.2.0",

@@ -896,10 +1231,11 @@

896 },

1231 },

897 "yoga-om": {

1232 "yoga-om": {

898 "type": "registry",

1233 "type": "registry",

899− "version": "1.2.2",

1234+ "version": "2.0.0",

900− "integrity": "sha256-uDV3/o8mUOTIgSEQFqIATPyladzL8BcjURvfS901hgI=",

1235+ "integrity": "sha256-eenoujD2rJzR6gYJbbIiqLhXHC1C5dagu91HZkAEt/Y=",

901 "dependencies": [

1236 "dependencies": [

902 "aff",

1237 "aff",

1238+ "aff-retry",

903 "avar",

1239 "avar",

904 "console",

1240 "console",

905 "control",

1241 "control",

@@ -908,12 +1244,14 @@

908 "either",

1244 "either",

909 "exceptions",

1245 "exceptions",

910 "functions",

1246 "functions",

1247+ "heterogeneous",

911 "maybe",

1248 "maybe",

912 "newtype",

1249 "newtype",

913 "parallel",

1250 "parallel",

914 "prelude",

1251 "prelude",

915 "record",

1252 "record",

916 "record-studio",

1253 "record-studio",

1254+ "refs",

917 "tailrec",

1255 "tailrec",

918 "transformers",

1256 "transformers",

919 "tuples",

1257 "tuples",

spago.yaml+12−6

@@ -1,34 +1,40 @@

1workspace: {}

2−

3package:

2package:

4 name: yoga-om-layer

3 name: yoga-om-layer

5 publish:

4 publish:

6− version: 1.0.6

5+ version: 2.1.0

7 license: MIT

6 license: MIT

8 location:

7 location:

9 githubOwner: rowtype-yoga

8 githubOwner: rowtype-yoga

10 githubRepo: purescript-yoga-om-layer

9 githubRepo: purescript-yoga-om-layer

11 dependencies:

10 dependencies:

12− - aff: ">=7.1.0 <8.0.0"

11+ - aff: ">=8.0.0 <9.0.0"

13 - aff-retry: ">=2.0.0 <3.0.0"

12 - aff-retry: ">=2.0.0 <3.0.0"

14 - arrays: ">=7.3.0 <8.0.0"

13 - arrays: ">=7.3.0 <8.0.0"

14+ - control: ">=6.0.0 <7.0.0"

15 - effect: ">=4.0.0 <5.0.0"

16 - exceptions: ">=6.1.0 <7.0.0"

17 - foldable-traversable: ">=6.0.0 <7.0.0"

18− - integers: ">=6.0.0 <7.0.0"

19 - maybe: ">=6.0.0 <7.0.0"

18 - maybe: ">=6.0.0 <7.0.0"

20 - nullable: ">=6.0.0 <7.0.0"

19 - nullable: ">=6.0.0 <7.0.0"

21 - ordered-collections: ">=3.2.0 <4.0.0"

20 - ordered-collections: ">=3.2.0 <4.0.0"

21+ - parallel: ">=7.0.0 <8.0.0"

22 - prelude: ">=6.0.2 <7.0.0"

23 - record: ">=4.0.0 <5.0.0"

24 - 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"

25 - type-equality: ">=4.0.1 <5.0.0"

28 - type-equality: ">=4.0.1 <5.0.0"

29+ - typelevel-prelude: ">=7.0.0 <8.0.0"

26 - unsafe-coerce: ">=6.0.0 <7.0.0"

30 - unsafe-coerce: ">=6.0.0 <7.0.0"

27 - variant: ">=8.0.0 <9.0.0"

31 - 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"

29 test:

33 test:

30 main: Test.Main

34 main: Test.Main

31 dependencies:

35 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"

33 - console: ">=6.0.0 <7.0.0"

39 - console: ">=6.0.0 <7.0.0"

34 - refs: ">=6.0.0 <7.0.0"

40 - refs: ">=6.0.0 <7.0.0"

src/Yoga/Om/Layer.purs+538−7

@@ -13,21 +13,59 @@ module Yoga.Om.Layer

13 , runScopedWith

14 , withScoped

15 , withScopedWith

16+ , scoped

16 , combineRequirements

17 , combineRequirements

18+ , withValue

17 , provide

19 , provide

18 , (>->)

20 , (>->)

19 , recovering

21 , recovering

20 , repeating

22 , 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

21 , class CheckAllProvided

45 , class CheckAllProvided

22 , class CheckAllLabelsExist

46 , class CheckAllLabelsExist

23 , class CheckLabelExists

47 , class CheckLabelExists

48+ , class TopoWire, topoWire

49+ , class AllLabelsIn

50+ , class FindReady

51+ , class FindReadyDispatch

24 ) where

52 ) where

26import Prelude

54import Prelude

56+import Control.Alt (class Alt)

57+import Control.Alt as Alt

58+import Control.Alternative (class Alternative)

28−import Control.Monad.Error.Class (catchError, throwError)

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)

29import Control.Parallel (class Parallel)

63import Control.Parallel (class Parallel)

30import Control.Parallel as Parallel

64import 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)

31import Data.Array as Array

69import Data.Array as Array

32import Data.Foldable (for_)

70import Data.Foldable (for_)

33import Data.Map (Map)

71import Data.Map (Map)

@@ -38,20 +76,30 @@ import Data.Variant (class VariantMatchCases, onMatch)

38import Effect (Effect)

76import Effect (Effect)

39import Effect.Aff (Aff, bracket)

77import Effect.Aff (Aff, bracket)

40import Effect.Aff.Retry (RetryPolicyM, RetryStatus, applyAndDelay, defaultRetryStatus)

78import Effect.Aff.Retry (RetryPolicyM, RetryStatus, applyAndDelay, defaultRetryStatus)

79+import Effect.Aff.Class (class MonadAff)

80+import Effect.Aff.Class as Aff

41−import Effect.Class (liftEffect)

81+import Effect.Class (class MonadEffect, liftEffect)

82+import Effect.Class (class MonadEffect, liftEffect) as Effect

42import Effect.Exception (Error)

83import Effect.Exception (Error)

43import Effect.Ref (Ref)

84import Effect.Ref (Ref)

44import Effect.Ref as Ref

85import Effect.Ref as Ref

45import Effect.Unsafe (unsafePerformEffect)

86import Effect.Unsafe (unsafePerformEffect)

46import Prim.Row (class Nub, class Union)

87import Prim.Row (class Nub, class Union)

88+import Prim.Row as Row

89+import Type.Proxy (Proxy(..))

47import Prim.RowList (class RowToList, Cons, Nil, RowList)

90import Prim.RowList (class RowToList, Cons, Nil, RowList)

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)

48−import Prim.TypeError (class Fail, Above, Quote, Text)

95+import Prim.TypeError (class Fail, class Warn, Above, Beside, Doc, Quote, Text)

49import Record as Record

96import Record as Record

50import Record.Studio (class Keys)

97import Record.Studio (class Keys)

51import Type.Equality (class TypeEquals)

98import Type.Equality (class TypeEquals)

52import Unsafe.Coerce (unsafeCoerce)

99import Unsafe.Coerce (unsafeCoerce)

53import Yoga.Om (Om, ParOm)

100import Yoga.Om (Om, ParOm)

54import Yoga.Om as Om

101import Yoga.Om as Om

102+import Yoga.Om.Error (Exception)

103

56-- =============================================================================

104-- =============================================================================

57-- Scope — a first-class representation of resource lifetime

105-- Scope — a first-class representation of resource lifetime

@@ -140,6 +188,36 @@ instance Bind (OmLayer req err) where

140

188

141instance Monad (OmLayer req err)

189instance Monad (OmLayer req err)

142

190

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+

143instance Functor (ParOmLayer req err) where

221instance Functor (ParOmLayer req err) where

144 map f (ParOmLayer p) = ParOmLayer (map f p)

222 map f (ParOmLayer p) = ParOmLayer (map f p)

145

223

@@ -149,6 +227,14 @@ instance Apply (ParOmLayer req err) where

149instance Applicative (ParOmLayer req err) where

227instance Applicative (ParOmLayer req err) where

150 pure a = ParOmLayer (pure a)

228 pure a = ParOmLayer (pure a)

151

229

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+

152instance Parallel (ParOmLayer req err) (OmLayer req err) where

238instance Parallel (ParOmLayer req err) (OmLayer req err) where

153 parallel (OmLayer _ om) = ParOmLayer (Parallel.parallel om)

239 parallel (OmLayer _ om) = ParOmLayer (Parallel.parallel om)

154 sequential (ParOmLayer p) = OmLayer (freshId unit) (Parallel.sequential p)

240 sequential (ParOmLayer p) = OmLayer (freshId unit) (Parallel.sequential p)

@@ -306,9 +392,13 @@ else instance

306-- =============================================================================

392-- =============================================================================

307

393

308-- | Run a layer with a given context, with custom error if requirements aren't met.

394-- | 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.

309runLayer

398runLayer

310 :: forall req err a available

399 :: forall req err a available

311 . CheckAllProvided req available

400 . CheckAllProvided req available

401+ => Keys req

312 => Record available

402 => Record available

313 -> OmLayer req err a

403 -> OmLayer req err a

314 -> Om (Record available) err a

404 -> Om (Record available) err a

@@ -336,7 +426,7 @@ withScoped

336 . OmLayer (scope :: Scope) () (Record prov)

426 . OmLayer (scope :: Scope) () (Record prov)

337 -> (Record prov -> Aff a)

427 -> (Record prov -> Aff a)

338 -> Aff a

428 -> Aff a

339−withScoped = withScopedWith { exception: \_ -> pure (unsafeCoerce {}) }

429+withScoped = withScopedWith { exception: throwError }

340

430

341-- | Like `runScoped` but accepts error handlers for layers with typed errors.

431-- | Like `runScoped` but accepts error handlers for layers with typed errors.

342runScopedWith

432runScopedWith

@@ -369,12 +459,23 @@ withScopedWith handlers layer callback = bracket acquire release use

369 release { scope } = closeScope scope

459 release { scope } = closeScope scope

370 use { prov } = callback prov

460 use { prov } = callback prov

371

461

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+

372-- =============================================================================

473-- =============================================================================

373-- Horizontal composition — combine two layers with automatic deduplication

474-- Horizontal composition — combine two layers with automatic deduplication

374-- =============================================================================

475-- =============================================================================

375

476

376combineRequirements

477combineRequirements

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

378 . Union req1 req2 reqMerged

479 . Union req1 req2 reqMerged

379 => Nub reqMerged reqDeduped

480 => Nub reqMerged reqDeduped

380 => Union req1 _req1 reqDeduped

481 => Union req1 _req1 reqDeduped

@@ -383,8 +484,8 @@ combineRequirements

383 => Nub errMerged errDeduped

484 => Nub errMerged errDeduped

384 => Union err1 _err1 errDeduped

485 => Union err1 _err1 errDeduped

385 => Union err2 _err2 errDeduped

486 => Union err2 _err2 errDeduped

386− => Union prov1 prov2 provMergedRaw

487+ => Union prov1 prov2 provMerged

387− => Nub provMergedRaw provMerged

488+ => Nub provMerged provMerged

388 => Keys req1

489 => Keys req1

389 => Keys req2

490 => Keys req2

390 => OmLayer req1 err1 (Record prov1)

491 => OmLayer req1 err1 (Record prov1)

@@ -395,6 +496,17 @@ combineRequirements layer1 layer2 = OmLayer (freshId unit) do

395 rec2 <- Om.expand (buildLayer layer2)

496 rec2 <- Om.expand (buildLayer layer2)

396 pure (Record.merge rec1 rec2)

497 pure (Record.merge rec1 rec2)

397

498

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+

398-- =============================================================================

510-- =============================================================================

399-- Vertical composition — feed output of one layer into input of another

511-- Vertical composition — feed output of one layer into input of another

400-- =============================================================================

512-- =============================================================================

@@ -464,3 +576,422 @@ repeating policy shouldRepeat (OmLayer layerId om) =

464 ifM (shouldRepeat status result)

576 ifM (shouldRepeat status result)

465 (applyAndDelay policy status >>= maybe (pure result) go)

577 (applyAndDelay policy status >>= maybe (pure result) go)

466 (pure result)

578 (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−609

@@ -2,617 +2,14 @@ module Test.Main where

3import Prelude

5−import Control.Parallel (parApply)

6import Effect (Effect)

5import Effect (Effect)

7−import Effect.Aff (launchAff_, throwError, try)

6+import Effect.Aff (launchAff_)

8−import Effect.Aff.Class (liftAff)

9−import Effect.Exception (error)

10import Effect.Class (liftEffect)

7import Effect.Class (liftEffect)

11−import Effect.Class.Console as Console

8+import Test.Spec.Discovery (discover)

12−import Effect.Ref as Ref

13−import Test.Spec (describe, it)

14−import Test.Spec.Assertions (shouldEqual)

15import Test.Spec.Reporter (consoleReporter)

9import Test.Spec.Reporter (consoleReporter)

16−import Test.Spec.Runner (runSpec)

10+import Test.Spec.Runner.Node (runSpecAndExitProcess)

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) }

29main :: Effect Unit

12main :: Effect Unit

30−main = launchAff_ $ runSpec [ consoleReporter ] do

13+main = launchAff_ do

31− describe "OmLayer - Proof of Concept: Type-Level Deduplication" do

14+ specs <- discover "Test\\.Yoga\\.Om\\.Layer\\..*Spec"

32−

15+ liftEffect $ runSpecAndExitProcess [ consoleReporter ] specs

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 "uses RetryStatus in the check" do

567− attemptsRef <- liftEffect $ Ref.new 0

568− let

569− layer :: OmLayer () (dbError :: String) { db :: String }

570− layer = makeLayer do

571− Ref.modify_ (_ + 1) attemptsRef # liftEffect

572− Om.throw { dbError: "fail" }

573−

574− retried = layer

575− # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 10)

576− (\(RetryStatus s) -> { dbError: \_ -> pure (s.iterNumber < 2) })

577−

578− _ <- Om.runOm {}

579− { exception: \_ -> pure { db: "" }, dbError: \_ -> pure { db: "" } }

580− (runLayer {} retried)

581− attempts <- liftEffect $ Ref.read attemptsRef

582− attempts `shouldEqual` 3

583−

584− describe "Layer repeating" do

585−

586− it "repeats layer construction while condition holds" do

587− counterRef <- liftEffect $ Ref.new 0

588− let

589− layer :: OmLayer () () { count :: Int }

590− layer = makeLayer do

591− count <- Ref.modify (_ + 1) counterRef # liftEffect

592− pure { count }

593−

594− repeated = layer

595− # repeating (constantDelay (Milliseconds 0.0) <> limitRetries 10)

596− (\_ r -> pure (r.count < 5))

597−

598− result <- Om.runOm {}

599− { exception: \_ -> pure { count: 0 } }

600− (runLayer {} repeated)

601− result.count `shouldEqual` 5

602−

603− it "stops when policy exhausted" do

604− counterRef <- liftEffect $ Ref.new 0

605− let

606− layer :: OmLayer () () { count :: Int }

607− layer = makeLayer do

608− count <- Ref.modify (_ + 1) counterRef # liftEffect

609− pure { count }

610−

611− repeated = layer

612− # repeating (constantDelay (Milliseconds 0.0) <> limitRetries 3)

613− (\_ _ -> pure true)

614−

615− result <- Om.runOm {}

616− { exception: \_ -> pure { count: 0 } }

617− (runLayer {} repeated)

618− result.count `shouldEqual` 4

test/Test/Yoga/Om/Layer/CompositionSpec.pursnew file+59

@@ -0,0 +1,59 @@

1+module Test.Yoga.Om.Layer.CompositionSpec where

3+import Prelude

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

3+import Prelude

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

3+import Prelude

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

3+import Prelude

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

3+import Prelude

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)

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

3+import Prelude

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

3+import Prelude

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

3+import Prelude

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

3+import Prelude

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