ENH generalize screensaver
This commit is contained in:
parent
7821140dc2
commit
39bd464ca1
|
@ -82,8 +82,9 @@ ruleCurrentState =
|
||||||
, matchMember = Just memState
|
, matchMember = Just memState
|
||||||
}
|
}
|
||||||
|
|
||||||
emitState :: Client -> SSState -> IO ()
|
emitState :: MonadUnliftIO m => Client -> SSState -> m ()
|
||||||
emitState client sss = emit client $ sigCurrentState {signalBody = [toVariant sss]}
|
emitState client sss =
|
||||||
|
liftIO $ emit client $ sigCurrentState {signalBody = [toVariant sss]}
|
||||||
|
|
||||||
bodyGetCurrentState :: [Variant] -> Maybe SSState
|
bodyGetCurrentState :: [Variant] -> Maybe SSState
|
||||||
bodyGetCurrentState [b] = fromVariant b :: Maybe SSState
|
bodyGetCurrentState [b] = fromVariant b :: Maybe SSState
|
||||||
|
@ -105,7 +106,7 @@ exportScreensaver ses =
|
||||||
defaultInterface
|
defaultInterface
|
||||||
{ interfaceName = interface
|
{ interfaceName = interface
|
||||||
, interfaceMethods =
|
, interfaceMethods =
|
||||||
[ autoMethod memToggle $ emitState cl' =<< toggle
|
[ autoMethod memToggle $ run $ emitState cl' =<< toggle
|
||||||
, autoMethod memQuery (run query)
|
, autoMethod memQuery (run query)
|
||||||
]
|
]
|
||||||
, interfaceSignals = [sig]
|
, interfaceSignals = [sig]
|
||||||
|
@ -134,12 +135,12 @@ callToggle =
|
||||||
interface
|
interface
|
||||||
memToggle
|
memToggle
|
||||||
|
|
||||||
callQuery :: SesClient -> IO (Maybe SSState)
|
callQuery :: MonadUnliftIO m => SesClient -> m (Maybe SSState)
|
||||||
callQuery ses = do
|
callQuery ses = do
|
||||||
reply <- callMethod ses xmonadBusName ssPath interface memQuery
|
reply <- callMethod ses xmonadBusName ssPath interface memQuery
|
||||||
return $ either (const Nothing) bodyGetCurrentState reply
|
return $ either (const Nothing) bodyGetCurrentState reply
|
||||||
|
|
||||||
matchSignal :: (Maybe SSState -> IO ()) -> SesClient -> IO ()
|
matchSignal :: MonadUnliftIO m => (Maybe SSState -> m ()) -> SesClient -> m ()
|
||||||
matchSignal cb ses =
|
matchSignal cb ses =
|
||||||
void $
|
void $
|
||||||
addMatchCallback
|
addMatchCallback
|
||||||
|
|
Loading…
Reference in New Issue