diff options
Diffstat (limited to 'src/Service.hs')
| -rw-r--r-- | src/Service.hs | 15 |
1 files changed, 12 insertions, 3 deletions
diff --git a/src/Service.hs b/src/Service.hs index 667196d..f08a7a2 100644 --- a/src/Service.hs +++ b/src/Service.hs @@ -1,11 +1,12 @@ module Service ( Service(..), - SomeService(..), + SomeService(..), fromService, ServiceHandler, ServiceInput(..), ServiceState(..), handleServicePacket, + svcSet, svcPrint, ) where @@ -13,17 +14,22 @@ import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State +import Data.Typeable + import Identity import State import Storage -class Storable (ServicePacket s) => Service s where +class (Typeable s, Storable (ServicePacket s)) => Service s where type ServicePacket s :: * emptyServiceState :: s serviceHandler :: Stored (ServicePacket s) -> ServiceHandler s (Maybe (ServicePacket s)) data SomeService = forall s. Service s => SomeService s +fromService :: Service s => SomeService -> Maybe s +fromService (SomeService s) = cast s + data ServiceInput = ServiceInput { svcPeer :: UnifiedIdentity , svcPeerOwner :: UnifiedIdentity @@ -36,7 +42,7 @@ data ServiceState s = ServiceState } newtype ServiceHandler s a = ServiceHandler (ReaderT ServiceInput (StateT (ServiceState s) (ExceptT String IO)) a) - deriving (Functor, Applicative, Monad, MonadReader ServiceInput, MonadState (ServiceState s), MonadIO) + deriving (Functor, Applicative, Monad, MonadReader ServiceInput, MonadState (ServiceState s), MonadError String, MonadIO) handleServicePacket :: Service s => Storage -> ServiceInput -> s -> Stored (ServicePacket s) -> IO (Maybe (ServicePacket s), s) handleServicePacket st input svc packet = do @@ -54,5 +60,8 @@ handleServicePacket st input svc packet = do Left _ -> handleServicePacket st input svc packet Right _ -> return (rsp, svcValue sstate') +svcSet :: s -> ServiceHandler s () +svcSet x = modify $ \st -> st { svcValue = x } + svcPrint :: String -> ServiceHandler s () svcPrint str = liftIO . ($str) =<< asks svcPrintOp |