From dc8be3ac86b92c791b398559d5f1132121d0e7ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 16 Aug 2026 09:10:09 +0200 Subject: Keep updated LocalState head in Server object --- src/Erebos/Service.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'src/Erebos/Service.hs') diff --git a/src/Erebos/Service.hs b/src/Erebos/Service.hs index 75551eb..dcc3df5 100644 --- a/src/Erebos/Service.hs +++ b/src/Erebos/Service.hs @@ -155,19 +155,24 @@ instance MonadHead LocalState (ServiceHandler s) where 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 + :: Service s + => Head LocalState -> ServiceInput s -> ServiceState s -> ServiceGlobalState s + -> ServiceHandler s () + -> IO ( [ ServiceReply s], ( ServiceState s, ServiceGlobalState s, Head LocalState ) ) runServiceHandler h input svc global shandler = do 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 svcPrintOp input $ "service failed: " ++ showErebosError err - return ([], (svc, global)) + return ( [], ( svc, global, h ) ) Right (rsp, sstate') - | svcLocal sstate' == svcLocal sstate -> return (rsp, (svcValue sstate', svcGlobal sstate')) + | svcLocal sstate' == svcLocal sstate -> return ( rsp, ( svcValue sstate', svcGlobal sstate', h )) | otherwise -> replaceHead h (svcLocal sstate') >>= \case Left (Just h') -> runServiceHandler h' input svc global shandler - _ -> return (rsp, (svcValue sstate', svcGlobal sstate')) + Left Nothing -> return ( rsp, ( svcValue sstate', svcGlobal sstate', h ) ) + Right h' -> return ( rsp, ( svcValue sstate', svcGlobal sstate', h' ) ) svcGet :: ServiceHandler s (ServiceState s) svcGet = gets svcValue -- cgit v1.2.3