@@ -2,763 +2,14 @@ module Test.Main where
22
33import Prelude
44
5−import Control.Parallel (parApply)
65import Effect (Effect)
7−import Effect.Aff (launchAff_, throwError, try)
8−import Effect.Aff.Class (liftAff)
9−import Effect.Exception (error)
6+import Effect.Aff (launchAff_)
107import Effect.Class (liftEffect)
11−import Effect.Class.Console as Console
12−import Effect.Ref as Ref
13−import Test.Spec (describe, it)
14−import Test.Spec.Assertions (shouldEqual)
8+import Test.Spec.Discovery (discover)
159import Test.Spec.Reporter (consoleReporter)
16−import Test.Spec.Runner (runSpec)
17−import Data.Either (Either(..))
18−import Data.Variant (match)
19−import Yoga.Om as Om
20−import Data.Time.Duration (Milliseconds(..))
21−import Effect.Aff.Retry (RetryStatus(..), limitRetries, constantDelay)
22−import Yoga.Om.Layer (OmLayer, Scope, makeLayer, makeScopedLayer, bracketLayer, fresh, combineRequirements, runLayer, runScoped, runScopedWith, withScoped, provide, recovering, repeating, wireLayers)
23−
24−-- Example types
25−type Config = { port :: Int, host :: String }
26−type Logger = { log :: String -> Effect Unit }
27−type Database = { query :: String -> Effect (Array String) }
10+import Test.Spec.Runner.Node (runSpecAndExitProcess)
2811
2912main :: Effect Unit
30−main = launchAff_ $ runSpec [ consoleReporter ] do
31− describe "OmLayer - Proof of Concept: Type-Level Deduplication" do
32−
33− it "proves Row.Nub deduplicates shared requirements at type level" do
34− let
35− loggerLayer :: OmLayer (config :: Config) () { logger :: Logger }
36− loggerLayer = makeLayer do
37− { config } <- Om.ask
38− pure { logger: { log: \msg -> Console.log $ "[" <> config.host <> "] " <> msg } }
39−
40− databaseLayer :: OmLayer (config :: Config) () { database :: Database }
41− databaseLayer = makeLayer do
42− { config } <- Om.ask
43− pure { database: { query: \q -> pure [ "Result from " <> config.host ] } }
44−
45− let
46− _proofOfDeduplication :: OmLayer (config :: Config) _ _
47− _proofOfDeduplication = combineRequirements loggerLayer databaseLayer
48−
49− Console.log "Type-level deduplication works: (config, config) -> (config)"
50− pure unit
51−
52− it "proves deduplication at runtime via shared Ref" do
53− accessLog <- liftEffect $ Ref.new ""
54− let
55− combinedLayer :: OmLayer (config :: Config, accessLog :: Ref.Ref String) () { logger :: Logger, database :: Database }
56− combinedLayer = makeLayer do
57− { config, accessLog: log } <- Om.ask
58− liftEffect $ Ref.modify_ (_ <> "config-accessed-by-logger ") log
59− let logger = { log: \msg -> Console.log $ "[" <> config.host <> "] " <> msg }
60− liftEffect $ Ref.modify_ (_ <> "config-accessed-by-database ") log
61− let database = { query: \q -> pure [ "Result from " <> config.host ] }
62− pure { logger, database }
63−
64− let
65− ctx =
66− { config: { port: 5432, host: "localhost" }
67− , accessLog: accessLog
68− }
69− result <- runLayer ctx combinedLayer
70− # Om.runOm ctx
71− { exception: \_ -> pure { logger: { log: \_ -> pure unit }, database: { query: \_ -> pure [] } } }
72−
73− finalLog <- liftEffect $ Ref.read accessLog
74− finalLog `shouldEqual` "config-accessed-by-logger config-accessed-by-database "
75−
76− liftEffect $ result.logger.log "Testing logger from combined layer"
77− queryResult <- liftEffect $ result.database.query "SELECT *"
78− queryResult `shouldEqual` [ "Result from localhost" ]
79−
80− describe "Scoped Layers" do
81−
82− it "runs finalizers in reverse order on success" do
83− log <- liftEffect $ Ref.new []
84− let
85− layerA :: OmLayer (scope :: Scope) () { a :: String }
86− layerA = makeScopedLayer
87− (pure { a: "A" })
88− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-A" ]) log)
89−
90− layerB :: OmLayer (scope :: Scope) () { b :: String }
91− layerB = makeScopedLayer
92− (pure { b: "B" })
93− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-B" ]) log)
94−
95− layerC :: OmLayer (scope :: Scope) () { c :: String }
96− layerC = makeScopedLayer
97− (pure { c: "C" })
98− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-C" ]) log)
99−
100− layerBC :: OmLayer (scope :: Scope) () { b :: String, c :: String }
101− layerBC = combineRequirements layerB layerC
102−
103− combined = combineRequirements layerA layerBC
104−
105− _ <- liftAff $ runScoped combined
106− finalLog <- liftEffect $ Ref.read log
107− finalLog `shouldEqual` [ "release-C", "release-B", "release-A" ]
108−
109− it "runs finalizers when the callback throws" do
110− log <- liftEffect $ Ref.new []
111− let
112− layer :: OmLayer (scope :: Scope) () { value :: String }
113− layer = makeScopedLayer
114− (pure { value: "acquired" })
115− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "released" ]) log)
116−
117− _ <- liftAff $ try $ withScoped layer \_ ->
118− throwError (error "callback failed")
119− finalLog <- liftEffect $ Ref.read log
120− finalLog `shouldEqual` [ "released" ]
121−
122− it "threads finalizers through vertical composition (provide)" do
123− log <- liftEffect $ Ref.new []
124− let
125− baseLayer :: OmLayer (scope :: Scope) () { base :: String }
126− baseLayer = makeScopedLayer
127− (pure { base: "base-value" })
128− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-base" ]) log)
129−
130− upperLayer :: OmLayer (scope :: Scope, base :: String) () { upper :: String }
131− upperLayer = makeScopedLayer
132− ( do
133− { base } <- Om.ask
134− pure { upper: base <> "-extended" }
135− )
136− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-upper" ]) log)
137−
138− composed = upperLayer `provide` baseLayer
139−
140− result <- liftAff $ runScoped composed
141− result.upper `shouldEqual` "base-value-extended"
142− finalLog <- liftEffect $ Ref.read log
143− finalLog `shouldEqual` [ "release-upper", "release-base" ]
144−
145− it "works with bracketLayer" do
146− log <- liftEffect $ Ref.new []
147− let
148− layer = bracketLayer
149− ( do
150− liftEffect $ Ref.modify_ (_ <> [ "acquire" ]) log
151− pure 42
152− )
153− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release" ]) log)
154− (\n -> pure { value: n })
155−
156− result <- liftAff $ runScoped layer
157− result.value `shouldEqual` 42
158− finalLog <- liftEffect $ Ref.read log
159− finalLog `shouldEqual` [ "acquire", "release" ]
160−
161− it "fresh layer builds twice even when same base layer" do
162− counter <- liftEffect $ Ref.new 0
163− let
164− baseLayer :: OmLayer (scope :: Scope) () { value :: String }
165− baseLayer = makeLayer do
166− liftEffect $ Ref.modify_ (_ + 1) counter
167− pure { value: "built" }
168−
169− branch1 :: OmLayer (scope :: Scope) () { out1 :: String }
170− branch1 = consumer `provide` fresh baseLayer
171− where
172− consumer :: OmLayer (scope :: Scope, value :: String) () { out1 :: String }
173− consumer = makeLayer do
174− { value } <- Om.ask
175− pure { out1: value <> "-1" }
176−
177− branch2 :: OmLayer (scope :: Scope) () { out2 :: String }
178− branch2 = consumer `provide` fresh baseLayer
179− where
180− consumer :: OmLayer (scope :: Scope, value :: String) () { out2 :: String }
181− consumer = makeLayer do
182− { value } <- Om.ask
183− pure { out2: value <> "-2" }
184−
185− app = combineRequirements branch1 branch2
186−
187− result <- liftAff $ runScoped app
188− result.out1 `shouldEqual` "built-1"
189− result.out2 `shouldEqual` "built-2"
190− count <- liftEffect $ Ref.read counter
191− count `shouldEqual` 2
192−
193− it "combines scoped and non-scoped layers" do
194− log <- liftEffect $ Ref.new []
195− let
196− scopedLayer :: OmLayer (scope :: Scope) () { scoped :: String }
197− scopedLayer = makeScopedLayer
198− (pure { scoped: "yes" })
199− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-scoped" ]) log)
200−
201− plainLayer :: OmLayer () () { plain :: String }
202− plainLayer = makeLayer (pure { plain: "no-finalizer" })
203−
204− combined = combineRequirements scopedLayer plainLayer
205−
206− result <- liftAff $ runScoped combined
207− result.scoped `shouldEqual` "yes"
208− result.plain `shouldEqual` "no-finalizer"
209− finalLog <- liftEffect $ Ref.read log
210− finalLog `shouldEqual` [ "release-scoped" ]
211−
212− describe "Automatic Memoization" do
213−
214− it "builds the same layer only once when used in two branches" do
215− counter <- liftEffect $ Ref.new 0
216− let
217− expensiveLayer :: OmLayer (scope :: Scope) () { value :: String }
218− expensiveLayer = makeLayer do
219− liftEffect $ Ref.modify_ (_ + 1) counter
220− pure { value: "built" }
221−
222− branch1 :: OmLayer (scope :: Scope) () { out1 :: String }
223− branch1 = consumer `provide` expensiveLayer
224− where
225− consumer :: OmLayer (scope :: Scope, value :: String) () { out1 :: String }
226− consumer = makeLayer do
227− { value } <- Om.ask
228− pure { out1: value <> "-1" }
229−
230− branch2 :: OmLayer (scope :: Scope) () { out2 :: String }
231− branch2 = consumer `provide` expensiveLayer
232− where
233− consumer :: OmLayer (scope :: Scope, value :: String) () { out2 :: String }
234− consumer = makeLayer do
235− { value } <- Om.ask
236− pure { out2: value <> "-2" }
237−
238− app = combineRequirements branch1 branch2
239−
240− result <- liftAff $ runScoped app
241− result.out1 `shouldEqual` "built-1"
242− result.out2 `shouldEqual` "built-2"
243− count <- liftEffect $ Ref.read counter
244− count `shouldEqual` 1
245−
246− it "memoized scoped layer runs finalizer only once" do
247− log <- liftEffect $ Ref.new []
248− let
249− dbLayer :: OmLayer (scope :: Scope) () { db :: String }
250− dbLayer = makeScopedLayer
251− (pure { db: "connected" })
252− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "db-closed" ]) log)
253−
254− repoBranch :: OmLayer (scope :: Scope) () { repo :: String }
255− repoBranch = repo `provide` dbLayer
256− where
257− repo :: OmLayer (scope :: Scope, db :: String) () { repo :: String }
258− repo = makeLayer do
259− { db } <- Om.ask
260− pure { repo: db <> "-repo" }
261−
262− analyticsBranch :: OmLayer (scope :: Scope) () { analytics :: String }
263− analyticsBranch = analytics `provide` dbLayer
264− where
265− analytics :: OmLayer (scope :: Scope, db :: String) () { analytics :: String }
266− analytics = makeLayer do
267− { db } <- Om.ask
268− pure { analytics: db <> "-analytics" }
269−
270− app = combineRequirements repoBranch analyticsBranch
271−
272− result <- liftAff $ runScoped app
273− result.repo `shouldEqual` "connected-repo"
274− result.analytics `shouldEqual` "connected-analytics"
275− finalLog <- liftEffect $ Ref.read log
276− finalLog `shouldEqual` [ "db-closed" ]
277−
278− it "memoized bracketLayer acquires and releases only once" do
279− log <- liftEffect $ Ref.new []
280− let
281− connLayer :: OmLayer (scope :: Scope) () { conn :: Int }
282− connLayer = bracketLayer
283− ( do
284− liftEffect $ Ref.modify_ (_ <> [ "acquire" ]) log
285− pure 42
286− )
287− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release" ]) log)
288− (\n -> pure { conn: n })
289−
290− branch1 :: OmLayer (scope :: Scope) () { x :: String }
291− branch1 = upper `provide` connLayer
292− where
293− upper :: OmLayer (scope :: Scope, conn :: Int) () { x :: String }
294− upper = makeLayer do
295− { conn } <- Om.ask
296− pure { x: show conn }
297−
298− branch2 :: OmLayer (scope :: Scope) () { y :: String }
299− branch2 = upper `provide` connLayer
300− where
301− upper :: OmLayer (scope :: Scope, conn :: Int) () { y :: String }
302− upper = makeLayer do
303− { conn } <- Om.ask
304− pure { y: show (conn + 1) }
305−
306− app = combineRequirements branch1 branch2
307−
308− result <- liftAff $ runScoped app
309− result.x `shouldEqual` "42"
310− result.y `shouldEqual` "43"
311− finalLog <- liftEffect $ Ref.read log
312− finalLog `shouldEqual` [ "acquire", "release" ]
313−
314− describe "Error Channel" do
315−
316− it "composes layers with different error types" do
317− let
318− dbLayer :: OmLayer () (dbError :: String) { db :: String }
319− dbLayer = makeLayer do
320− pure { db: "connected" }
321−
322− cacheLayer :: OmLayer () (cacheError :: String) { cache :: String }
323− cacheLayer = makeLayer do
324− pure { cache: "ready" }
325−
326− combined :: OmLayer () (dbError :: String, cacheError :: String) { db :: String, cache :: String }
327− combined = combineRequirements dbLayer cacheLayer
328−
329− result <- Om.runOm {}
330− { exception: \_ -> pure { db: "", cache: "" }
331− , dbError: \_ -> pure { db: "", cache: "" }
332− , cacheError: \_ -> pure { db: "", cache: "" }
333− }
334− (runLayer {} combined)
335− result.db `shouldEqual` "connected"
336− result.cache `shouldEqual` "ready"
337−
338− it "propagates errors from the first layer" do
339− let
340− failingLayer :: OmLayer () (dbError :: String) { db :: String }
341− failingLayer = makeLayer do
342− Om.throw { dbError: "connection refused" }
343−
344− okLayer :: OmLayer () () { cache :: String }
345− okLayer = makeLayer do
346− pure { cache: "ready" }
347−
348− combined = combineRequirements failingLayer okLayer
349−
350− result <- Om.runReader {} (runLayer {} combined)
351− # liftAff
352− case result of
353− Left err -> do
354− let
355− msg = err # match
356− { exception: \_ -> "exception"
357− , dbError: \e -> e
358− }
359− msg `shouldEqual` "connection refused"
360− Right _ -> "should have failed" `shouldEqual` "but succeeded"
361−
362− it "propagates errors from the second layer" do
363− let
364− okLayer :: OmLayer () () { db :: String }
365− okLayer = makeLayer do
366− pure { db: "connected" }
367−
368− failingLayer :: OmLayer () (cacheError :: String) { cache :: String }
369− failingLayer = makeLayer do
370− Om.throw { cacheError: "cache unavailable" }
371−
372− combined = combineRequirements okLayer failingLayer
373−
374− result <- Om.runReader {} (runLayer {} combined)
375− # liftAff
376− case result of
377− Left err -> do
378− let
379− msg = err # match
380− { exception: \_ -> "exception"
381− , cacheError: \e -> e
382− }
383− msg `shouldEqual` "cache unavailable"
384− Right _ -> "should have failed" `shouldEqual` "but succeeded"
385−
386− it "propagates errors through vertical composition" do
387− let
388− baseLayer :: OmLayer () (baseError :: String) { base :: String }
389− baseLayer = makeLayer do
390− Om.throw { baseError: "base failed" }
391−
392− upperLayer :: OmLayer (base :: String) (upperError :: String) { upper :: String }
393− upperLayer = makeLayer do
394− { base } <- Om.ask
395− pure { upper: base <> "-extended" }
396−
397− composed = upperLayer `provide` baseLayer
398−
399− result <- Om.runReader {} (runLayer {} composed)
400− # liftAff
401− case result of
402− Left err -> do
403− let
404− msg = err # match
405− { exception: \_ -> "exception"
406− , baseError: \e -> e
407− , upperError: \_ -> "upper"
408− }
409− msg `shouldEqual` "base failed"
410− Right _ -> "should have failed" `shouldEqual` "but succeeded"
411−
412− it "scoped layers with errors run via runScopedWith" do
413− log <- liftEffect $ Ref.new []
414− let
415− dbLayer :: OmLayer (scope :: Scope) (dbError :: String) { db :: String }
416− dbLayer = makeScopedLayer
417− (pure { db: "connected" })
418− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "db-closed" ]) log)
419−
420− cacheLayer :: OmLayer (scope :: Scope) (cacheError :: String) { cache :: String }
421− cacheLayer = makeScopedLayer
422− (pure { cache: "ready" })
423− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "cache-closed" ]) log)
424−
425− combined = combineRequirements dbLayer cacheLayer
426−
427− let
428− handlers =
429− { exception: \_ -> pure { db: "", cache: "" }
430− , dbError: \_ -> pure { db: "", cache: "" }
431− , cacheError: \_ -> pure { db: "", cache: "" }
432− }
433− result <- liftAff $ runScopedWith handlers combined
434− result.db `shouldEqual` "connected"
435− result.cache `shouldEqual` "ready"
436− finalLog <- liftEffect $ Ref.read log
437− finalLog `shouldEqual` [ "cache-closed", "db-closed" ]
438−
439− it "scoped layer error triggers finalizers" do
440− log <- liftEffect $ Ref.new []
441− let
442− goodLayer :: OmLayer (scope :: Scope) () { good :: String }
443− goodLayer = makeScopedLayer
444− (pure { good: "ok" })
445− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "good-closed" ]) log)
446−
447− failLayer :: OmLayer (scope :: Scope) (buildError :: String) { bad :: String }
448− failLayer = makeScopedLayer
449− (Om.throw { buildError: "build failed" })
450− (\_ -> liftEffect $ Ref.modify_ (_ <> [ "bad-closed" ]) log)
451−
452− combined = combineRequirements goodLayer failLayer
453−
454− let
455− handlers =
456− { exception: \_ -> pure { good: "", bad: "" }
457− , buildError: \_ -> pure { good: "", bad: "" }
458− }
459− result <- liftAff $ try $ runScopedWith handlers combined
460− case result of
461− Right r -> r.good `shouldEqual` ""
462− Left _ -> pure unit
463− finalLog <- liftEffect $ Ref.read log
464− finalLog `shouldEqual` [ "good-closed" ]
465−
466− describe "Functor / Apply / Bind" do
467−
468− it "maps over layer output" do
469− let
470− layer :: OmLayer () () { value :: Int }
471− layer = makeLayer (pure { value: 10 })
472−
473− mapped = layer <#> \r -> { doubled: r.value * 2 }
474−
475− result <- Om.runOm {} { exception: \_ -> pure { doubled: 0 } } (runLayer {} mapped)
476− result.doubled `shouldEqual` 20
477−
478− it "applies two layers" do
479− let
480− fLayer :: OmLayer () () ({ a :: Int } -> { a :: Int, b :: String })
481− fLayer = makeLayer (pure \r -> { a: r.a, b: show r.a })
482−
483− aLayer :: OmLayer () () { a :: Int }
484− aLayer = makeLayer (pure { a: 42 })
485−
486− result <- Om.runOm {} { exception: \_ -> pure { a: 0, b: "" } } (runLayer {} (fLayer <*> aLayer))
487− result.a `shouldEqual` 42
488− result.b `shouldEqual` "42"
489−
490− it "binds layers sequentially" do
491− let
492− layer = do
493− r <- makeLayer (pure { x: 5 }) :: OmLayer () () { x :: Int }
494− makeLayer (pure { result: r.x + 10 })
495−
496− result <- Om.runOm {} { exception: \_ -> pure { result: 0 } } (runLayer {} layer)
497− result.result `shouldEqual` 15
498−
499− describe "Parallel" do
500−
501− it "runs layers in parallel via parApply" do
502− log <- liftEffect $ Ref.new []
503− let
504− layerA :: OmLayer () () { a :: String }
505− layerA = makeLayer do
506− liftEffect $ Ref.modify_ (_ <> [ "a" ]) log
507− pure { a: "A" }
508−
509− layerB :: OmLayer () () { b :: String }
510− layerB = makeLayer do
511− liftEffect $ Ref.modify_ (_ <> [ "b" ]) log
512− pure { b: "B" }
513−
514− combined = parApply (map (\ra rb -> { a: ra.a, b: rb.b }) layerA) layerB
515−
516− result <- Om.runOm {} { exception: \_ -> pure { a: "", b: "" } } (runLayer {} combined)
517− result.a `shouldEqual` "A"
518− result.b `shouldEqual` "B"
519− finalLog <- liftEffect $ Ref.read log
520− finalLog `shouldEqual` [ "a", "b" ]
521−
522− describe "Layer recovering" do
523−
524− it "retries layer construction on matching errors" do
525− attemptsRef <- liftEffect $ Ref.new 0
526− let
527− layer :: OmLayer () (dbError :: String) { db :: String }
528− layer = makeLayer do
529− attempts <- Ref.modify (_ + 1) attemptsRef # liftEffect
530− when (attempts < 3) do
531− Om.throw { dbError: "connection refused" }
532− pure { db: "connected" }
533−
534− retried = layer
535− # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 5)
536− \_ -> { dbError: \_ -> pure true }
537−
538− result <- Om.runOm {}
539− { exception: \_ -> pure { db: "" }, dbError: \_ -> pure { db: "" } }
540− (runLayer {} retried)
541− result.db `shouldEqual` "connected"
542− attempts <- liftEffect $ Ref.read attemptsRef
543− attempts `shouldEqual` 3
544−
545− it "does not retry on non-matching errors" do
546− attemptsRef <- liftEffect $ Ref.new 0
547− let
548− layer :: OmLayer () (dbError :: String, authError :: String) { db :: String }
549− layer = makeLayer do
550− Ref.modify_ (_ + 1) attemptsRef # liftEffect
551− Om.throw { authError: "unauthorized" }
552−
553− retried = layer
554− # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 3)
555− \_ -> { dbError: \_ -> pure true }
556−
557− _ <- Om.runOm {}
558− { exception: \_ -> pure { db: "" }
559− , dbError: \_ -> pure { db: "" }
560− , authError: \_ -> pure { db: "" }
561− }
562− (runLayer {} retried)
563− attempts <- liftEffect $ Ref.read attemptsRef
564− attempts `shouldEqual` 1
565−
566− it "preserves the error when retries are exhausted" do
567− let
568− layer :: OmLayer () (dbError :: String) { db :: String }
569− layer = makeLayer do
570− Om.throw { dbError: "connection refused" }
571−
572− retried = layer
573− # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 2)
574− \_ -> { dbError: \_ -> pure true }
575−
576− result <- Om.runReader {} (runLayer {} retried)
577− # liftAff
578− case result of
579− Left err -> do
580− let
581− msg = err # match
582− { exception: \_ -> "exception"
583− , dbError: \e -> e
584− }
585− msg `shouldEqual` "connection refused"
586− Right _ -> "should have failed" `shouldEqual` "but succeeded"
587−
588− it "only retries the specified error in a multi-error layer" do
589− attemptsRef <- liftEffect $ Ref.new 0
590− let
591− layer :: OmLayer () (dbError :: String, cacheError :: String) { db :: String }
592− layer = makeLayer do
593− attempts <- Ref.modify (_ + 1) attemptsRef # liftEffect
594− if attempts <= 2 then Om.throw { dbError: "db down" }
595− else Om.throw { cacheError: "cache miss" }
596−
597− retried = layer
598− # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 5)
599− \_ -> { dbError: \_ -> pure true }
600−
601− result <- Om.runReader {} (runLayer {} retried)
602− # liftAff
603− case result of
604− Left err -> do
605− let
606− msg = err # match
607− { exception: \_ -> "exception"
608− , dbError: \e -> e
609− , cacheError: \e -> e
610− }
611− msg `shouldEqual` "cache miss"
612− Right _ -> "should have failed" `shouldEqual` "but succeeded"
613− attempts <- liftEffect $ Ref.read attemptsRef
614− attempts `shouldEqual` 3
615−
616− it "uses RetryStatus in the check" do
617− attemptsRef <- liftEffect $ Ref.new 0
618− let
619− layer :: OmLayer () (dbError :: String) { db :: String }
620− layer = makeLayer do
621− Ref.modify_ (_ + 1) attemptsRef # liftEffect
622− Om.throw { dbError: "fail" }
623−
624− retried = layer
625− # recovering (constantDelay (Milliseconds 0.0) <> limitRetries 10)
626− \(RetryStatus s) -> { dbError: \_ -> pure (s.iterNumber < 2) }
627−
628− _ <- Om.runOm {}
629− { exception: \_ -> pure { db: "" }, dbError: \_ -> pure { db: "" } }
630− (runLayer {} retried)
631− attempts <- liftEffect $ Ref.read attemptsRef
632− attempts `shouldEqual` 3
633−
634− describe "Layer repeating" do
635−
636− it "repeats layer construction while condition holds" do
637− counterRef <- liftEffect $ Ref.new 0
638− let
639− layer :: OmLayer () () { count :: Int }
640− layer = makeLayer do
641− count <- Ref.modify (_ + 1) counterRef # liftEffect
642− pure { count }
643−
644− repeated = layer
645− # repeating (constantDelay (Milliseconds 0.0) <> limitRetries 10)
646− \_ r -> pure (r.count < 5)
647−
648− result <- Om.runOm {}
649− { exception: \_ -> pure { count: 0 } }
650− (runLayer {} repeated)
651− result.count `shouldEqual` 5
652−
653− it "stops when policy exhausted" do
654− counterRef <- liftEffect $ Ref.new 0
655− let
656− layer :: OmLayer () () { count :: Int }
657− layer = makeLayer do
658− count <- Ref.modify (_ + 1) counterRef # liftEffect
659− pure { count }
660−
661− repeated = layer
662− # repeating (constantDelay (Milliseconds 0.0) <> limitRetries 3)
663− \_ _ -> pure true
664−
665− result <- Om.runOm {}
666− { exception: \_ -> pure { count: 0 } }
667− (runLayer {} repeated)
668− result.count `shouldEqual` 4
669−
670− describe "wireLayers" do
671−
672− it "wires a simple linear chain (A -> B -> C)" do
673− let
674− a_base :: OmLayer (scope :: Scope) () { base :: String }
675− a_base = makeLayer (pure { base: "foundation" })
676−
677− b_mid :: OmLayer (scope :: Scope, base :: String) () { mid :: String }
678− b_mid = makeLayer do
679− { base } <- Om.ask
680− pure { mid: base <> "-middle" }
681−
682− c_top :: OmLayer (scope :: Scope, mid :: String) () { top :: String }
683− c_top = makeLayer do
684− { mid } <- Om.ask
685− pure { top: mid <> "-top" }
686−
687− app = wireLayers { a_base, b_mid, c_top }
688−
689− result <- liftAff $ runScoped app
690− result.base `shouldEqual` "foundation"
691− result.mid `shouldEqual` "foundation-middle"
692− result.top `shouldEqual` "foundation-middle-top"
693−
694− it "wires independent layers with no inter-dependencies" do
695− let
696− a_x :: OmLayer (scope :: Scope) () { x :: Int }
697− a_x = makeLayer (pure { x: 1 })
698−
699− b_y :: OmLayer (scope :: Scope) () { y :: Int }
700− b_y = makeLayer (pure { y: 2 })
701−
702− c_z :: OmLayer (scope :: Scope) () { z :: Int }
703− c_z = makeLayer (pure { z: 3 })
704−
705− app = wireLayers { a_x, b_y, c_z }
706−
707− result <- liftAff $ runScoped app
708− result.x `shouldEqual` 1
709− result.y `shouldEqual` 2
710− result.z `shouldEqual` 3
711−
712− it "wires a diamond dependency" do
713− let
714− a_db :: OmLayer (scope :: Scope) () { db :: String }
715− a_db = makeLayer (pure { db: "postgres" })
716−
717− b_cache :: OmLayer (scope :: Scope, db :: String) () { cache :: String }
718− b_cache = makeLayer do
719− { db } <- Om.ask
720− pure { cache: db <> "-cache" }
721−
722− b_repo :: OmLayer (scope :: Scope, db :: String) () { repo :: String }
723− b_repo = makeLayer do
724− { db } <- Om.ask
725− pure { repo: db <> "-repo" }
726−
727− d_app :: OmLayer (scope :: Scope, cache :: String, repo :: String) () { app :: String }
728− d_app = makeLayer do
729− { cache, repo } <- Om.ask
730− pure { app: cache <> "+" <> repo }
731−
732− app = wireLayers { a_db, b_cache, b_repo, d_app }
733−
734− result <- liftAff $ runScoped app
735− result.db `shouldEqual` "postgres"
736− result.cache `shouldEqual` "postgres-cache"
737− result.repo `shouldEqual` "postgres-repo"
738− result.app `shouldEqual` "postgres-cache+postgres-repo"
739−
740− it "memoizes shared dependencies within wireLayers" do
741− counter <- liftEffect $ Ref.new 0
742− let
743− a_db :: OmLayer (scope :: Scope) () { db :: String }
744− a_db = makeLayer do
745− liftEffect $ Ref.modify_ (_ + 1) counter
746− pure { db: "connected" }
747−
748− b_cache :: OmLayer (scope :: Scope, db :: String) () { cache :: String }
749− b_cache = makeLayer do
750− { db } <- Om.ask
751− pure { cache: db <> "-cache" }
752−
753− b_repo :: OmLayer (scope :: Scope, db :: String) () { repo :: String }
754− b_repo = makeLayer do
755− { db } <- Om.ask
756− pure { repo: db <> "-repo" }
757−
758− app = wireLayers { a_db, b_cache, b_repo }
759−
760− result <- liftAff $ runScoped app
761− result.cache `shouldEqual` "connected-cache"
762− result.repo `shouldEqual` "connected-repo"
763− count <- liftEffect $ Ref.read counter
764− count `shouldEqual` 1
13+main = launchAff_ do
14+ specs <- discover "Test\\.Yoga\\.Om\\.Layer\\..*Spec"
15+ liftEffect $ runSpecAndExitProcess [ consoleReporter ] specs