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

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

on main help sign in

Add memoized combinator with Symbol-keyed cache in Scope

40bc3b4Mark8 months ago

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

compare with main

unifiedsplit

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

14 , combineRequirements

15 , provide

16 , (>->)

17+ , class CheckMemoKeys

18+ , class CheckMemoKeysList

19+ , class CheckKeyNotDuplicated

17 , class CheckAllProvided

20 , class CheckAllProvided

18 , class CheckAllLabelsExist

21 , class CheckAllLabelsExist

19 , class CheckLabelExists

22 , class CheckLabelExists

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

85-- OmLayer

88-- OmLayer

86-- =============================================================================

89-- =============================================================================

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

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

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

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

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

91-- =============================================================================

95-- =============================================================================

92-- Layer constructors

96-- Layer constructors

93-- =============================================================================

97-- =============================================================================

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

99-- | 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 ()

97makeLayer = OmLayer

101makeLayer = OmLayer

102

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

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

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

103 :: forall req prov err

107 :: forall req prov err

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

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

105 -> (Record prov -> Aff Unit)

109 -> (Record prov -> Aff Unit)

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

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

107makeScopedLayer acquire release = makeLayer do

111makeScopedLayer acquire release = makeLayer do

108 acquireRelease acquire release

112 acquireRelease acquire release

109

113

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

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

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

115 -> (resource -> Aff Unit)

119 -> (resource -> Aff Unit)

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

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

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

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

118bracketLayer acquire release use = makeLayer do

122bracketLayer acquire release use = makeLayer do

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

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

120 use resource

124 use resource

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

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

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

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

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

139memoized

143memoized

140− :: forall sym req prov err

144+ :: forall sym req prov err memo

141 . IsSymbol sym

145 . IsSymbol sym

142 => Proxy sym

146 => Proxy sym

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

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

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

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

145memoized _ (OmLayer om) = OmLayer do

149memoized _ (OmLayer om) = OmLayer do

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

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

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

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

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

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

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

154 pure prov

158 pure prov

155

159

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+

156-- =============================================================================

192-- =============================================================================

157-- Custom Type Errors for Missing Dependencies

193-- Custom Type Errors for Missing Dependencies

158-- =============================================================================

194-- =============================================================================

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

229

265

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

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

231runLayer

267runLayer

232− :: forall req prov err available

268+ :: forall req prov err available memo

233 . CheckAllProvided req available

269 . CheckAllProvided req available

234 => Record available

270 => Record available

235− -> OmLayer req prov err

271+ -> OmLayer req prov err memo

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

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

237runLayer _ctx (OmLayer om) = widenCtx om

273runLayer _ctx (OmLayer om) = widenCtx om

238 where

274 where

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

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

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

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

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

244runScoped

280runScoped

245− :: forall prov

281+ :: forall prov memo

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

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

247 -> Aff (Record prov)

283 -> Aff (Record prov)

248runScoped layer = withScoped layer pure

284runScoped layer = withScoped layer pure

249

285

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

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

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

253-- | or interruption.

289-- | or interruption.

254withScoped

290withScoped

255− :: forall prov a

291+ :: forall prov a memo

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

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

257 -> (Record prov -> Aff a)

293 -> (Record prov -> Aff a)

258 -> Aff a

294 -> Aff a

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

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

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

270-- =============================================================================

306-- =============================================================================

271

307

272combineRequirements

308combineRequirements

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

274 . Union req1 req2 reqMerged

310 . Union req1 req2 reqMerged

275 => Nub reqMerged reqDeduped

311 => Nub reqMerged reqDeduped

276 => Union req1 _req1 reqDeduped

312 => Union req1 _req1 reqDeduped

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

279 => Union err2 _err2 ()

315 => Union err2 _err2 ()

280 => Union prov1 prov2 provMergedRaw

316 => Union prov1 prov2 provMergedRaw

281 => Nub provMergedRaw provMerged

317 => Nub provMergedRaw provMerged

318+ => Union memo1 memo2 memoMerged

319+ => CheckMemoKeys memoMerged

320+ => Nub memoMerged memoDeduped

282 => Keys req1

321 => Keys req1

283 => Keys req2

322 => Keys req2

284− => OmLayer req1 prov1 err1

323+ => OmLayer req1 prov1 err1 memo1

285− -> OmLayer req2 prov2 err2

324+ -> OmLayer req2 prov2 err2 memo2

286− -> OmLayer reqDeduped provMerged ()

325+ -> OmLayer reqDeduped provMerged () memoDeduped

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

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

288 rec1 <- Om.expand build1

327 rec1 <- Om.expand build1

289 rec2 <- Om.expand build2

328 rec2 <- Om.expand build2

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

294-- =============================================================================

333-- =============================================================================

295

334

296provide

335provide

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

298 . Union req _req req

337 . Union req _req req

299 => Union prov1 _prov1 prov1

338 => Union prov1 _prov1 prov1

300 => Union err1 _err1 ()

339 => Union err1 _err1 ()

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

302 => Union prov1 req reqOut

341 => Union prov1 req reqOut

303 => Nub reqOut reqOut

342 => Nub reqOut reqOut

304 => Union req2 _prov1 reqOut

343 => Union req2 _prov1 reqOut

344+ => Union memo1 memo2 memoMerged

345+ => CheckMemoKeys memoMerged

346+ => Nub memoMerged memoDeduped

305 => Keys req

347 => Keys req

306 => Keys prov1

348 => Keys prov1

307 => Keys req2

349 => Keys req2

308− => OmLayer req2 prov2 err2

350+ => OmLayer req2 prov2 err2 memo2

309− -> OmLayer req prov1 err1

351+ -> OmLayer req prov1 err1 memo1

310− -> OmLayer req prov2 ()

352+ -> OmLayer req prov2 () memoDeduped

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

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

312 prov1 <- Om.expand layer1

354 prov1 <- Om.expand layer1

313 Om.expand layer2 # Om.widenCtx prov1

355 Om.expand layer2 # Om.widenCtx prov1

test/Playground.purs+4−4

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

25type CacheL_ = CacheL ()

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

28−loggerLayer :: OmLayer ConfigL_ LoggerL_ ()

28+loggerLayer :: OmLayer ConfigL_ LoggerL_ () _

29loggerLayer = makeLayer do

30 { config } <- Om.ask

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

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

34−databaseLayer :: OmLayer ConfigL_ DatabaseL_ ()

34+databaseLayer :: OmLayer ConfigL_ DatabaseL_ () _

35databaseLayer = makeLayer do

36 { config } <- Om.ask

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

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

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

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

41cacheLayer = makeLayer do

42 { logger, database } <- Om.ask

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

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

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

46programLayer = makeLayer do

47 pure {}

test/Test/Main.purs+23−23

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

30 -- Define layers with dependencies

31 let

32 -- Layer that requires config

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

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

34 loggerLayer = makeLayer do

35 { config } <- Om.ask

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

38 -- Layer that also requires config

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

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

40 databaseLayer = makeLayer do

41 { config } <- Om.ask

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

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

47 let

48 -- The type annotation proves deduplication works:

49 _proofOfDeduplication

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

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

51 _proofOfDeduplication = combineRequirements loggerLayer databaseLayer

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

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

78 let

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

80 -- 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) () _

82 combinedLayer = makeLayer do

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

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

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

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

132 log <- liftEffect $ Ref.new []

133 let

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

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

135 layerA = makeScopedLayer

136 (pure { a: "A" })

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

138

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

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

140 layerB = makeScopedLayer

141 (pure { b: "B" })

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

143

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

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

145 layerC = makeScopedLayer

146 (pure { c: "C" })

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

148

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

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

150 layerBC = combineRequirements layerB layerC

151

152 combined = combineRequirements layerA layerBC

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

158 it "runs finalizers when the callback throws" do

159 log <- liftEffect $ Ref.new []

160 let

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

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

162 layer = makeScopedLayer

163 (pure { value: "acquired" })

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

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

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

172 log <- liftEffect $ Ref.new []

173 let

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

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

175 baseLayer = makeScopedLayer

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

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

178

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

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

180 upperLayer = makeScopedLayer

181 ( do

182 { base } <- Om.ask

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

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

211 log <- liftEffect $ Ref.new []

212 let

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

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

214 scopedLayer = makeScopedLayer

215 (pure { scoped: "yes" })

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

217

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

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

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

220

221 combined = combineRequirements scopedLayer plainLayer

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

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

232 counter <- liftEffect $ Ref.new 0

233 let

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

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

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

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

237 pure { value: "built" }

238

239 -- Both branches independently provide expensiveLayer

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

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

241 branch1 = consumer1 `provide` expensiveLayer

242 where

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

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

244 consumer1 = makeLayer do

245 { value } <- Om.ask

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

247

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

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

249 branch2 = consumer2 `provide` expensiveLayer

250 where

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

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

252 consumer2 = makeLayer do

253 { value } <- Om.ask

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

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

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

265 log <- liftEffect $ Ref.new []

266 let

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

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

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

269 (pure { db: "connected" })

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

271

272 -- Both branches independently provide dbLayer

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

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

274 repoBranch = repo `provide` dbLayer

275 where

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

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

277 repo = makeLayer do

278 { db } <- Om.ask

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

280

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

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

282 analyticsBranch = analytics `provide` dbLayer

283 where

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

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

285 analytics = makeLayer do

286 { db } <- Om.ask

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