@@ -13,6 +13,7 @@ module Yoga.Om.Layer
13 , runScopedWith
13 , runScopedWith
14 , withScoped
14 , withScoped
15 , withScopedWith
15 , withScopedWith
16 , combineRequirements
17 , combineRequirements
@@ -20,18 +21,33 @@ module Yoga.Om.Layer
20 , repeating
21 , repeating
21 , wireLayers
22 , wireLayers
22 , wireLayersDebug
23 , wireLayersDebug
25 , class FilterScope
24 , class FilterScope
26 , class FindProvider
25 , class FindProvider
27 , class FindProviderMatch
26 , class FindProviderMatch
28 , class HasLabel
27 , class HasLabel
29 , class EmitEdges
28 , class EmitEdges
30+ , class BoxTop, class BoxMid, class BoxBot
31+ , class RenderDepChildNode
32+ , class IsNotProvided
33+ , class HasDirectMissing, class HasDirectMissingOr
34+ , class FindLayerReqs
35+ , class RenderProviderDeps
36+ , class RenderDepTree
37+ , class FirstProvLabel
38+ , class PrintLayerDispatch
30 , class PrintLayersRL
39 , class PrintLayersRL
31 , class PrintEdgesRL
40 , class PrintEdgesRL
41+ , class PrintLayersASCII
42+ , class PrintEdgesASCII
32 , class CheckAllProvided
44 , class CheckAllProvided
33 , class CheckAllLabelsExist
45 , class CheckAllLabelsExist
34 , class CheckLabelExists
46 , class CheckLabelExists
47+ , class TopoWire, topoWire
50+ , class FindReadyDispatch
37import Prelude
53import Prelude
@@ -60,8 +76,10 @@ import Prim.Row as Row
60import Type.Proxy (Proxy(..))
76import Type.Proxy (Proxy(..))
61import Prim.RowList (class RowToList, Cons, Nil, RowList)
77import Prim.RowList (class RowToList, Cons, Nil, RowList)
62import Prim.Boolean (True, False)
78import Prim.Boolean (True, False)
63−import Prim.Symbol (class Append)
79+import Prim.Symbol (class Append, class Cons)
80+import Type.Data.Boolean (class And)
81+import Type.RowList (class RowListAppend)
64−import Prim.TypeError (class Fail, class Warn, Above, Doc, Quote, Text)
82+import Prim.TypeError (class Fail, class Warn, Above, Beside, Doc, Quote, Text)
65import Record as Record
83import Record as Record
66import Record.Studio (class Keys)
84import Record.Studio (class Keys)
67import Type.Equality (class TypeEquals)
85import Type.Equality (class TypeEquals)
@@ -352,7 +370,7 @@ withScoped
352 . OmLayer (scope :: Scope) () (Record prov)
370 . OmLayer (scope :: Scope) () (Record prov)
353 -> (Record prov -> Aff a)
371 -> (Record prov -> Aff a)
355−withScoped = withScopedWith { exception: \_ -> pure (unsafeCoerce {}) }
373+withScoped = withScopedWith { exception: throwError }
357-- | Like `runScoped` but accepts error handlers for layers with typed errors.
375-- | Like `runScoped` but accepts error handlers for layers with typed errors.
358runScopedWith
376runScopedWith
@@ -385,6 +403,17 @@ withScopedWith handlers layer callback = bracket acquire release use
385 release { scope } = closeScope scope
403 release { scope } = closeScope scope
386 use { prov } = callback prov
404 use { prov } = callback prov
407+ :: forall prov a r rl err_ err
408+ . RowToList (exception :: Error -> Aff (Record prov) | r) rl
409+ => VariantMatchCases rl err_ (Aff (Record prov))
410+ => Union err_ () (exception :: Error | err)
411+ => { exception :: Error -> Aff (Record prov) | r }
412+ -> OmLayer (scope :: Scope) err (Record prov)
413+ -> (Record prov -> Aff a)
415+scoped = withScopedWith
388-- =============================================================================
417-- =============================================================================
389-- Horizontal composition — combine two layers with automatic deduplication
418-- Horizontal composition — combine two layers with automatic deduplication
390-- =============================================================================
419-- =============================================================================
@@ -481,13 +510,82 @@ repeating policy shouldRepeat (OmLayer layerId om) =
481 (applyAndDelay policy status >>= maybe (pure result) go)
510 (applyAndDelay policy status >>= maybe (pure result) go)
482 (pure result)
511 (pure result)
484-- =============================================================================
514-- =============================================================================
485−-- Auto-wiring
515+-- Topological auto-wiring (order-independent)
486-- =============================================================================
516-- =============================================================================
488−class
518+-- | Check if ALL labels in `needles` exist in `haystack`, returning a Boolean.
489− WireLayersRL
519+class AllLabelsIn (needles :: RowList Type) (haystack :: RowList Type) (result :: Boolean)
520+ | needles haystack -> result
522+instance AllLabelsIn Nil haystack True
525+ ( HasLabel label haystack found
526+ , AllLabelsIn tail haystack tailResult
527+ , And found tailResult result
529+ AllLabelsIn (Cons label ty tail) haystack result
531+-- | Dispatch based on whether a layer is ready (deps satisfied).
532+class FindReadyDispatch
536+ (tail :: RowList Type)
537+ (available :: RowList Type)
538+ (allLayersRL :: RowList Type)
539+ (foundSym :: Symbol)
540+ (foundLayer :: Type)
541+ (rest :: RowList Type)
542+ | ready sym layer tail available allLayersRL -> foundSym foundLayer rest
544+instance FindReadyDispatch True sym layer tail available allLayersRL sym layer tail
547+ FindReady tail available allLayersRL foundSym foundLayer rest' =>
548+ FindReadyDispatch False sym layer tail available allLayersRL foundSym foundLayer (Cons sym layer rest')
550+-- | Scan candidates for the first layer whose requirements are satisfied.
552+ (candidates :: RowList Type)
553+ (available :: RowList Type)
554+ (allLayersRL :: RowList Type)
557+ (rest :: RowList Type)
558+ | candidates available allLayersRL -> sym layer rest
561+ ( PrintLayersASCII allLayersRL graphDoc
564+ ( Above (Text "Dependency not provided!")
566+ ( Above (Text "No remaining layer has all its dependencies satisfied.")
568+ ( Above (Text "Dependency graph:") graphDoc
576+ FindReady Nil available allLayersRL sym layer rest
579+ ( RowToList req reqRL
580+ , AllLabelsIn reqRL available isReady
581+ , FindReadyDispatch isReady sym (OmLayer req err (Record prov)) tail available allLayersRL foundSym foundLayer rest
583+ FindReady (Cons sym (OmLayer req err (Record prov)) tail) available allLayersRL foundSym foundLayer rest
585+-- | Topologically sort and wire layers. Each iteration finds a layer whose
586+-- | dependencies are already satisfied, processes it, and adds its provisions.
490− (rl :: RowList Type)
588+ (remaining :: RowList Type)
491 (layers :: Row Type)
589 (layers :: Row Type)
492 (accReq :: Row Type)
590 (accReq :: Row Type)
493 (accErr :: Row Type)
591 (accErr :: Row Type)
@@ -495,20 +593,25 @@ class
495 (resReq :: Row Type)
593 (resReq :: Row Type)
496 (resErr :: Row Type)
594 (resErr :: Row Type)
497 (resProv :: Row Type)
595 (resProv :: Row Type)
498− | rl layers accReq accErr accProv -> resReq resErr resProv
596+ | remaining layers accReq accErr accProv -> resReq resErr resProv
500− wireLayersRL
598+ topoWire
501− :: Proxy rl
599+ :: Proxy remaining
502 -> Record layers
600 -> Record layers
503 -> OmLayer accReq accErr (Record accProv)
601 -> OmLayer accReq accErr (Record accProv)
504 -> OmLayer resReq resErr (Record resProv)
602 -> OmLayer resReq resErr (Record resProv)
506−instance WireLayersRL Nil layers accReq accErr accProv accReq accErr accProv where
604+instance TopoWire Nil layers accReq accErr accProv accReq accErr accProv where
507− wireLayersRL _ _ acc = acc
605+ topoWire _ _ acc = acc
509−instance
607+else instance
608+ ( RowToList layers allLayersRL
609+ , RowToList accProv accProvRL
610+ , RowToList accReq accReqRL
611+ , RowListAppend accProvRL accReqRL availableRL
612+ , FindReady remaining availableRL allLayersRL readySym (OmLayer nextReq nextErr (Record nextProv)) rest
510− ( IsSymbol sym
613+ , IsSymbol readySym
511− , Row.Cons sym (OmLayer nextReq nextErr (Record nextProv)) _rest layers
614+ , Row.Cons readySym (OmLayer nextReq nextErr (Record nextProv)) _rest layers
512 -- next's requirements must be subset of (accProv + accReq)
615 -- next's requirements must be subset of (accProv + accReq)
513 , Union accProv accReq provReqOut
616 , Union accProv accReq provReqOut
514 , Nub provReqOut provReqOut
617 , Nub provReqOut provReqOut
@@ -521,19 +624,18 @@ instance
521 , Nub errMergedRaw errMerged
624 , Nub errMergedRaw errMerged
522 , Union accErr _e1 errMerged
625 , Union accErr _e1 errMerged
523 , Union nextErr _e2 errMerged
626 , Union nextErr _e2 errMerged
524− -- merge provisions (Nub provMerged provMerged ensures disjoint)
627+ -- merge provisions
525 , Union accProv nextProv provMerged
628 , Union accProv nextProv provMerged
526 , Nub provMerged provMerged
629 , Nub provMerged provMerged
527 -- recurse
630 -- recurse
528− , WireLayersRL tail layers accReq errMerged provMerged resReq resErr resProv
631+ , TopoWire rest layers accReq errMerged provMerged resReq resErr resProv
530− WireLayersRL (Cons sym (OmLayer nextReq nextErr (Record nextProv)) tail) layers accReq accErr accProv resReq resErr resProv
633+ TopoWire remaining layers accReq accErr accProv resReq resErr resProv where
532− wireLayersRL _ layers acc =
634+ topoWire _ layers acc =
533− wireLayersRL (Proxy :: Proxy tail) layers combined
635+ topoWire (Proxy :: Proxy rest) layers combined
535 next :: OmLayer nextReq nextErr (Record nextProv)
637 next :: OmLayer nextReq nextErr (Record nextProv)
536− next = Record.get (Proxy :: Proxy sym) layers
638+ next = Record.get (Proxy :: Proxy readySym) layers
538 combined :: OmLayer accReq errMerged (Record provMerged)
640 combined :: OmLayer accReq errMerged (Record provMerged)
539 combined = OmLayer (freshId unit) do
641 combined = OmLayer (freshId unit) do
@@ -544,11 +646,11 @@ instance
544wireLayers
646wireLayers
545 :: forall layers rl req err prov
647 :: forall layers rl req err prov
546 . RowToList layers rl
648 . RowToList layers rl
547− => WireLayersRL rl layers (scope :: Scope) () () req err prov
649+ => TopoWire rl layers (scope :: Scope) () () req err prov
548 => Record layers
650 => Record layers
549 -> OmLayer req err (Record prov)
651 -> OmLayer req err (Record prov)
550wireLayers layers =
652wireLayers layers =
551− wireLayersRL (Proxy :: Proxy rl) layers seed
653+ topoWire (Proxy :: Proxy rl) layers seed
553 seed = pure {} :: OmLayer (scope :: Scope) () (Record ())
655 seed = pure {} :: OmLayer (scope :: Scope) () (Record ())
@@ -563,10 +665,16 @@ instance FilterScope Nil Nil
563instance FilterScope (Cons "scope" Scope tail) tail
665instance FilterScope (Cons "scope" Scope tail) tail
564else instance FilterScope tail out => FilterScope (Cons sym ty tail) (Cons sym ty out)
666else instance FilterScope tail out => FilterScope (Cons sym ty tail) (Cons sym ty out)
668+-- | Marker symbol for unresolved dependencies.
669+type NotProvided :: Symbol
670+type NotProvided = "???"
566-- | Given a label, find which layer in the RowList provides it.
672-- | Given a label, find which layer in the RowList provides it.
567class FindProvider (label :: Symbol) (rl :: RowList Type) (provider :: Symbol) | label rl -> provider
673class FindProvider (label :: Symbol) (rl :: RowList Type) (provider :: Symbol) | label rl -> provider
569−instance
675+instance FindProvider label Nil NotProvided
570 ( RowToList prov provRL
678 ( RowToList prov provRL
571 , HasLabel label provRL hasIt
679 , HasLabel label provRL hasIt
572 , FindProviderMatch hasIt label sym (Cons sym (OmLayer req err (Record prov)) tail) provider
680 , FindProviderMatch hasIt label sym (Cons sym (OmLayer req err (Record prov)) tail) provider
@@ -603,7 +711,7 @@ else instance
604 EmitEdges consumer (Cons label ty tail) allLayers (Above (Text line) restDoc)
712 EmitEdges consumer (Cons label ty tail) allLayers (Above (Text line) restDoc)
606−-- | Walk all layers emitting D2 edges.
714+-- | Walk all layers emitting D2 edges (mermaid format for wireLayersDebug).
607class PrintLayersRL (rl :: RowList Type) (doc :: Doc) | rl -> doc
715class PrintLayersRL (rl :: RowList Type) (doc :: Doc) | rl -> doc
608class PrintEdgesRL (rl :: RowList Type) (allLayers :: RowList Type) (doc :: Doc) | rl allLayers -> doc
716class PrintEdgesRL (rl :: RowList Type) (allLayers :: RowList Type) (doc :: Doc) | rl allLayers -> doc
@@ -620,12 +728,203 @@ else instance
621 PrintEdgesRL (Cons sym (OmLayer req err (Record prov)) tail) allLayers (Above edgeDoc restDoc)
729 PrintEdgesRL (Cons sym (OmLayer req err (Record prov)) tail) allLayers (Above edgeDoc restDoc)
731+-- | Map a symbol to same-length dashes (for box borders).
732+class DashesFor (sym :: Symbol) (dashes :: Symbol) | sym -> dashes
734+instance DashesFor "" ""
737+ ( Cons head tail sym
738+ , DashesFor tail rest
739+ , Append "─" rest dashes
741+ DashesFor sym dashes
743+-- | Build box parts from a symbol.
744+class BoxTop (sym :: Symbol) (result :: Symbol) | sym -> result
747+ ( DashesFor sym dashes
748+ , Append "╭─" dashes s0
749+ , Append s0 "─╮" result
753+class BoxMid (sym :: Symbol) (result :: Symbol) | sym -> result
756+ ( Append "│ " sym s0
757+ , Append s0 " │" result
761+class BoxBot (sym :: Symbol) (result :: Symbol) | sym -> result
764+ ( DashesFor sym dashes
765+ , Append "╰─" dashes s0
766+ , Append s0 "─╯" result
770+-- | Render a single dependency child node (dispatches on provided vs missing).
771+class RenderDepChildNode
772+ (isNotProvided :: Boolean) (provider :: Symbol) (label :: Symbol) (ty :: Type)
773+ (prePrefix :: Symbol) (contPrefix :: Symbol) (branchPrefix :: Symbol)
774+ (allLayers :: RowList Type) (doc :: Doc)
775+ | isNotProvided provider label ty prePrefix contPrefix branchPrefix allLayers -> doc
777+-- Missing dep: boxed label, type outside
779+ ( BoxTop label topLine, BoxMid label midLine, BoxBot label botLine
780+ , Append prePrefix topLine topFull
781+ , Append branchPrefix midLine midFull
782+ , Append contPrefix botLine botFull
784+ RenderDepChildNode True provider label ty prePrefix contPrefix branchPrefix allLayers
785+ (Above (Text topFull) (Above (Beside (Text midFull) (Beside (Text " :: ") (Beside (Quote ty) (Text " <-- ⚠️ not provided")))) (Text botFull)))
787+-- Provided dep: boxed label, then recurse into provider's sub-tree
789+ ( BoxTop label topLine, BoxMid label midLine, BoxBot label botLine
790+ , Append prePrefix topLine topFull
791+ , Append branchPrefix midLine midFull
792+ , Append contPrefix botLine botFull
793+ , Append contPrefix " " subTreePrefix
794+ , RenderProviderDeps provider subTreePrefix allLayers subDoc
796+ RenderDepChildNode False provider label ty prePrefix contPrefix branchPrefix allLayers
797+ (Above (Text topFull) (Above (Text midFull) (Above (Text botFull) subDoc)))
799+-- | Is this provider the NotProvided marker?
800+class IsNotProvided (provider :: Symbol) (result :: Boolean) | provider -> result
801+instance IsNotProvided NotProvided True
802+else instance IsNotProvided other False
804+-- | Does any requirement in this RowList resolve to NotProvided?
805+class HasDirectMissing (reqRL :: RowList Type) (allLayers :: RowList Type) (result :: Boolean)
806+ | reqRL allLayers -> result
808+instance HasDirectMissing Nil allLayers False
811+ ( FindProvider label allLayers provider
812+ , IsNotProvided provider isMissing
813+ , HasDirectMissingOr isMissing tail allLayers result
815+ HasDirectMissing (Cons label ty tail) allLayers result
817+class HasDirectMissingOr (found :: Boolean) (tail :: RowList Type) (allLayers :: RowList Type) (result :: Boolean)
818+ | found tail allLayers -> result
820+instance HasDirectMissingOr True tail allLayers True
823+ HasDirectMissing tail allLayers result =>
824+ HasDirectMissingOr False tail allLayers result
826+-- | Look up a layer's requirements by name.
827+class FindLayerReqs (sym :: Symbol) (allLayers :: RowList Type) (reqRL :: RowList Type)
828+ | sym allLayers -> reqRL
831+ RowToList req reqRL =>
832+ FindLayerReqs sym (Cons sym (OmLayer req err (Record prov)) tail) reqRL
835+ FindLayerReqs sym tail reqRL =>
836+ FindLayerReqs sym (Cons other otherLayer tail) reqRL
838+-- | Render a provider's sub-tree (stops at NotProvided or roots).
839+class RenderProviderDeps
840+ (provider :: Symbol) (prefix :: Symbol) (allLayers :: RowList Type) (doc :: Doc)
841+ | provider prefix allLayers -> doc
843+instance RenderProviderDeps NotProvided prefix allLayers (Text "")
846+ ( FindLayerReqs provider allLayers reqRL
847+ , FilterScope reqRL filteredReqRL
848+ , RenderDepTree prefix filteredReqRL allLayers doc
850+ RenderProviderDeps provider prefix allLayers doc
852+-- | Render a dependency tree with tree connectors.
854+ (prefix :: Symbol) (reqRL :: RowList Type) (allLayers :: RowList Type) (doc :: Doc)
855+ | prefix reqRL allLayers -> doc
857+instance RenderDepTree prefix Nil allLayers (Text "")
861+ ( FindProvider label allLayers provider
862+ , IsNotProvided provider isNP
863+ , Append prefix "│ " prePrefix
864+ , Append prefix " " contPrefix
865+ , Append prefix "└───" branchPrefix
866+ , RenderDepChildNode isNP provider label ty prePrefix contPrefix branchPrefix allLayers doc
868+ RenderDepTree prefix (Cons label ty Nil) allLayers doc
870+-- Non-last child: ├───
872+ ( FindProvider label allLayers provider
873+ , IsNotProvided provider isNP
874+ , Append prefix "│ " contPrefix
875+ , Append prefix "├───" branchPrefix
876+ , RenderDepChildNode isNP provider label ty contPrefix contPrefix branchPrefix allLayers childDoc
877+ , RenderDepTree prefix tail allLayers restDoc
879+ RenderDepTree prefix (Cons label ty tail) allLayers (Above childDoc restDoc)
881+-- | Extract the first label from a RowList.
882+class FirstProvLabel (rl :: RowList Type) (label :: Symbol) | rl -> label
883+instance FirstProvLabel (Cons label ty tail) label
885+-- | Dispatch: skip layers without missing deps, render tree for others.
886+class PrintLayerDispatch
887+ (show :: Boolean) (displayName :: Symbol) (filteredReqRL :: RowList Type)
888+ (tail :: RowList Type) (allLayers :: RowList Type) (doc :: Doc)
889+ | show displayName filteredReqRL tail allLayers -> doc
892+ PrintEdgesASCII tail allLayers doc =>
893+ PrintLayerDispatch False displayName filteredReqRL tail allLayers doc
896+ ( BoxTop displayName topLine, BoxMid displayName midLine, BoxBot displayName botLine
897+ , RenderDepTree " " filteredReqRL allLayers treeDoc
898+ , PrintEdgesASCII tail allLayers restDoc
900+ PrintLayerDispatch True displayName filteredReqRL tail allLayers
901+ (Above (Text topLine) (Above (Text midLine) (Above (Text botLine) (Above treeDoc (Above (Text "") restDoc)))))
903+-- | Walk all layers emitting ASCII dependency trees (for error messages).
904+class PrintLayersASCII (rl :: RowList Type) (doc :: Doc) | rl -> doc
905+class PrintEdgesASCII (rl :: RowList Type) (allLayers :: RowList Type) (doc :: Doc) | rl allLayers -> doc
907+instance PrintLayersASCII Nil (Text "")
908+else instance PrintEdgesASCII rl rl doc => PrintLayersASCII rl doc
910+instance PrintEdgesASCII Nil allLayers (Text "")
913+ ( RowToList req reqRL
914+ , FilterScope reqRL filteredReqRL
915+ , RowToList prov provRL
916+ , FirstProvLabel provRL displayName
917+ , HasDirectMissing filteredReqRL allLayers hasMissing
918+ , PrintLayerDispatch hasMissing displayName filteredReqRL tail allLayers doc
920+ PrintEdgesASCII (Cons sym (OmLayer req err (Record prov)) tail) allLayers doc
623wireLayersDebug
922wireLayersDebug
624 :: forall layers rl req err prov doc
923 :: forall layers rl req err prov doc
625 . RowToList layers rl
924 . RowToList layers rl
626 => PrintLayersRL rl doc
925 => PrintLayersRL rl doc
627 => Warn (Above (Text "") (Above (Text "%%{init: {\"flowchart\": {\"defaultRenderer\": \"elk\"}} }%%") (Above (Text "flowchart LR") doc)))
926 => Warn (Above (Text "") (Above (Text "%%{init: {\"flowchart\": {\"defaultRenderer\": \"elk\"}} }%%") (Above (Text "flowchart LR") doc)))
628− => WireLayersRL rl layers (scope :: Scope) () () req err prov
927+ => TopoWire rl layers (scope :: Scope) () () req err prov
629 => Record layers
928 => Record layers
630 -> OmLayer req err (Record prov)
929 -> OmLayer req err (Record prov)
631wireLayersDebug = wireLayers
930wireLayersDebug = wireLayers