diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2021-12-21 22:36:58 +0100 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2021-12-21 22:47:45 +0100 |
commit | ed2fd1bf1f2e24565530bcfc9853cacbfa1c2a2a (patch) | |
tree | 56b1c4cf414fcc9427ead5f030c8b7081574141e /src/Service.hs | |
parent | 8416b3e959fd0f6ade7c2b61a6caea681ee03e15 (diff) |
Network: external interface to run service handlers
Diffstat (limited to 'src/Service.hs')
-rw-r--r-- | src/Service.hs | 10 |
1 files changed, 5 insertions, 5 deletions
diff --git a/src/Service.hs b/src/Service.hs index 90fd34a..0942159 100644 --- a/src/Service.hs +++ b/src/Service.hs @@ -8,7 +8,7 @@ module Service ( ServiceHandler, ServiceInput(..), ServiceReply(..), - handleServicePacket, + runServiceHandler, svcGet, svcSet, svcModify, svcGetGlobal, svcSetGlobal, svcModifyGlobal, @@ -110,10 +110,10 @@ 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) -handleServicePacket :: Service s => Head LocalState -> ServiceInput s -> ServiceState s -> ServiceGlobalState s -> Stored s -> IO ([ServiceReply s], (ServiceState s, ServiceGlobalState s)) -handleServicePacket h input svc global packet = do +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 } - ServiceHandler handler = serviceHandler packet + ServiceHandler handler = shandler (runExceptT $ flip runStateT sstate $ execWriterT $ flip runReaderT input $ handler) >>= \case Left err -> do svcPrintOp input $ "service failed: " ++ err @@ -121,7 +121,7 @@ handleServicePacket h input svc global packet = do Right (rsp, sstate') | svcLocal sstate' == svcLocal sstate -> return (rsp, (svcValue sstate', svcGlobal sstate')) | otherwise -> replaceHead h (svcLocal sstate') >>= \case - Left (Just h') -> handleServicePacket h' input svc global packet + Left (Just h') -> runServiceHandler h' input svc global shandler _ -> return (rsp, (svcValue sstate', svcGlobal sstate')) svcGet :: ServiceHandler s (ServiceState s) |