summaryrefslogtreecommitdiff
path: root/src/Service.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2021-12-21 22:36:58 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2021-12-21 22:47:45 +0100
commited2fd1bf1f2e24565530bcfc9853cacbfa1c2a2a (patch)
tree56b1c4cf414fcc9427ead5f030c8b7081574141e /src/Service.hs
parent8416b3e959fd0f6ade7c2b61a6caea681ee03e15 (diff)
Network: external interface to run service handlers
Diffstat (limited to 'src/Service.hs')
-rw-r--r--src/Service.hs10
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)