40bc3b4 · rowtype-yoga/purescript-yoga-om-layer

git.iko.soy/rowtype-yoga/purescript-yoga-om-layer

Add memoized combinator with Symbol-keyed cache in Scope

commit40bc3b45118953727e65b758b91fd72ece714c1f authorMark <mark.eibes@gmail.com> dateFri 13 Feb 2026, 21:17 (8 months ago) parentefda23a

3 files changed+91−49

compare with main

unifiedsplit

src/Yoga/Om/Layer.purs+64−22 test/Playground.purs+4−4 test/Test/Main.purs+23−23

src/Yoga/Om/Layer.purs+64−22

@@ -14,6 +14,9 @@ module Yoga.Om.Layer

1414 , combineRequirements

1515 , provide

1616 , (>->)

17+ , class CheckMemoKeys

18+ , class CheckMemoKeysList

19+ , class CheckKeyNotDuplicated

1720 , class CheckAllProvided

1821 , class CheckAllLabelsExist

1922 , class CheckLabelExists

@@ -85,15 +88,16 @@ closeScope (Scope s) = do

8588-- OmLayer

8689-- =============================================================================

8790

88−-- | A layer that requires dependencies (req) and provides services (prov).

89−data OmLayer req prov err = OmLayer (Om (Record req) err (Record prov))

91+-- | A layer that requires dependencies (req), provides services (prov),

92+-- | and tracks memoization keys (memo) to prevent key collisions at compile time.

93+data OmLayer req prov err (memo :: Row Type) = OmLayer (Om (Record req) err (Record prov))

9094

9195-- =============================================================================

9296-- Layer constructors

9397-- =============================================================================

9498

9599-- | Create a layer from an Om computation.

96−makeLayer :: forall req prov err. Om (Record req) err (Record prov) -> OmLayer req prov err

100+makeLayer :: forall req prov err. Om (Record req) err (Record prov) -> OmLayer req prov err ()

97101makeLayer = OmLayer

98102

99103-- | Create a scoped layer with acquire/release semantics.

@@ -103,7 +107,7 @@ makeScopedLayer

103107 :: forall req prov err

104108 . Om { scope :: Scope | req } err (Record prov)

105109 -> (Record prov -> Aff Unit)

106− -> OmLayer (scope :: Scope | req) prov err

110+ -> OmLayer (scope :: Scope | req) prov err ()

107111makeScopedLayer acquire release = makeLayer do

108112 acquireRelease acquire release

109113

@@ -114,7 +118,7 @@ bracketLayer

114118 . Om { scope :: Scope | req } err resource

115119 -> (resource -> Aff Unit)

116120 -> (resource -> Om { scope :: Scope | req } err (Record prov))

117− -> OmLayer (scope :: Scope | req) prov err

121+ -> OmLayer (scope :: Scope | req) prov err ()

118122bracketLayer acquire release use = makeLayer do

119123 resource <- acquireRelease acquire (\r -> release r)

120124 use resource

@@ -137,11 +141,11 @@ acquireRelease acquire release = do

137141-- | If the same key has already been built in this scope, the cached result

138142-- | is returned without re-running the layer.

139143memoized

140− :: forall sym req prov err

144+ :: forall sym req prov err memo

141145 . IsSymbol sym

142146 => Proxy sym

143− -> OmLayer (scope :: Scope | req) prov err

144− -> OmLayer (scope :: Scope | req) prov err

147+ -> OmLayer (scope :: Scope | req) prov err memo

148+ -> OmLayer (scope :: Scope | req) prov err (sym :: Record prov | memo)

145149memoized _ (OmLayer om) = OmLayer do

146150 { scope: Scope s } <- Om.ask

147151 let key = reflectSymbol (Proxy :: Proxy sym)

@@ -153,6 +157,38 @@ memoized _ (OmLayer om) = OmLayer do

153157 liftEffect $ Ref.modify_ (Map.insert key (toDynamic prov)) s.cache

154158 pure prov

155159

160+-- =============================================================================

161+-- Memo key safety — reject duplicate keys with different types

162+-- =============================================================================

163+

164+class CheckMemoKeys (row :: Row Type)

165+

166+instance (RowToList row rl, CheckMemoKeysList rl) => CheckMemoKeys row

167+

168+class CheckMemoKeysList (rl :: RowList Type)

169+

170+instance CheckMemoKeysList Nil

171+

172+instance

173+ ( CheckMemoKeysList tail

174+ , CheckKeyNotDuplicated label ty tail

175+ ) =>

176+ CheckMemoKeysList (Cons label ty tail)

177+

178+class CheckKeyNotDuplicated (label :: Symbol) (ty :: Type) (rest :: RowList Type)

179+

180+instance CheckKeyNotDuplicated label ty Nil

181+

182+instance

183+ ( TypeEquals ty ty'

184+ , CheckKeyNotDuplicated label ty tail

185+ ) =>

186+ CheckKeyNotDuplicated label ty (Cons label ty' tail)

187+

188+else instance

189+ CheckKeyNotDuplicated label ty tail =>

190+ CheckKeyNotDuplicated label ty (Cons otherLabel otherTy tail)

191+

156192-- =============================================================================

157193-- Custom Type Errors for Missing Dependencies

158194-- =============================================================================

@@ -229,10 +265,10 @@ else instance

229265

230266-- | Run a layer with a given context, with custom error if requirements aren't met.

231267runLayer

232− :: forall req prov err available

268+ :: forall req prov err available memo

233269 . CheckAllProvided req available

234270 => Record available

235− -> OmLayer req prov err

271+ -> OmLayer req prov err memo

236272 -> Om (Record available) err (Record prov)

237273runLayer _ctx (OmLayer om) = widenCtx om

238274 where

@@ -242,8 +278,8 @@ runLayer _ctx (OmLayer om) = widenCtx om

242278-- | Build a fully-provided scoped layer, return the provisions.

243279-- | All finalizers run after the provisions are returned.

244280runScoped

245− :: forall prov

246− . OmLayer (scope :: Scope) prov ()

281+ :: forall prov memo

282+ . OmLayer (scope :: Scope) prov () memo

247283 -> Aff (Record prov)

248284runScoped layer = withScoped layer pure

249285

@@ -252,8 +288,8 @@ runScoped layer = withScoped layer pure

252288-- | running all finalizers in reverse order — whether by success, failure,

253289-- | or interruption.

254290withScoped

255− :: forall prov a

256− . OmLayer (scope :: Scope) prov ()

291+ :: forall prov a memo

292+ . OmLayer (scope :: Scope) prov () memo

257293 -> (Record prov -> Aff a)

258294 -> Aff a

259295withScoped (OmLayer om) callback = bracket acquire release use

@@ -270,7 +306,7 @@ withScoped (OmLayer om) callback = bracket acquire release use

270306-- =============================================================================

271307

272308combineRequirements

273− :: forall req1 req2 prov1 prov2 err1 err2 provMerged provMergedRaw reqMerged reqDeduped _req1 _req2 _err1 _err2

309+ :: forall req1 req2 prov1 prov2 err1 err2 memo1 memo2 provMerged provMergedRaw reqMerged reqDeduped memoMerged memoDeduped _req1 _req2 _err1 _err2

274310 . Union req1 req2 reqMerged

275311 => Nub reqMerged reqDeduped

276312 => Union req1 _req1 reqDeduped

@@ -279,11 +315,14 @@ combineRequirements

279315 => Union err2 _err2 ()

280316 => Union prov1 prov2 provMergedRaw

281317 => Nub provMergedRaw provMerged

318+ => Union memo1 memo2 memoMerged

319+ => CheckMemoKeys memoMerged

320+ => Nub memoMerged memoDeduped

282321 => Keys req1

283322 => Keys req2

284− => OmLayer req1 prov1 err1

285− -> OmLayer req2 prov2 err2

286− -> OmLayer reqDeduped provMerged ()

323+ => OmLayer req1 prov1 err1 memo1

324+ -> OmLayer req2 prov2 err2 memo2

325+ -> OmLayer reqDeduped provMerged () memoDeduped

287326combineRequirements (OmLayer build1) (OmLayer build2) = OmLayer do

288327 rec1 <- Om.expand build1

289328 rec2 <- Om.expand build2

@@ -294,7 +333,7 @@ combineRequirements (OmLayer build1) (OmLayer build2) = OmLayer do

294333-- =============================================================================

295334

296335provide

297− :: forall req prov1 prov2 err1 err2 req2 reqOut _req _prov1 _err1 _err2

336+ :: forall req prov1 prov2 err1 err2 req2 reqOut memo1 memo2 memoMerged memoDeduped _req _prov1 _err1 _err2

298337 . Union req _req req

299338 => Union prov1 _prov1 prov1

300339 => Union err1 _err1 ()

@@ -302,12 +341,15 @@ provide

302341 => Union prov1 req reqOut

303342 => Nub reqOut reqOut

304343 => Union req2 _prov1 reqOut

344+ => Union memo1 memo2 memoMerged

345+ => CheckMemoKeys memoMerged

346+ => Nub memoMerged memoDeduped

305347 => Keys req

306348 => Keys prov1

307349 => Keys req2

308− => OmLayer req2 prov2 err2

309− -> OmLayer req prov1 err1

310− -> OmLayer req prov2 ()

350+ => OmLayer req2 prov2 err2 memo2

351+ -> OmLayer req prov1 err1 memo1

352+ -> OmLayer req prov2 () memoDeduped

311353provide (OmLayer layer2) (OmLayer layer1) = OmLayer do

312354 prov1 <- Om.expand layer1

313355 Om.expand layer2 # Om.widenCtx prov1

test/Playground.purs+4−4

@@ -25,24 +25,24 @@ type CacheL r = (cache :: Cache | r)

2525type CacheL_ = CacheL ()

2626

2727-- Example layer 1: needs config, provides logger

28−loggerLayer :: OmLayer ConfigL_ LoggerL_ ()

28+loggerLayer :: OmLayer ConfigL_ LoggerL_ () _

2929loggerLayer = makeLayer do

3030 { config } <- Om.ask

3131 pure { logger: { log: \msg -> pure unit } }

3232

3333-- Example layer 2: needs config, provides database

34−databaseLayer :: OmLayer ConfigL_ DatabaseL_ ()

34+databaseLayer :: OmLayer ConfigL_ DatabaseL_ () _

3535databaseLayer = makeLayer do

3636 { config } <- Om.ask

3737 pure { database: { query: \q -> pure [] } }

3838

3939-- Example layer 3: needs logger and database, provides cache

40−cacheLayer :: OmLayer (LoggerL + DatabaseL_) CacheL_ ()

40+cacheLayer :: OmLayer (LoggerL + DatabaseL_) CacheL_ () _

4141cacheLayer = makeLayer do

4242 { logger, database } <- Om.ask

4343 pure { cache: { get: \key -> pure Nothing } }

4444

45−programLayer :: OmLayer (DatabaseL + CacheL_) () ()

45+programLayer :: OmLayer (DatabaseL + CacheL_) () () _

4646programLayer = makeLayer do

4747 pure {}

4848

test/Test/Main.purs+23−23

@@ -30,13 +30,13 @@ main = launchAff_ $ runSpec [ consoleReporter ] do

3030 -- Define layers with dependencies

3131 let

3232 -- Layer that requires config

33− loggerLayer :: OmLayer (config :: Config) (logger :: Logger) ()

33+ loggerLayer :: OmLayer (config :: Config) (logger :: Logger) () _

3434 loggerLayer = makeLayer do

3535 { config } <- Om.ask

3636 pure { logger: { log: \msg -> Console.log $ "[" <> config.host <> "] " <> msg } }

3737

3838 -- Layer that also requires config

39− databaseLayer :: OmLayer (config :: Config) (database :: Database) ()

39+ databaseLayer :: OmLayer (config :: Config) (database :: Database) () _

4040 databaseLayer = makeLayer do

4141 { config } <- Om.ask

4242 pure { database: { query: \q -> pure [ "Result from " <> config.host ] } }

@@ -47,7 +47,7 @@ main = launchAff_ $ runSpec [ consoleReporter ] do

4747 let

4848 -- The type annotation proves deduplication works:

4949 _proofOfDeduplication

50− :: OmLayer (config :: Config) _ _

50+ :: OmLayer (config :: Config) _ _ _

5151 _proofOfDeduplication = combineRequirements loggerLayer databaseLayer

5252

5353 Console.log "✓ PROOF OF CONCEPT SUCCESS!"

@@ -78,7 +78,7 @@ main = launchAff_ $ runSpec [ consoleReporter ] do

7878 let

7979 -- Manually construct a combined layer that shows both "components"

8080 -- accessing the same shared context (with deduplicated requirements)

81− combinedLayer :: OmLayer (config :: Config, accessLog :: Ref.Ref String) (logger :: Logger, database :: Database) ()

81+ combinedLayer :: OmLayer (config :: Config, accessLog :: Ref.Ref String) (logger :: Logger, database :: Database) () _

8282 combinedLayer = makeLayer do

8383 -- Get the shared context - note the type signature shows it's deduplicated!

8484 { config, accessLog: log } <- Om.ask

@@ -131,22 +131,22 @@ main = launchAff_ $ runSpec [ consoleReporter ] do

131131 it "runs finalizers in reverse order on success" do

132132 log <- liftEffect $ Ref.new []

133133 let

134− layerA :: OmLayer (scope :: Scope) (a :: String) ()

134+ layerA :: OmLayer (scope :: Scope) (a :: String) () _

135135 layerA = makeScopedLayer

136136 (pure { a: "A" })

137137 (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-A" ]) log)

138138

139− layerB :: OmLayer (scope :: Scope) (b :: String) ()

139+ layerB :: OmLayer (scope :: Scope) (b :: String) () _

140140 layerB = makeScopedLayer

141141 (pure { b: "B" })

142142 (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-B" ]) log)

143143

144− layerC :: OmLayer (scope :: Scope) (c :: String) ()

144+ layerC :: OmLayer (scope :: Scope) (c :: String) () _

145145 layerC = makeScopedLayer

146146 (pure { c: "C" })

147147 (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-C" ]) log)

148148

149− layerBC :: OmLayer (scope :: Scope) (b :: String, c :: String) ()

149+ layerBC :: OmLayer (scope :: Scope) (b :: String, c :: String) () _

150150 layerBC = combineRequirements layerB layerC

151151

152152 combined = combineRequirements layerA layerBC

@@ -158,7 +158,7 @@ main = launchAff_ $ runSpec [ consoleReporter ] do

158158 it "runs finalizers when the callback throws" do

159159 log <- liftEffect $ Ref.new []

160160 let

161− layer :: OmLayer (scope :: Scope) (value :: String) ()

161+ layer :: OmLayer (scope :: Scope) (value :: String) () _

162162 layer = makeScopedLayer

163163 (pure { value: "acquired" })

164164 (\_ -> liftEffect $ Ref.modify_ (_ <> [ "released" ]) log)

@@ -171,12 +171,12 @@ main = launchAff_ $ runSpec [ consoleReporter ] do

171171 it "threads finalizers through vertical composition (provide)" do

172172 log <- liftEffect $ Ref.new []

173173 let

174− baseLayer :: OmLayer (scope :: Scope) (base :: String) ()

174+ baseLayer :: OmLayer (scope :: Scope) (base :: String) () _

175175 baseLayer = makeScopedLayer

176176 (pure { base: "base-value" })

177177 (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-base" ]) log)

178178

179− upperLayer :: OmLayer (scope :: Scope, base :: String) (upper :: String) ()

179+ upperLayer :: OmLayer (scope :: Scope, base :: String) (upper :: String) () _

180180 upperLayer = makeScopedLayer

181181 ( do

182182 { base } <- Om.ask

@@ -210,12 +210,12 @@ main = launchAff_ $ runSpec [ consoleReporter ] do

210210 it "combines scoped and non-scoped layers" do

211211 log <- liftEffect $ Ref.new []

212212 let

213− scopedLayer :: OmLayer (scope :: Scope) (scoped :: String) ()

213+ scopedLayer :: OmLayer (scope :: Scope) (scoped :: String) () _

214214 scopedLayer = makeScopedLayer

215215 (pure { scoped: "yes" })

216216 (\_ -> liftEffect $ Ref.modify_ (_ <> [ "release-scoped" ]) log)

217217

218− plainLayer :: OmLayer () (plain :: String) ()

218+ plainLayer :: OmLayer () (plain :: String) () _

219219 plainLayer = makeLayer (pure { plain: "no-finalizer" })

220220

221221 combined = combineRequirements scopedLayer plainLayer

@@ -231,24 +231,24 @@ main = launchAff_ $ runSpec [ consoleReporter ] do

231231 it "builds a memoized layer only once even when used twice" do

232232 counter <- liftEffect $ Ref.new 0

233233 let

234− expensiveLayer :: OmLayer (scope :: Scope) (value :: String) ()

234+ expensiveLayer :: OmLayer (scope :: Scope) (value :: String) () _

235235 expensiveLayer = memoized (Proxy :: Proxy "expensive") $ makeLayer do

236236 liftEffect $ Ref.modify_ (_ + 1) counter

237237 pure { value: "built" }

238238

239239 -- Both branches independently provide expensiveLayer

240− branch1 :: OmLayer (scope :: Scope) (out1 :: String) ()

240+ branch1 :: OmLayer (scope :: Scope) (out1 :: String) () _

241241 branch1 = consumer1 `provide` expensiveLayer

242242 where

243− consumer1 :: OmLayer (scope :: Scope, value :: String) (out1 :: String) ()

243+ consumer1 :: OmLayer (scope :: Scope, value :: String) (out1 :: String) () _

244244 consumer1 = makeLayer do

245245 { value } <- Om.ask

246246 pure { out1: value <> "-1" }

247247

248− branch2 :: OmLayer (scope :: Scope) (out2 :: String) ()

248+ branch2 :: OmLayer (scope :: Scope) (out2 :: String) () _

249249 branch2 = consumer2 `provide` expensiveLayer

250250 where

251− consumer2 :: OmLayer (scope :: Scope, value :: String) (out2 :: String) ()

251+ consumer2 :: OmLayer (scope :: Scope, value :: String) (out2 :: String) () _

252252 consumer2 = makeLayer do

253253 { value } <- Om.ask

254254 pure { out2: value <> "-2" }

@@ -264,24 +264,24 @@ main = launchAff_ $ runSpec [ consoleReporter ] do

264264 it "memoized scoped layer runs finalizer only once" do

265265 log <- liftEffect $ Ref.new []

266266 let

267− dbLayer :: OmLayer (scope :: Scope) (db :: String) ()

267+ dbLayer :: OmLayer (scope :: Scope) (db :: String) () _

268268 dbLayer = memoized (Proxy :: Proxy "db") $ makeScopedLayer

269269 (pure { db: "connected" })

270270 (\_ -> liftEffect $ Ref.modify_ (_ <> [ "db-closed" ]) log)

271271

272272 -- Both branches independently provide dbLayer

273− repoBranch :: OmLayer (scope :: Scope) (repo :: String) ()

273+ repoBranch :: OmLayer (scope :: Scope) (repo :: String) () _

274274 repoBranch = repo `provide` dbLayer

275275 where

276− repo :: OmLayer (scope :: Scope, db :: String) (repo :: String) ()

276+ repo :: OmLayer (scope :: Scope, db :: String) (repo :: String) () _

277277 repo = makeLayer do

278278 { db } <- Om.ask

279279 pure { repo: db <> "-repo" }

280280

281− analyticsBranch :: OmLayer (scope :: Scope) (analytics :: String) ()

281+ analyticsBranch :: OmLayer (scope :: Scope) (analytics :: String) () _

282282 analyticsBranch = analytics `provide` dbLayer

283283 where

284− analytics :: OmLayer (scope :: Scope, db :: String) (analytics :: String) ()

284+ analytics :: OmLayer (scope :: Scope, db :: String) (analytics :: String) () _

285285 analytics = makeLayer do

286286 { db } <- Om.ask

287287 pure { analytics: db <> "-analytics" }