@@ -13,41 +13,93 @@ module Yoga.Om.Layer
1313 , runScopedWith
1414 , withScoped
1515 , withScopedWith
16+ , scoped
1617 , combineRequirements
18+ , withValue
1719 , provide
1820 , (>->)
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
1945 , class CheckAllProvided
2046 , class CheckAllLabelsExist
2147 , class CheckLabelExists
48+ , class TopoWire, topoWire
49+ , class AllLabelsIn
50+ , class FindReady
51+ , class FindReadyDispatch
2252 ) where
2353
2454import Prelude
2555
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)
2663import Control.Parallel (class Parallel)
2764import 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)
2869import Data.Array as Array
2970import Data.Foldable (for_)
3071import Data.Map (Map)
3172import Data.Map as Map
32−import Data.Maybe (Maybe(..))
73+import Data.Maybe (Maybe(..), maybe)
3374import Data.Nullable (Nullable, toMaybe)
34−import Data.Variant (class VariantMatchCases)
75+import Data.Variant (class VariantMatchCases, onMatch)
3576import Effect (Effect)
3677import Effect.Aff (Aff, bracket)
37−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
3883import Effect.Exception (Error)
3984import Effect.Ref (Ref)
4085import Effect.Ref as Ref
4186import Effect.Unsafe (unsafePerformEffect)
4287import Prim.Row (class Nub, class Union)
88+import Prim.Row as Row
89+import Type.Proxy (Proxy(..))
4390import Prim.RowList (class RowToList, Cons, Nil, RowList)
44−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)
4596import Record as Record
4697import Record.Studio (class Keys)
4798import Type.Equality (class TypeEquals)
4899import Unsafe.Coerce (unsafeCoerce)
49100import Yoga.Om (Om, ParOm)
50101import Yoga.Om as Om
102+import Yoga.Om.Error (Exception)
51103
52104-- =============================================================================
53105-- Scope — a first-class representation of resource lifetime
@@ -136,6 +188,36 @@ instance Bind (OmLayer req err) where
136188
137189instance Monad (OmLayer req err)
138190
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+
139221instance Functor (ParOmLayer req err) where
140222 map f (ParOmLayer p) = ParOmLayer (map f p)
141223
@@ -145,6 +227,14 @@ instance Apply (ParOmLayer req err) where
145227instance Applicative (ParOmLayer req err) where
146228 pure a = ParOmLayer (pure a)
147229
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+
148238instance Parallel (ParOmLayer req err) (OmLayer req err) where
149239 parallel (OmLayer _ om) = ParOmLayer (Parallel.parallel om)
150240 sequential (ParOmLayer p) = OmLayer (freshId unit) (Parallel.sequential p)
@@ -302,9 +392,13 @@ else instance
302392-- =============================================================================
303393
304394-- | 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.
305398runLayer
306399 :: forall req err a available
307400 . CheckAllProvided req available
401+ => Keys req
308402 => Record available
309403 -> OmLayer req err a
310404 -> Om (Record available) err a
@@ -332,7 +426,7 @@ withScoped
332426 . OmLayer (scope :: Scope) () (Record prov)
333427 -> (Record prov -> Aff a)
334428 -> Aff a
335−withScoped = withScopedWith { exception: \_ -> pure (unsafeCoerce {}) }
429+withScoped = withScopedWith { exception: throwError }
336430
337431-- | Like `runScoped` but accepts error handlers for layers with typed errors.
338432runScopedWith
@@ -365,12 +459,23 @@ withScopedWith handlers layer callback = bracket acquire release use
365459 release { scope } = closeScope scope
366460 use { prov } = callback prov
367461
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+
368473-- =============================================================================
369474-- Horizontal composition — combine two layers with automatic deduplication
370475-- =============================================================================
371476
372477combineRequirements
373− :: forall req1 req2 prov1 prov2 err1 err2 provMerged provMergedRaw reqMerged reqDeduped errMerged errDeduped _req1 _req2 _err1 _err2
478+ :: forall req1 req2 prov1 prov2 err1 err2 provMerged reqMerged reqDeduped errMerged errDeduped _req1 _req2 _err1 _err2
374479 . Union req1 req2 reqMerged
375480 => Nub reqMerged reqDeduped
376481 => Union req1 _req1 reqDeduped
@@ -379,8 +484,8 @@ combineRequirements
379484 => Nub errMerged errDeduped
380485 => Union err1 _err1 errDeduped
381486 => Union err2 _err2 errDeduped
382− => Union prov1 prov2 provMergedRaw
383− => Nub provMergedRaw provMerged
487+ => Union prov1 prov2 provMerged
488+ => Nub provMerged provMerged
384489 => Keys req1
385490 => Keys req2
386491 => OmLayer req1 err1 (Record prov1)
@@ -391,6 +496,17 @@ combineRequirements layer1 layer2 = OmLayer (freshId unit) do
391496 rec2 <- Om.expand (buildLayer layer2)
392497 pure (Record.merge rec1 rec2)
393498
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+
394510-- =============================================================================
395511-- Vertical composition — feed output of one layer into input of another
396512-- =============================================================================
@@ -417,3 +533,465 @@ provide l2 l1 = OmLayer (freshId unit) do
417533 Om.expand (buildLayer l2) # Om.widenCtx prov1
418534
419535infixl 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