@@ -22,20 +22,13 @@ module Yoga.Om.Layer
2222 , wireLayersDebug
2323 , wireLayersRL
2424 , class WireLayersRL
25− , class RowLabels
2625 , class FilterScope
2726 , class FindProvider
2827 , class FindProviderMatch
2928 , class HasLabel
30− , class LayerDepth
31− , class FindLayerReqs
32− , class MaxProviderDepth
33− , class MaxSymbol
29+ , class EmitEdges
3430 , class PrintLayersRL
3531 , class PrintEdgesRL
36− , class IsNil
37− , class FormatNode
38− , class ProviderNames
3932 , class CheckAllProvided
4033 , class CheckAllLabelsExist
4134 , class CheckLabelExists
@@ -560,24 +553,9 @@ wireLayers layers =
560553 seed = pure {} :: OmLayer (scope :: Scope) () (Record ())
561554
562555-- =============================================================================
563−-- Debug graph printing
556+-- Debug graph printing (D2 diagram)
564557-- =============================================================================
565558
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−
581559-- | Remove `scope :: Scope` from a RowList (it's always present, just noise).
582560class FilterScope (rl :: RowList Type) (out :: RowList Type) | rl -> out
583561
@@ -588,7 +566,6 @@ else instance FilterScope tail out => FilterScope (Cons sym ty tail) (Cons sym t
588566-- | Given a label, find which layer in the RowList provides it.
589567class FindProvider (label :: Symbol) (rl :: RowList Type) (provider :: Symbol) | label rl -> provider
590568
591−-- This layer provides the label
592569instance
593570 ( RowToList prov provRL
594571 , HasLabel label provRL hasIt
@@ -599,10 +576,8 @@ instance
599576-- | Dispatch based on whether the current layer has the label.
600577class FindProviderMatch (hasIt :: Boolean) (label :: Symbol) (sym :: Symbol) (rl :: RowList Type) (provider :: Symbol) | hasIt label sym rl -> provider
601578
602−-- Yes: this layer provides it
603579instance FindProviderMatch True label sym rl sym
604580
605−-- No: keep looking in the tail
606581else instance
607582 FindProvider label tail provider =>
608583 FindProviderMatch False label sym (Cons sym ty tail) provider
@@ -614,68 +589,20 @@ instance HasLabel label Nil False
614589instance HasLabel label (Cons label ty tail) True
615590else instance HasLabel label tail result => HasLabel label (Cons sym ty tail) result
616591
617−-- | Compute depth of a layer: roots = "", each level adds " ".
618−class LayerDepth (sym :: Symbol) (allLayers :: RowList Type) (depth :: Symbol) | sym allLayers -> depth
619−
620−instance
621− ( FindLayerReqs sym allLayers reqRL
622− , FilterScope reqRL filteredReqRL
623− , MaxProviderDepth filteredReqRL allLayers depth
624− ) =>
625− LayerDepth sym allLayers depth
592+-- | Emit D2 edges for one consumer: "provider -> consumer" per requirement.
593+class EmitEdges (consumer :: Symbol) (reqRL :: RowList Type) (allLayers :: RowList Type) (doc :: Doc) | consumer reqRL allLayers -> doc
626594
627−-- | Find the requirements RowList for a named layer.
628−class FindLayerReqs (sym :: Symbol) (rl :: RowList Type) (reqRL :: RowList Type) | sym rl -> reqRL
629−
630−instance
631− ( RowToList req reqRL
632− ) =>
633− FindLayerReqs sym (Cons sym (OmLayer req err (Record prov)) tail) reqRL
595+instance EmitEdges consumer Nil allLayers (Text "")
634596
635−else instance
636− FindLayerReqs sym tail reqRL =>
637− FindLayerReqs sym (Cons other ty tail) reqRL
638−
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
643−
644−-- No requirements: root layer, depth ""
645−instance MaxProviderDepth Nil allLayers ""
646−
647−-- One or more requirements: depth = provider's depth + " "
648597else instance
649598 ( FindProvider label allLayers provider
650− , LayerDepth provider allLayers provDepth
651− , Append provDepth " " nextDepth
652− , MaxProviderDepth tail allLayers tailDepth
653− , MaxSymbol nextDepth tailDepth depth
599+ , Append provider " -> " s1
600+ , Append s1 consumer line
601+ , EmitEdges consumer tail allLayers restDoc
654602 ) =>
655− MaxProviderDepth (Cons label ty tail) allLayers depth
656−
657−-- | Pick the longer of two Symbols (approximating max depth).
658−class MaxSymbol (a :: Symbol) (b :: Symbol) (max :: Symbol) | a b -> max
659−
660−-- Both empty: result is empty
661−instance MaxSymbol "" "" ""
662−
663−-- a empty, b not: b wins
664−else instance MaxSymbol "" b b
665−
666−-- a not empty, b empty: a wins
667−else instance MaxSymbol a "" a
603+ EmitEdges consumer (Cons label ty tail) allLayers (Above (Text line) restDoc)
668604
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
675− ) =>
676− MaxSymbol a b max
677−
678−-- | Walk the layers RowList, printing each with indentation.
605+-- | Walk all layers emitting D2 edges.
679606class PrintLayersRL (rl :: RowList Type) (doc :: Doc) | rl -> doc
680607class PrintEdgesRL (rl :: RowList Type) (allLayers :: RowList Type) (doc :: Doc) | rl allLayers -> doc
681608
@@ -687,64 +614,16 @@ instance PrintEdgesRL Nil allLayers (Text "")
687614else instance
688615 ( RowToList req reqRL
689616 , FilterScope reqRL filteredReqRL
690− , LayerDepth sym allLayers depth
691− , IsNil filteredReqRL isRoot
692− , FormatNode isRoot depth sym filteredReqRL allLayers line
617+ , EmitEdges sym filteredReqRL allLayers edgeDoc
693618 , PrintEdgesRL tail allLayers restDoc
694619 ) =>
695− PrintEdgesRL (Cons sym (OmLayer req err (Record prov)) tail) allLayers (Above (Text line) restDoc)
696−
697−-- | Check if a RowList is Nil.
698−class IsNil (rl :: RowList Type) (result :: Boolean) | rl -> result
699−
700−instance IsNil Nil True
701−else instance IsNil (Cons sym ty tail) False
702−
703−-- | Format a node: each layer appears once, indented by depth, with providers listed.
704−class FormatNode (isRoot :: Boolean) (depth :: Symbol) (sym :: Symbol) (reqRL :: RowList Type) (allLayers :: RowList Type) (line :: Symbol) | isRoot depth sym reqRL allLayers -> line
705−
706−-- Root node
707−instance
708− ( Append " " depth s1
709− , Append s1 "○ " s2
710− , Append s2 sym line
711− ) =>
712− FormatNode True depth sym Nil allLayers line
713−
714−-- Non-root: show this ◂── providerList
715−else instance
716− ( ProviderNames reqRL allLayers provSym
717− , Append " " depth s1
718− , Append s1 "○ " s2
719− , Append s2 sym s3
720− , Append s3 " ◂── " s4
721− , Append s4 provSym line
722− ) =>
723− FormatNode False depth sym reqRL allLayers line
724−
725−-- | Collect provider names for a set of requirements.
726−class ProviderNames (reqRL :: RowList Type) (allLayers :: RowList Type) (out :: Symbol) | reqRL allLayers -> out
727−
728−instance ProviderNames Nil allLayers ""
729−
730−else instance
731− ( FindProvider label allLayers provider
732− ) =>
733− ProviderNames (Cons label ty Nil) allLayers provider
734−
735−else instance
736− ( FindProvider label allLayers provider
737− , ProviderNames tail allLayers rest
738− , Append provider ", " s1
739− , Append s1 rest out
740− ) =>
741− ProviderNames (Cons label ty tail) allLayers out
620+ PrintEdgesRL (Cons sym (OmLayer req err (Record prov)) tail) allLayers (Above edgeDoc restDoc)
742621
743622wireLayersDebug
744623 :: forall layers rl req err prov doc
745624 . RowToList layers rl
746625 => PrintLayersRL rl doc
747− => Warn (Above (Text "") (Above (Text "Layer wiring:") doc))
626+ => Warn (Above (Text "") (Above (Text "Copy into https://play.d2lang.com") doc))
748627 => WireLayersRL rl layers (scope :: Scope) () () req err prov
749628 => Record layers
750629 -> OmLayer req err (Record prov)