@@ -13,40 +13,59 @@ module Yoga.Om.Layer
1313 , runScopedWith
1414 , withScoped
1515 , withScopedWith
16+ , scoped
1617 , combineRequirements
18+ , withValue
1719 , provide
1820 , (>->)
1921 , recovering
2022 , repeating
2123 , wireLayers
2224 , wireLayersDebug
23− , wireLayersRL
24− , class WireLayersRL
25− , class RowLabels
2625 , class FilterScope
2726 , class FindProvider
2827 , class FindProviderMatch
2928 , class HasLabel
30− , class LayerDepth
29+ , class EmitEdges
30+ , class DashesFor
31+ , class BoxTop, class BoxMid, class BoxBot
32+ , class RenderDepChildNode
33+ , class IsNotProvided
34+ , class HasDirectMissing, class HasDirectMissingOr
3135 , class FindLayerReqs
32− , class MaxProviderDepth
33− , class MaxSymbol
36+ , class RenderProviderDeps
37+ , class RenderDepTree
38+ , class FirstProvLabel
39+ , class PrintLayerDispatch
3440 , class PrintLayersRL
3541 , class PrintEdgesRL
36− , class IsNil
37− , class FormatNode
38− , class ProviderNames
42+ , class PrintLayersASCII
43+ , class PrintEdgesASCII
44+ , NotProvided
3945 , class CheckAllProvided
4046 , class CheckAllLabelsExist
4147 , class CheckLabelExists
48+ , class TopoWire, topoWire
49+ , class AllLabelsIn
50+ , class FindReady
51+ , class FindReadyDispatch
4252 ) where
4353
4454import Prelude
4555
46−import Control.Monad.Error.Class (catchError, throwError)
47−import Data.Symbol (class IsSymbol)
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)
4863import Control.Parallel (class Parallel)
4964import 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)
5069import Data.Array as Array
5170import Data.Foldable (for_)
5271import Data.Map (Map)
@@ -57,7 +76,10 @@ import Data.Variant (class VariantMatchCases, onMatch)
5776import Effect (Effect)
5877import Effect.Aff (Aff, bracket)
5978import Effect.Aff.Retry (RetryPolicyM, RetryStatus, applyAndDelay, defaultRetryStatus)
60−import Effect.Class (liftEffect)
79+import Effect.Aff.Class (class MonadAff)
80+import Effect.Aff.Class as Aff
81+import Effect.Class (class MonadEffect, liftEffect)
82+import Effect.Class (class MonadEffect, liftEffect) as Effect
6183import Effect.Exception (Error)
6284import Effect.Ref (Ref)
6385import Effect.Ref as Ref
@@ -67,14 +89,17 @@ import Prim.Row as Row
6789import Type.Proxy (Proxy(..))
6890import Prim.RowList (class RowToList, Cons, Nil, RowList)
6991import Prim.Boolean (True, False)
70−import Prim.Symbol (class Append)
71−import Prim.TypeError (class Fail, class Warn, Above, Doc, Quote, Text)
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)
7296import Record as Record
7397import Record.Studio (class Keys)
7498import Type.Equality (class TypeEquals)
7599import Unsafe.Coerce (unsafeCoerce)
76100import Yoga.Om (Om, ParOm)
77101import Yoga.Om as Om
102+import Yoga.Om.Error (Exception)
78103
79104-- =============================================================================
80105-- Scope — a first-class representation of resource lifetime
@@ -163,6 +188,36 @@ instance Bind (OmLayer req err) where
163188
164189instance Monad (OmLayer req err)
165190
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+
166221instance Functor (ParOmLayer req err) where
167222 map f (ParOmLayer p) = ParOmLayer (map f p)
168223
@@ -172,6 +227,14 @@ instance Apply (ParOmLayer req err) where
172227instance Applicative (ParOmLayer req err) where
173228 pure a = ParOmLayer (pure a)
174229
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+
175238instance Parallel (ParOmLayer req err) (OmLayer req err) where
176239 parallel (OmLayer _ om) = ParOmLayer (Parallel.parallel om)
177240 sequential (ParOmLayer p) = OmLayer (freshId unit) (Parallel.sequential p)
@@ -329,9 +392,13 @@ else instance
329392-- =============================================================================
330393
331394-- | 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.
332398runLayer
333399 :: forall req err a available
334400 . CheckAllProvided req available
401+ => Keys req
335402 => Record available
336403 -> OmLayer req err a
337404 -> Om (Record available) err a
@@ -359,7 +426,7 @@ withScoped
359426 . OmLayer (scope :: Scope) () (Record prov)
360427 -> (Record prov -> Aff a)
361428 -> Aff a
362−withScoped = withScopedWith { exception: \_ -> pure (unsafeCoerce {}) }
429+withScoped = withScopedWith { exception: throwError }
363430
364431-- | Like `runScoped` but accepts error handlers for layers with typed errors.
365432runScopedWith
@@ -392,6 +459,17 @@ withScopedWith handlers layer callback = bracket acquire release use
392459 release { scope } = closeScope scope
393460 use { prov } = callback prov
394461
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+
395473-- =============================================================================
396474-- Horizontal composition — combine two layers with automatic deduplication
397475-- =============================================================================
@@ -418,6 +496,17 @@ combineRequirements layer1 layer2 = OmLayer (freshId unit) do
418496 rec2 <- Om.expand (buildLayer layer2)
419497 pure (Record.merge rec1 rec2)
420498
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+
421510-- =============================================================================
422511-- Vertical composition — feed output of one layer into input of another
423512-- =============================================================================
@@ -488,13 +577,82 @@ repeating policy shouldRepeat (OmLayer layerId om) =
488577 (applyAndDelay policy status >>= maybe (pure result) go)
489578 (pure result)
490579
580+
491581-- =============================================================================
492−-- Auto-wiring
582+-- Topological auto-wiring (order-independent)
493583-- =============================================================================
494584
495−class
496− WireLayersRL
497− (rl :: RowList Type)
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)
498656 (layers :: Row Type)
499657 (accReq :: Row Type)
500658 (accErr :: Row Type)
@@ -502,20 +660,25 @@ class
502660 (resReq :: Row Type)
503661 (resErr :: Row Type)
504662 (resProv :: Row Type)
505− | rl layers accReq accErr accProv -> resReq resErr resProv
663+ | remaining layers accReq accErr accProv -> resReq resErr resProv
506664 where
507− wireLayersRL
508− :: Proxy rl
665+ topoWire
666+ :: Proxy remaining
509667 -> Record layers
510668 -> OmLayer accReq accErr (Record accProv)
511669 -> OmLayer resReq resErr (Record resProv)
512670
513−instance WireLayersRL Nil layers accReq accErr accProv accReq accErr accProv where
514− wireLayersRL _ _ acc = acc
671+instance TopoWire Nil layers accReq accErr accProv accReq accErr accProv where
672+ topoWire _ _ acc = acc
515673
516−instance
517− ( IsSymbol sym
518− , Row.Cons sym (OmLayer nextReq nextErr (Record nextProv)) _rest layers
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
519682 -- next's requirements must be subset of (accProv + accReq)
520683 , Union accProv accReq provReqOut
521684 , Nub provReqOut provReqOut
@@ -528,19 +691,18 @@ instance
528691 , Nub errMergedRaw errMerged
529692 , Union accErr _e1 errMerged
530693 , Union nextErr _e2 errMerged
531− -- merge provisions (Nub provMerged provMerged ensures disjoint)
694+ -- merge provisions
532695 , Union accProv nextProv provMerged
533696 , Nub provMerged provMerged
534697 -- recurse
535− , WireLayersRL tail layers accReq errMerged provMerged resReq resErr resProv
698+ , TopoWire rest layers accReq errMerged provMerged resReq resErr resProv
536699 ) =>
537− WireLayersRL (Cons sym (OmLayer nextReq nextErr (Record nextProv)) tail) layers accReq accErr accProv resReq resErr resProv
538− where
539− wireLayersRL _ layers acc =
540− wireLayersRL (Proxy :: Proxy tail) layers combined
700+ TopoWire remaining layers accReq accErr accProv resReq resErr resProv where
701+ topoWire _ layers acc =
702+ topoWire (Proxy :: Proxy rest) layers combined
541703 where
542704 next :: OmLayer nextReq nextErr (Record nextProv)
543− next = Record.get (Proxy :: Proxy sym) layers
705+ next = Record.get (Proxy :: Proxy readySym) layers
544706
545707 combined :: OmLayer accReq errMerged (Record provMerged)
546708 combined = OmLayer (freshId unit) do
@@ -551,33 +713,18 @@ instance
551713wireLayers
552714 :: forall layers rl req err prov
553715 . RowToList layers rl
554− => WireLayersRL rl layers (scope :: Scope) () () req err prov
716+ => TopoWire rl layers (scope :: Scope) () () req err prov
555717 => Record layers
556718 -> OmLayer req err (Record prov)
557719wireLayers layers =
558− wireLayersRL (Proxy :: Proxy rl) layers seed
720+ topoWire (Proxy :: Proxy rl) layers seed
559721 where
560722 seed = pure {} :: OmLayer (scope :: Scope) () (Record ())
561723
562724-- =============================================================================
563−-- Debug graph printing
725+-- Debug graph printing (D2 diagram)
564726-- =============================================================================
565727
566−-- | Collect labels from a RowList into a comma-separated Symbol.
567−class RowLabels (rl :: RowList Type) (out :: Symbol) | rl -> out
568−
569−instance RowLabels Nil ""
570−
571−else instance IsSymbol sym => RowLabels (Cons sym ty Nil) sym
572−
573−else instance
574− ( IsSymbol sym
575− , RowLabels tail rest
576− , Append sym ", " symComma
577− , Append symComma rest out
578− ) =>
579− RowLabels (Cons sym ty tail) out
580−
581728-- | Remove `scope :: Scope` from a RowList (it's always present, just noise).
582729class FilterScope (rl :: RowList Type) (out :: RowList Type) | rl -> out
583730
@@ -585,11 +732,16 @@ instance FilterScope Nil Nil
585732instance FilterScope (Cons "scope" Scope tail) tail
586733else instance FilterScope tail out => FilterScope (Cons sym ty tail) (Cons sym ty out)
587734
735+-- | Marker symbol for unresolved dependencies.
736+type NotProvided :: Symbol
737+type NotProvided = "???"
738+
588739-- | Given a label, find which layer in the RowList provides it.
589740class FindProvider (label :: Symbol) (rl :: RowList Type) (provider :: Symbol) | label rl -> provider
590741
591−-- This layer provides the label
592−instance
742+instance FindProvider label Nil NotProvided
743+
744+else instance
593745 ( RowToList prov provRL
594746 , HasLabel label provRL hasIt
595747 , FindProviderMatch hasIt label sym (Cons sym (OmLayer req err (Record prov)) tail) provider
@@ -599,10 +751,8 @@ instance
599751-- | Dispatch based on whether the current layer has the label.
600752class FindProviderMatch (hasIt :: Boolean) (label :: Symbol) (sym :: Symbol) (rl :: RowList Type) (provider :: Symbol) | hasIt label sym rl -> provider
601753
602−-- Yes: this layer provides it
603754instance FindProviderMatch True label sym rl sym
604755
605−-- No: keep looking in the tail
606756else instance
607757 FindProvider label tail provider =>
608758 FindProviderMatch False label sym (Cons sym ty tail) provider
@@ -614,137 +764,234 @@ instance HasLabel label Nil False
614764instance HasLabel label (Cons label ty tail) True
615765else instance HasLabel label tail result => HasLabel label (Cons sym ty tail) result
616766
617−-- | Compute depth of a layer: roots = "", each level adds " ".
618−class LayerDepth (sym :: Symbol) (allLayers :: RowList Type) (depth :: Symbol) | sym allLayers -> depth
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
619769
620−instance
621− ( FindLayerReqs sym allLayers reqRL
622− , FilterScope reqRL filteredReqRL
623− , MaxProviderDepth filteredReqRL allLayers depth
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
624778 ) =>
625− LayerDepth sym allLayers depth
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
626787
627−-- | Find the requirements RowList for a named layer.
628−class FindLayerReqs (sym :: Symbol) (rl :: RowList Type) (reqRL :: RowList Type) | sym rl -> reqRL
788+instance PrintEdgesRL Nil allLayers (Text "")
629789
630−instance
790+else instance
631791 ( RowToList req reqRL
792+ , FilterScope reqRL filteredReqRL
793+ , EmitEdges sym filteredReqRL allLayers edgeDoc
794+ , PrintEdgesRL tail allLayers restDoc
632795 ) =>
633− FindLayerReqs sym (Cons sym (OmLayer req err (Record prov)) tail) reqRL
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 "" ""
634802
635803else instance
636− FindLayerReqs sym tail reqRL =>
637− FindLayerReqs sym (Cons other ty tail) reqRL
804+ ( Cons head tail sym
805+ , DashesFor tail rest
806+ , Append "─" rest dashes
807+ ) =>
808+ DashesFor sym dashes
638809
639−-- | Compute max depth across all providers of a layer's requirements.
640−-- For each required label, find its provider, get provider's depth, add " ".
641−-- "Max" is approximated: we pick the longest depth symbol (deepest provider).
642−class MaxProviderDepth (reqRL :: RowList Type) (allLayers :: RowList Type) (depth :: Symbol) | reqRL allLayers -> depth
810+-- | Build box parts from a symbol.
811+class BoxTop (sym :: Symbol) (result :: Symbol) | sym -> result
643812
644−-- No requirements: root layer, depth ""
645−instance MaxProviderDepth Nil allLayers ""
813+instance
814+ ( DashesFor sym dashes
815+ , Append "╭─" dashes s0
816+ , Append s0 "─╮" result
817+ ) =>
818+ BoxTop sym result
646819
647−-- One or more requirements: depth = provider's depth + " "
648−else instance
649− ( FindProvider label allLayers provider
650− , LayerDepth provider allLayers provDepth
651− , Append provDepth " " nextDepth
652− , MaxProviderDepth tail allLayers tailDepth
653− , MaxSymbol nextDepth tailDepth depth
820+class BoxMid (sym :: Symbol) (result :: Symbol) | sym -> result
821+
822+instance
823+ ( Append "│ " sym s0
824+ , Append s0 " │" result
654825 ) =>
655− MaxProviderDepth (Cons label ty tail) allLayers depth
826+ BoxMid sym result
656827
657−-- | Pick the longer of two Symbols (approximating max depth).
658−class MaxSymbol (a :: Symbol) (b :: Symbol) (max :: Symbol) | a b -> max
828+class BoxBot (sym :: Symbol) (result :: Symbol) | sym -> result
659829
660−-- Both empty: result is empty
661−instance MaxSymbol "" "" ""
830+instance
831+ ( DashesFor sym dashes
832+ , Append "╰─" dashes s0
833+ , Append s0 "─╯" result
834+ ) =>
835+ BoxBot sym result
662836
663−-- a empty, b not: b wins
664−else instance MaxSymbol "" b b
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
665843
666−-- a not empty, b empty: a wins
667−else instance MaxSymbol a "" a
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)))
668853
669−-- Both non-empty: strip one char from each and recurse, then restore the winner
670−else instance
671− ( Append " " restA a
672− , Append " " restB b
673− , MaxSymbol restA restB deeper
674− , Append " " deeper max
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
675862 ) =>
676− MaxSymbol a b max
863+ RenderDepChildNode False provider label ty prePrefix contPrefix branchPrefix allLayers
864+ (Above (Text topFull) (Above (Text midFull) (Above (Text botFull) subDoc)))
677865
678−-- | Walk the layers RowList, printing each with indentation.
679−class PrintLayersRL (rl :: RowList Type) (doc :: Doc) | rl -> doc
680−class PrintEdgesRL (rl :: RowList Type) (allLayers :: RowList Type) (doc :: Doc) | rl allLayers -> doc
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
681870
682−instance PrintLayersRL Nil (Text "")
683−else instance PrintEdgesRL rl rl doc => PrintLayersRL rl doc
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
684874
685−instance PrintEdgesRL Nil allLayers (Text "")
875+instance HasDirectMissing Nil allLayers False
686876
687877else instance
688− ( RowToList req reqRL
689− , FilterScope reqRL filteredReqRL
690− , LayerDepth sym allLayers depth
691− , IsNil filteredReqRL isRoot
692− , FormatNode isRoot depth sym filteredReqRL allLayers line
693− , PrintEdgesRL tail allLayers restDoc
878+ ( FindProvider label allLayers provider
879+ , IsNotProvided provider isMissing
880+ , HasDirectMissingOr isMissing tail allLayers result
694881 ) =>
695− PrintEdgesRL (Cons sym (OmLayer req err (Record prov)) tail) allLayers (Above (Text line) restDoc)
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
696886
697−-- | Check if a RowList is Nil.
698−class IsNil (rl :: RowList Type) (result :: Boolean) | rl -> result
887+instance HasDirectMissingOr True tail allLayers True
699888
700−instance IsNil Nil True
701−else instance IsNil (Cons sym ty tail) False
889+else instance
890+ HasDirectMissing tail allLayers result =>
891+ HasDirectMissingOr False tail allLayers result
702892
703−-- | Format a node: root gets ○, others get ◀── providerList
704−class FormatNode (isRoot :: Boolean) (depth :: Symbol) (sym :: Symbol) (reqRL :: RowList Type) (allLayers :: RowList Type) (line :: Symbol) | isRoot depth sym reqRL allLayers -> line
893+-- | Look up a layer's requirements by name.
894+class FindLayerReqs (sym :: Symbol) (allLayers :: RowList Type) (reqRL :: RowList Type)
895+ | sym allLayers -> reqRL
705896
706−-- Root node
707897instance
708− ( Append " " depth s1
709− , Append s1 "○ " s2
710− , Append s2 sym line
711− ) =>
712− FormatNode True depth sym Nil allLayers line
898+ RowToList req reqRL =>
899+ FindLayerReqs sym (Cons sym (OmLayer req err (Record prov)) tail) reqRL
713900
714−-- Non-root: show providers ───▶ this
715901else instance
716− ( ProviderNames reqRL allLayers provSym
717− , Append " " depth s1
718− , Append s1 provSym s2
719− , Append s2 " ───▶ " s3
720− , Append s3 sym line
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
721916 ) =>
722− FormatNode False depth sym reqRL allLayers line
917+ RenderProviderDeps provider prefix allLayers doc
723918
724−-- | Collect provider names for a set of requirements.
725−class ProviderNames (reqRL :: RowList Type) (allLayers :: RowList Type) (out :: Symbol) | reqRL allLayers -> out
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
726923
727−instance ProviderNames Nil allLayers ""
924+instance RenderDepTree prefix Nil allLayers (Text "")
728925
926+-- Last child: └───
729927else instance
730928 ( 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
731934 ) =>
732− ProviderNames (Cons label ty Nil) allLayers provider
935+ RenderDepTree prefix (Cons label ty Nil) allLayers doc
733936
937+-- Non-last child: ├───
734938else instance
735939 ( FindProvider label allLayers provider
736− , ProviderNames tail allLayers rest
737− , Append provider ", " s1
738− , Append s1 rest out
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
739986 ) =>
740− ProviderNames (Cons label ty tail) allLayers out
987+ PrintEdgesASCII (Cons sym (OmLayer req err (Record prov)) tail) allLayers doc
741988
742989wireLayersDebug
743990 :: forall layers rl req err prov doc
744991 . RowToList layers rl
745992 => PrintLayersRL rl doc
746− => Warn (Above (Text "") (Above (Text "Layer wiring:") doc))
747− => WireLayersRL rl layers (scope :: Scope) () () req err prov
993+ => Warn (Above (Text "") (Above (Text "%%{init: {\"flowchart\": {\"defaultRenderer\": \"elk\"}} }%%") (Above (Text "flowchart LR") doc)))
994+ => TopoWire rl layers (scope :: Scope) () () req err prov
748995 => Record layers
749996 -> OmLayer req err (Record prov)
750997wireLayersDebug = wireLayers