From baa678abb2d355779c3184b7302e1c00a0498829 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Fri, 14 Aug 2026 22:36:43 +0200
Subject: Track LocalState cache in Service state

---
 src/Erebos/Service.hs | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

(limited to 'src/Erebos/Service.hs')

diff --git a/src/Erebos/Service.hs b/src/Erebos/Service.hs
index 303f9db..a5b1370 100644
--- a/src/Erebos/Service.hs
+++ b/src/Erebos/Service.hs
@@ -134,6 +134,7 @@ data ServiceHandlerState s = ServiceHandlerState
     { svcValue :: ServiceState s
     , svcGlobal :: ServiceGlobalState s
     , svcLocal :: Stored LocalState
+    , svcLocalCache :: HeadCacheType LocalState
     }
 
 newtype ServiceHandler s a = ServiceHandler (ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT ErebosError IO))) a)
@@ -144,13 +145,17 @@ instance MonadStorage (ServiceHandler s) where
 
 instance MonadHead LocalState (ServiceHandler s) where
     updateLocalHead f = do
-        (ls, x) <- f =<< gets svcLocal
-        modify $ \s -> s { svcLocal = ls }
+        ls <- gets svcLocal
+        c <- gets svcLocalCache
+        ( ls', x ) <- f ls
+        let c' = headCacheUpdate ls' c
+        modify $ \s -> s { svcLocal = ls', svcLocalCache = c' }
         return x
+    getLocalHeadCache _ = gets svcLocalCache
 
 runServiceHandler :: Service s => Head LocalState -> ServiceInput s -> ServiceState s -> ServiceGlobalState s -> ServiceHandler s () -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s))
 runServiceHandler h input svc global shandler = do
-    let sstate = ServiceHandlerState { svcValue = svc, svcGlobal = global, svcLocal = headStoredObject h }
+    let sstate = ServiceHandlerState { svcValue = svc, svcGlobal = global, svcLocal = headStoredObject h, svcLocalCache = headCache h }
         ServiceHandler handler = shandler
     (runExceptT $ flip runStateT sstate $ execWriterT $ flip runReaderT input $ handler) >>= \case
         Left err -> do
-- 
cgit v1.2.3