From 2903fd39c39357168a7cbb8b6821a0c99ed1e5a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Sun, 26 Dec 2021 22:22:34 +0100 Subject: Generalize local state helper functions --- src/Service.hs | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'src/Service.hs') diff --git a/src/Service.hs b/src/Service.hs index 0942159..1d506aa 100644 --- a/src/Service.hs +++ b/src/Service.hs @@ -110,6 +110,12 @@ data ServiceHandlerState s = ServiceHandlerState newtype ServiceHandler s a = ServiceHandler (ReaderT (ServiceInput s) (WriterT [ServiceReply s] (StateT (ServiceHandlerState s) (ExceptT String IO))) a) deriving (Functor, Applicative, Monad, MonadReader (ServiceInput s), MonadWriter [ServiceReply s], MonadState (ServiceHandlerState s), MonadError String, MonadIO) +instance MonadHead LocalState (ServiceHandler s) where + updateLocalHead f = do + (ls, x) <- liftIO . f =<< gets svcLocal + modify $ \s -> s { svcLocal = ls } + return x + 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 } -- cgit v1.2.3