@@ -1,9 +1,13 @@
11-- @inline export makeLayer arity=1
22-- @inline export runLayer arity=2
3−module Yoga.Om.Layer
3+module Yoga.Om.Layer
44 ( OmLayer(..)
5+ , Finalizers(..)
56 , makeLayer
7+ , makeScopedLayer
8+ , bracketLayer
69 , runLayer
10+ , runScoped
711 , combineRequirements
812 , provide
913 , (>->)
@@ -14,7 +18,11 @@ module Yoga.Om.Layer
1418
1519import Prelude
1620
21+import Data.Array as Array
1722import Data.Newtype (class Newtype)
23+import Data.Tuple.Nested ((/\), type (/\))
24+import Data.Foldable (for_)
25+import Effect.Aff (Aff, generalBracket)
1826import Effect.Aff.Class (liftAff)
1927import Prim.Row (class Nub, class Union)
2028import Prim.RowList (class RowToList, Cons, Nil, RowList)
@@ -26,21 +34,71 @@ import Unsafe.Coerce (unsafeCoerce)
2634import Yoga.Om (Om)
2735import Yoga.Om as Om
2836
29−-- | A layer that requires dependencies (req) and provides services (prov)
30−newtype OmLayer req prov err = OmLayer (Om (Record req) err (Record prov))
37+-- =============================================================================
38+-- Finalizers — guaranteed cleanup actions collected during layer construction
39+-- =============================================================================
40+
41+-- | Cleanup actions to run when a scope closes. Stored in construction order;
42+-- | executed in reverse (LIFO) by `runScoped`.
43+newtype Finalizers = Finalizers (Array (Aff Unit))
44+
45+derive instance Newtype Finalizers _
46+
47+instance Semigroup Finalizers where
48+ append (Finalizers a) (Finalizers b) = Finalizers (a <> b)
49+
50+instance Monoid Finalizers where
51+ mempty = Finalizers []
52+
53+-- =============================================================================
54+-- OmLayer — a layer that requires dependencies, provides services, and
55+-- carries finalizers for resource cleanup
56+-- =============================================================================
57+
58+-- | A layer that requires dependencies (req), provides services (prov),
59+-- | and may carry finalizers for scoped resource management.
60+newtype OmLayer req prov err = OmLayer (Om (Record req) err (Record prov /\ Finalizers))
3161
3262derive instance Newtype (OmLayer req prov err) _
3363
34−-- | Helper to create a layer from an Om computation
64+-- =============================================================================
65+-- Layer constructors
66+-- =============================================================================
67+
68+-- | Create a layer from an Om computation (no finalizers).
3569makeLayer :: forall req prov err. Om (Record req) err (Record prov) -> OmLayer req prov err
36−makeLayer = OmLayer
70+makeLayer om = OmLayer (om <#> \r -> r /\ mempty)
71+
72+-- | Create a scoped layer with acquire/release semantics.
73+-- | The release function is guaranteed to run when `runScoped` closes the scope.
74+makeScopedLayer
75+ :: forall req prov err
76+ . Om (Record req) err (Record prov)
77+ -> (Record prov -> Aff Unit)
78+ -> OmLayer req prov err
79+makeScopedLayer acquire release = OmLayer do
80+ prov <- acquire
81+ pure (prov /\ Finalizers [ release prov ])
82+
83+-- | Bracket-style scoped layer: acquire a resource, build provisions from it,
84+-- | and register a finalizer for the resource.
85+bracketLayer
86+ :: forall req prov resource err
87+ . Om (Record req) err resource
88+ -> (resource -> Aff Unit)
89+ -> (resource -> Om (Record req) err (Record prov))
90+ -> OmLayer req prov err
91+bracketLayer acquire release use = OmLayer do
92+ resource <- acquire
93+ prov <- use resource
94+ pure (prov /\ Finalizers [ release resource ])
3795
3896-- =============================================================================
3997-- Custom Type Errors for Missing Dependencies
4098-- =============================================================================
4199
42−-- | Check if all required dependencies are provided
43−-- If not, show a helpful diff of required vs available
100+-- | Check if all required dependencies are provided.
101+-- If not, show a helpful diff of required vs available.
44102class CheckAllProvided (required :: Row Type) (available :: Row Type)
45103
46104instance
@@ -50,157 +108,144 @@ instance
50108 ) =>
51109 CheckAllProvided required available
52110
53−-- | Check that all labels in required RowList exist in available RowList
54−-- Pass along the original rows for better error messages
111+-- | Check that all labels in required RowList exist in available RowList.
112+-- Pass along the original rows for better error messages.
55113class CheckAllLabelsExist (required :: RowList Type) (available :: RowList Type) (requiredRow :: Row Type) (availableRow :: Row Type)
56114
57−-- Base case: no more requirements to check
58115instance CheckAllLabelsExist Nil available requiredRow availableRow
59116
60−-- Recursive case: check if this label exists, then check the rest
61117instance
62118 ( CheckLabelExists label ty available requiredRow availableRow
63119 , CheckAllLabelsExist tail available requiredRow availableRow
64120 ) =>
65121 CheckAllLabelsExist (Cons label ty tail) available requiredRow availableRow
66122
67−-- | Check if a single label exists in the available RowList
68−-- This is where the magic happens - we dispatch on RowList structure in the instance head!
123+-- | Check if a single label exists in the available RowList.
69124class CheckLabelExists (label :: Symbol) (ty :: Type) (available :: RowList Type) (requiredRow :: Row Type) (availableRow :: Row Type)
70125
71−-- Found it! The label matches in the instance head
72−-- TypeEquals ensures the types at this label actually match!
73126instance
74127 TypeEquals ty ty' =>
75128 CheckLabelExists label ty (Cons label ty' tail) requiredRow availableRow
76129
77−-- Keep looking: different label, recurse on tail
78−else instance checkLabelExistsKeepLooking ::
130+else instance
79131 CheckLabelExists label ty tail requiredRow availableRow =>
80132 CheckLabelExists label ty (Cons otherLabel otherTy tail) requiredRow availableRow
81133
82−-- Not found: reached end of list, emit custom error WITH FULL CONTEXT!
83−else instance checkLabelExistsNotFound ::
134+else instance
84135 Fail
85136 ( Above
86137 (Text "Missing required dependency!")
87− (Above
88− (Text "")
89− (Above
90− (Text "The first missing field is: ")
91− (Above
92− (Quote label)
93− (Above
94− (Text "")
95− (Above
96− (Text "The layer requires: ")
97− (Above
98− (Quote requiredRow)
99− (Above
100− (Text "")
101− (Above
102− (Text "But you provided: ")
103− (Quote availableRow)
104− )
138+ ( Above
139+ (Text "")
140+ ( Above
141+ (Text "The first missing field is: ")
142+ ( Above
143+ (Quote label)
144+ ( Above
145+ (Text "")
146+ ( Above
147+ (Text "The layer requires: ")
148+ ( Above
149+ (Quote requiredRow)
150+ ( Above
151+ (Text "")
152+ ( Above
153+ (Text "But you provided: ")
154+ (Quote availableRow)
155+ )
156+ )
157+ )
158+ )
105159 )
106− )
107160 )
108− )
109161 )
110− )
111162 )
112163 ) =>
113164 CheckLabelExists label ty Nil requiredRow availableRow
114165
115−-- | Run a layer with a given context, with custom error if requirements aren't met
166+-- =============================================================================
167+-- Running layers
168+-- =============================================================================
169+
170+-- | Run a layer with a given context, discarding finalizers.
171+-- | Use `runScoped` instead if the layer has scoped resources.
116172runLayer
117173 :: forall req prov err available
118− . CheckAllProvided req available -- ← Custom error if dependencies missing!
174+ . CheckAllProvided req available
119175 => Record available
120176 -> OmLayer req prov err
121177 -> Om (Record available) err (Record prov)
122−runLayer _ctx layer = unsafeCastLayer layer
178+runLayer _ctx layer = unsafeCastLayer layer <#> \(prov /\ _) -> prov
123179 where
124− -- After CheckAllProvided succeeds, we know req ⊆ available at compile time
125− -- So this cast is safe - we're just telling the type system what it already proved
126− unsafeCastLayer :: OmLayer req prov err -> Om (Record available) err (Record prov)
180+ unsafeCastLayer :: OmLayer req prov err -> Om (Record available) err (Record prov /\ Finalizers)
127181 unsafeCastLayer = unsafeCoerce
128182
129−-- | The key function: combine two layers with automatic deduplication
130−-- Given two layers with potentially overlapping requirements,
131−-- produce a layer with deduplicated requirements
132−--
133−-- Uses expand to properly widen contexts and errors, then runs both layers!
183+-- | Run a fully-provided layer within a scope, passing the provisions to a
184+-- | callback. All finalizers are guaranteed to run in reverse order when the
185+-- | callback completes, whether by success, failure, or interruption.
186+runScoped
187+ :: forall prov a
188+ . OmLayer () prov ()
189+ -> (Record prov -> Aff a)
190+ -> Aff a
191+runScoped (OmLayer om) callback = generalBracket acquire conditions use
192+ where
193+ acquire = Om.runOm {} { exception: \_ -> pure (unsafeCoerce {} /\ mempty) } om
194+ conditions =
195+ { completed: \_ (_ /\ fins) -> runFinalizers fins
196+ , failed: \_ (_ /\ fins) -> runFinalizers fins
197+ , killed: \_ (_ /\ fins) -> runFinalizers fins
198+ }
199+ use (prov /\ _) = callback prov
200+
201+-- | Run finalizers in reverse order (LIFO).
202+runFinalizers :: Finalizers -> Aff Unit
203+runFinalizers (Finalizers fs) = for_ (Array.reverse fs) identity
204+
205+-- =============================================================================
206+-- Horizontal composition — combine two layers with automatic deduplication
207+-- =============================================================================
208+
134209combineRequirements
135210 :: forall req1 req2 prov1 prov2 err1 err2 provMerged provMergedRaw reqMerged reqDeduped _req1 _req2 _err1 _err2
136211 . Union req1 req2 reqMerged
137− => Nub reqMerged reqDeduped -- ← Automatic deduplication of requirements!
138− => Union req1 _req1 reqDeduped -- req1 is subset of reqDeduped
139− => Union req2 _req2 reqDeduped -- req2 is subset of reqDeduped
140− => Union err1 _err1 () -- Widen errors to empty
212+ => Nub reqMerged reqDeduped
213+ => Union req1 _req1 reqDeduped
214+ => Union req2 _req2 reqDeduped
215+ => Union err1 _err1 ()
141216 => Union err2 _err2 ()
142− => Union prov1 prov2 provMergedRaw -- Merge provisions
143− => Nub provMergedRaw provMerged -- Deduplicate provisions too!
144− => Keys req1 -- Needed for expand
145− => Keys req2 -- Needed for expand
217+ => Union prov1 prov2 provMergedRaw
218+ => Nub provMergedRaw provMerged
219+ => Keys req1
220+ => Keys req2
146221 => OmLayer req1 prov1 err1
147222 -> OmLayer req2 prov2 err2
148223 -> OmLayer reqDeduped provMerged ()
149−combineRequirements (OmLayer build1) (OmLayer build2) = makeLayer do
150− -- Widen both contexts and errors to allow them to run in the deduplicated context
151− -- expand allows an Om computation to run in a larger context with larger error row
152− rec1 <- Om.expand build1 -- Om req1 err1 -> Om reqDeduped ()
153− rec2 <- Om.expand build2 -- Om req2 err2 -> Om reqDeduped ()
154− -- Merge the results (Record.merge handles the Nub)
155− pure (Record.merge rec1 rec2)
156−
157−-- Example proof that this works:
158−-- If we have:
159−-- layer1 :: OmLayer (config :: Config) (logger :: Logger) ()
160−-- layer2 :: OmLayer (config :: Config) (database :: Database) ()
161−--
162−-- Then: combineRequirements layer1 layer2
163−-- Has type: OmLayer (config :: Config) prov3 err3
164−--
165−-- NOT: OmLayer (config :: Config, config :: Config) prov3 err3
166−--
167−-- The duplicated requirement (config, config) is automatically
168−-- deduplicated to just (config) by the Nub constraint!
224+combineRequirements (OmLayer build1) (OmLayer build2) = OmLayer do
225+ rec1 /\ fins1 <- Om.expand build1
226+ rec2 /\ fins2 <- Om.expand build2
227+ pure (Record.merge rec1 rec2 /\ (fins1 <> fins2))
169228
170229-- =============================================================================
171−-- Vertical Composition (ZLayer-style provide)
230+-- Vertical composition — feed output of one layer into input of another
172231-- =============================================================================
173232
174−-- | Vertical composition: feed output of one layer into input of another
175−-- | This is the >>> operator from ZIO ZLayer
176−-- |
177−-- | Example:
178−-- | postgresLive :: OmLayer (config :: Config) (postgres :: SQL) ()
179−-- | userRepoLive :: OmLayer (postgres :: SQL) (userRepo :: UserRepo) ()
180−-- |
181−-- | composed = userRepoLive `provide` postgresLive
182−-- | -- Result: OmLayer (config :: Config) (userRepo :: UserRepo) ()
183233provide
184234 :: forall req prov1 prov2 err1 err2 _req _prov1 _err1 _err2
185− . Union req _req req -- expand constraints
235+ . Union req _req req
186236 => Union prov1 _prov1 prov1
187237 => Union err1 _err1 ()
188238 => Union err2 _err2 ()
189239 => Keys req
190240 => Keys prov1
191− => OmLayer prov1 prov2 err2 -- layer that needs prov1, provides prov2
192− -> OmLayer req prov1 err1 -- layer that needs req, provides prov1
193− -> OmLayer req prov2 () -- composed: needs req, provides prov2
194−provide (OmLayer layer2) (OmLayer layer1) = makeLayer do
195− -- Run first layer to get prov1
196− prov1 <- Om.expand layer1
197−
198− -- Run second layer with prov1 as context
199− liftAff $ Om.runOm prov1
200− { exception: \_ -> pure (unsafeCoerce {}) }
241+ => OmLayer prov1 prov2 err2
242+ -> OmLayer req prov1 err1
243+ -> OmLayer req prov2 ()
244+provide (OmLayer layer2) (OmLayer layer1) = OmLayer do
245+ prov1 /\ fins1 <- Om.expand layer1
246+ prov2 /\ fins2 <- liftAff $ Om.runOm prov1
247+ { exception: \_ -> pure (unsafeCoerce {} /\ mempty) }
201248 (Om.expand layer2)
249+ pure (prov2 /\ (fins1 <> fins2))
202250
203251infixl 9 provide as >->
204−
205−-- TODO: More sophisticated composition operators
206−-- For now, use >>> for simple chains and combineRequirements for parallel deps