@@ -1,6 +1,7 @@
11-- @inline export runLayer arity=2
22module Yoga.Om.Layer
33 ( OmLayer
4+ , ParOmLayer
45 , Scope
56 , makeLayer
67 , makeScopedLayer
@@ -9,38 +10,96 @@ module Yoga.Om.Layer
910 , fresh
1011 , runLayer
1112 , runScoped
13+ , runScopedWith
1214 , withScoped
15+ , withScopedWith
16+ , scoped
1317 , combineRequirements
18+ , withValue
1419 , provide
1520 , (>->)
21+ , recovering
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
1645 , class CheckAllProvided
1746 , class CheckAllLabelsExist
1847 , class CheckLabelExists
48+ , class TopoWire, topoWire
49+ , class AllLabelsIn
50+ , class FindReady
51+ , class FindReadyDispatch
1952 ) where
2053
2154import Prelude
2255
56+import Control.Alt (class Alt)
57+import Control.Alt as Alt
58+import Control.Alternative (class Alternative)
59+import Control.Monad.Error.Class (class MonadError, class MonadThrow, catchError, throwError)
60+import Control.Monad.Reader (class MonadAsk, class MonadReader)
61+import Control.Monad.Reader as Reader
62+import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
63+import Control.Parallel (class Parallel)
64+import 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)
2369import Data.Array as Array
2470import Data.Foldable (for_)
2571import Data.Map (Map)
2672import Data.Map as Map
27−import Data.Maybe (Maybe(..))
73+import Data.Maybe (Maybe(..), maybe)
2874import Data.Nullable (Nullable, toMaybe)
75+import Data.Variant (class VariantMatchCases, onMatch)
2976import Effect (Effect)
3077import Effect.Aff (Aff, bracket)
31−import Effect.Class (liftEffect)
78+import Effect.Aff.Retry (RetryPolicyM, RetryStatus, applyAndDelay, defaultRetryStatus)
79+import Effect.Aff.Class (class MonadAff)
80+import Effect.Aff.Class as Aff
81+import Effect.Class (class MonadEffect, liftEffect)
82+import Effect.Class (class MonadEffect, liftEffect) as Effect
83+import Effect.Exception (Error)
3284import Effect.Ref (Ref)
3385import Effect.Ref as Ref
3486import Effect.Unsafe (unsafePerformEffect)
3587import Prim.Row (class Nub, class Union)
88+import Prim.Row as Row
89+import Type.Proxy (Proxy(..))
3690import Prim.RowList (class RowToList, Cons, Nil, RowList)
37−import Prim.TypeError (class Fail, Above, Quote, Text)
91+import Prim.Boolean (True, False)
92+import Prim.Symbol (class Append, class Cons)
93+import Type.Data.Boolean (class And)
94+import Type.RowList (class RowListAppend)
95+import Prim.TypeError (class Fail, class Warn, Above, Beside, Doc, Quote, Text)
3896import Record as Record
3997import Record.Studio (class Keys)
4098import Type.Equality (class TypeEquals)
4199import Unsafe.Coerce (unsafeCoerce)
42−import Yoga.Om (Om)
100+import Yoga.Om (Om, ParOm)
43101import Yoga.Om as Om
102+import Yoga.Om.Error (Exception)
44103
45104-- =============================================================================
46105-- Scope — a first-class representation of resource lifetime
@@ -98,9 +157,87 @@ freshId _ = unsafePerformEffect nextId
98157-- OmLayer
99158-- =============================================================================
100159
101−-- | A layer that requires dependencies (req) and provides services (prov).
160+-- | A layer that requires dependencies (req), may fail with (err),
161+-- | and produces a value (typically Record prov).
102162-- | Each layer has a unique identity used for automatic memoization within a Scope.
103−data OmLayer req prov err = OmLayer Int (Om (Record req) err (Record prov))
163+data OmLayer req err a = OmLayer Int (Om (Record req) err a)
164+
165+-- =============================================================================
166+-- ParOmLayer — parallel counterpart
167+-- =============================================================================
168+
169+data ParOmLayer req err a = ParOmLayer (ParOm (Record req) err a)
170+
171+-- =============================================================================
172+-- Instances
173+-- =============================================================================
174+
175+instance Functor (OmLayer req err) where
176+ map f layer = OmLayer (freshId unit) (map f (buildLayer layer))
177+
178+instance Apply (OmLayer req err) where
179+ apply f a = OmLayer (freshId unit) (apply (buildLayer f) (buildLayer a))
180+
181+instance Applicative (OmLayer req err) where
182+ pure a = OmLayer (freshId unit) (pure a)
183+
184+instance Bind (OmLayer req err) where
185+ bind layer f = OmLayer (freshId unit) do
186+ a <- buildLayer layer
187+ buildLayer (f a)
188+
189+instance Monad (OmLayer req err)
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+
221+instance Functor (ParOmLayer req err) where
222+ map f (ParOmLayer p) = ParOmLayer (map f p)
223+
224+instance Apply (ParOmLayer req err) where
225+ apply (ParOmLayer f) (ParOmLayer a) = ParOmLayer (apply f a)
226+
227+instance Applicative (ParOmLayer req err) where
228+ pure a = ParOmLayer (pure a)
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+
238+instance Parallel (ParOmLayer req err) (OmLayer req err) where
239+ parallel (OmLayer _ om) = ParOmLayer (Parallel.parallel om)
240+ sequential (ParOmLayer p) = OmLayer (freshId unit) (Parallel.sequential p)
104241
105242-- =============================================================================
106243-- Automatic memoization
@@ -109,7 +246,7 @@ data OmLayer req prov err = OmLayer Int (Om (Record req) err (Record prov))
109246-- | Wrap an Om computation with cache logic.
110247-- | If a scope is available in the context, checks/populates the cache by layer ID.
111248-- | If no scope is present, runs the computation directly.
112−withCache :: forall req prov err. Int -> Om (Record req) err (Record prov) -> Om (Record req) err (Record prov)
249+withCache :: forall req err a. Int -> Om (Record req) err a -> Om (Record req) err a
113250withCache layerId om = do
114251 ctx <- Om.ask
115252 case toMaybe (tryGetScope ctx) of
@@ -130,11 +267,11 @@ withCache layerId om = do
130267-- | Create a layer from an Om computation.
131268-- | The layer is automatically memoized within a Scope — the same layer value
132269-- | used in multiple branches of a dependency graph builds only once.
133−makeLayer :: forall req prov err. Om (Record req) err (Record prov) -> OmLayer req prov err
270+makeLayer :: forall req err a. Om (Record req) err a -> OmLayer req err a
134271makeLayer om = OmLayer (freshId unit) om
135272
136273-- | Extract the Om from a layer, wrapped with cache logic.
137−buildLayer :: forall req prov err. OmLayer req prov err -> Om (Record req) err (Record prov)
274+buildLayer :: forall req err a. OmLayer req err a -> Om (Record req) err a
138275buildLayer (OmLayer layerId om) = withCache layerId om
139276
140277-- | Create a scoped layer with acquire/release semantics.
@@ -144,7 +281,7 @@ makeScopedLayer
144281 :: forall req prov err
145282 . Om { scope :: Scope | req } err (Record prov)
146283 -> (Record prov -> Aff Unit)
147− -> OmLayer (scope :: Scope | req) prov err
284+ -> OmLayer (scope :: Scope | req) err (Record prov)
148285makeScopedLayer acquire release = makeLayer do
149286 acquireRelease acquire release
150287
@@ -155,7 +292,7 @@ bracketLayer
155292 . Om { scope :: Scope | req } err resource
156293 -> (resource -> Aff Unit)
157294 -> (resource -> Om { scope :: Scope | req } err (Record prov))
158− -> OmLayer (scope :: Scope | req) prov err
295+ -> OmLayer (scope :: Scope | req) err (Record prov)
159296bracketLayer acquire release use = makeLayer do
160297 resource <- acquireRelease acquire (\r -> release r)
161298 use resource
@@ -177,7 +314,7 @@ acquireRelease acquire release = do
177314-- | Create a fresh (non-memoized) copy of a layer.
178315-- | The new layer has a unique identity and will always build independently,
179316-- | even within the same scope.
180−fresh :: forall req prov err. OmLayer req prov err -> OmLayer req prov err
317+fresh :: forall req err a. OmLayer req err a -> OmLayer req err a
181318fresh (OmLayer _ om) = OmLayer (freshId unit) om
182319
183320-- =============================================================================
@@ -255,22 +392,27 @@ else instance
255392-- =============================================================================
256393
257394-- | 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.
258398runLayer
259− :: forall req prov err available
399+ :: forall req err a available
260400 . CheckAllProvided req available
401+ => Keys req
261402 => Record available
262− -> OmLayer req prov err
263− -> Om (Record available) err (Record prov)
403+ -> OmLayer req err a
404+ -> Om (Record available) err a
264405runLayer _ctx layer = widenCtx (buildLayer layer)
265406 where
266− widenCtx :: Om (Record req) err (Record prov) -> Om (Record available) err (Record prov)
407+ widenCtx :: Om (Record req) err a -> Om (Record available) err a
267408 widenCtx = unsafeCoerce
268409
269410-- | Build a fully-provided scoped layer, return the provisions.
270411-- | All finalizers run after the provisions are returned.
412+-- | For layers with typed errors, use `runScopedWith`.
271413runScoped
272414 :: forall prov
273− . OmLayer (scope :: Scope) prov ()
415+ . OmLayer (scope :: Scope) () (Record prov)
274416 -> Aff (Record prov)
275417runScoped layer = withScoped layer pure
276418
@@ -278,66 +420,578 @@ runScoped layer = withScoped layer pure
278420-- | A fresh `Scope` is created and closed when the callback completes,
279421-- | running all finalizers in reverse order — whether by success, failure,
280422-- | or interruption.
423+-- | For layers with typed errors, use `withScopedWith`.
281424withScoped
282425 :: forall prov a
283− . OmLayer (scope :: Scope) prov ()
426+ . OmLayer (scope :: Scope) () (Record prov)
284427 -> (Record prov -> Aff a)
285428 -> Aff a
286−withScoped layer callback = bracket acquire release use
429+withScoped = withScopedWith { exception: throwError }
430+
431+-- | Like `runScoped` but accepts error handlers for layers with typed errors.
432+runScopedWith
433+ :: forall prov r rl err_ err
434+ . RowToList (exception :: Error -> Aff (Record prov) | r) rl
435+ => VariantMatchCases rl err_ (Aff (Record prov))
436+ => Union err_ () (exception :: Error | err)
437+ => { exception :: Error -> Aff (Record prov) | r }
438+ -> OmLayer (scope :: Scope) err (Record prov)
439+ -> Aff (Record prov)
440+runScopedWith handlers layer = withScopedWith handlers layer pure
441+
442+-- | Like `withScoped` but accepts error handlers for layers with typed errors.
443+withScopedWith
444+ :: forall prov a r rl err_ err
445+ . RowToList (exception :: Error -> Aff (Record prov) | r) rl
446+ => VariantMatchCases rl err_ (Aff (Record prov))
447+ => Union err_ () (exception :: Error | err)
448+ => { exception :: Error -> Aff (Record prov) | r }
449+ -> OmLayer (scope :: Scope) err (Record prov)
450+ -> (Record prov -> Aff a)
451+ -> Aff a
452+withScopedWith handlers layer callback = bracket acquire release use
287453 where
288454 acquire = do
289455 scope <- newScope # liftEffect
290456 let om = buildLayer layer
291− prov <- Om.runOm { scope } { exception: \_ -> pure (unsafeCoerce {}) } om
457+ prov <- Om.runOm { scope } handlers om
292458 pure { scope, prov }
293459 release { scope } = closeScope scope
294460 use { prov } = callback prov
295461
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+
296473-- =============================================================================
297474-- Horizontal composition — combine two layers with automatic deduplication
298475-- =============================================================================
299476
300477combineRequirements
301− :: forall req1 req2 prov1 prov2 err1 err2 provMerged provMergedRaw reqMerged reqDeduped _req1 _req2 _err1 _err2
478+ :: forall req1 req2 prov1 prov2 err1 err2 provMerged reqMerged reqDeduped errMerged errDeduped _req1 _req2 _err1 _err2
302479 . Union req1 req2 reqMerged
303480 => Nub reqMerged reqDeduped
304481 => Union req1 _req1 reqDeduped
305482 => Union req2 _req2 reqDeduped
306− => Union err1 _err1 ()
307− => Union err2 _err2 ()
308− => Union prov1 prov2 provMergedRaw
309− => Nub provMergedRaw provMerged
483+ => Union err1 err2 errMerged
484+ => Nub errMerged errDeduped
485+ => Union err1 _err1 errDeduped
486+ => Union err2 _err2 errDeduped
487+ => Union prov1 prov2 provMerged
488+ => Nub provMerged provMerged
310489 => Keys req1
311490 => Keys req2
312− => OmLayer req1 prov1 err1
313− -> OmLayer req2 prov2 err2
314− -> OmLayer reqDeduped provMerged ()
491+ => OmLayer req1 err1 (Record prov1)
492+ -> OmLayer req2 err2 (Record prov2)
493+ -> OmLayer reqDeduped errDeduped (Record provMerged)
315494combineRequirements layer1 layer2 = OmLayer (freshId unit) do
316495 rec1 <- Om.expand (buildLayer layer1)
317496 rec2 <- Om.expand (buildLayer layer2)
318497 pure (Record.merge rec1 rec2)
319498
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+
320510-- =============================================================================
321511-- Vertical composition — feed output of one layer into input of another
322512-- =============================================================================
323513
324514provide
325− :: forall req prov1 prov2 err1 err2 req2 reqOut _req _prov1 _err1 _err2
515+ :: forall req prov1 prov2 err1 err2 req2 reqOut errMerged errDeduped _req _prov1 _err1 _err2
326516 . Union req _req req
327517 => Union prov1 _prov1 prov1
328− => Union err1 _err1 ()
329− => Union err2 _err2 ()
518+ => Union err1 err2 errMerged
519+ => Nub errMerged errDeduped
520+ => Union err1 _err1 errDeduped
521+ => Union err2 _err2 errDeduped
330522 => Union prov1 req reqOut
331523 => Nub reqOut reqOut
332524 => Union req2 _prov1 reqOut
333525 => Keys req
334526 => Keys prov1
335527 => Keys req2
336− => OmLayer req2 prov2 err2
337− -> OmLayer req prov1 err1
338− -> OmLayer req prov2 ()
528+ => OmLayer req2 err2 (Record prov2)
529+ -> OmLayer req err1 (Record prov1)
530+ -> OmLayer req errDeduped (Record prov2)
339531provide l2 l1 = OmLayer (freshId unit) do
340532 prov1 <- Om.expand (buildLayer l1)
341533 Om.expand (buildLayer l2) # Om.widenCtx prov1
342534
343535infixl 9 provide as >->
536+
537+-- =============================================================================
538+-- Retry / Repeat on layers
539+-- =============================================================================
540+
541+recovering
542+ :: forall req err rest a
543+ (handlersRL :: RowList Type)
544+ (handlers :: Row Type)
545+ (handled :: Row Type)
546+ . RowToList handlers handlersRL
547+ => VariantMatchCases handlersRL handled (Om (Record req) err Boolean)
548+ => Union handled rest (exception :: Error | err)
549+ => RetryPolicyM (Om (Record req) err)
550+ -> (RetryStatus -> Record handlers)
551+ -> OmLayer req err a
552+ -> OmLayer req err a
553+recovering policy mkChecks (OmLayer layerId om) =
554+ OmLayer layerId (go defaultRetryStatus)
555+ where
556+ go status =
557+ catchError om (handleErr status)
558+
559+ handleErr status variant = do
560+ let shouldRetry = variant # onMatch (mkChecks status) (\_ -> pure false)
561+ ifM shouldRetry
562+ (applyAndDelay policy status >>= maybe (throwError variant) go)
563+ (throwError variant)
564+
565+repeating
566+ :: forall req err a
567+ . RetryPolicyM (Om (Record req) err)
568+ -> (RetryStatus -> a -> Om (Record req) err Boolean)
569+ -> OmLayer req err a
570+ -> OmLayer req err a
571+repeating policy shouldRepeat (OmLayer layerId om) =
572+ OmLayer layerId (go defaultRetryStatus)
573+ where
574+ go status = do
575+ result <- om
576+ ifM (shouldRepeat status result)
577+ (applyAndDelay policy status >>= maybe (pure result) go)
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