summaryrefslogtreecommitdiff
path: root/src/Service.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Service.hs')
-rw-r--r--src/Service.hs6
1 files changed, 6 insertions, 0 deletions
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 }