ENH use rio logger for eventhook
This commit is contained in:
parent
335fa7b460
commit
89eacd63aa
|
@ -136,7 +136,7 @@ run = do
|
||||||
, modMask = myModMask
|
, modMask = myModMask
|
||||||
, layoutHook = myLayouts tt
|
, layoutHook = myLayouts tt
|
||||||
, manageHook = myManageHook dws
|
, manageHook = myManageHook dws
|
||||||
, handleEventHook = myEventHook ha
|
, handleEventHook = myEventHook runIO ha
|
||||||
, startupHook = myStartupHook
|
, startupHook = myStartupHook
|
||||||
, workspaces = myWorkspaces
|
, workspaces = myWorkspaces
|
||||||
, logHook = myLoghook xmobarP
|
, logHook = myLoghook xmobarP
|
||||||
|
@ -625,20 +625,30 @@ manageApps dws =
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Eventhook configuration
|
-- Eventhook configuration
|
||||||
|
|
||||||
myEventHook :: (String -> X ()) -> Event -> X All
|
myEventHook
|
||||||
myEventHook handler = xMsgEventHook handler <+> handleEventHook def
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
|
=> (m () -> IO ())
|
||||||
|
-> (String -> X ())
|
||||||
|
-> Event
|
||||||
|
-> X All
|
||||||
|
myEventHook runIO handler = xMsgEventHook runIO handler <+> handleEventHook def
|
||||||
|
|
||||||
-- | React to ClientMessage events from concurrent threads
|
-- | React to ClientMessage events from concurrent threads
|
||||||
xMsgEventHook :: (String -> X ()) -> Event -> X All
|
xMsgEventHook
|
||||||
xMsgEventHook handler ClientMessageEvent {ev_message_type = t, ev_data = d}
|
:: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
|
||||||
|
=> (m () -> IO ())
|
||||||
|
-> (String -> X ())
|
||||||
|
-> Event
|
||||||
|
-> X All
|
||||||
|
xMsgEventHook runIO handler ClientMessageEvent {ev_message_type = t, ev_data = d}
|
||||||
| t == bITMAP = do
|
| t == bITMAP = do
|
||||||
let (xtype, tag) = splitXMsg d
|
let (xtype, tag) = splitXMsg d
|
||||||
case xtype of
|
case xtype of
|
||||||
Workspace -> removeDynamicWorkspace tag
|
Workspace -> removeDynamicWorkspace tag
|
||||||
ACPI -> handler tag
|
ACPI -> handler tag
|
||||||
Unknown -> io $ putStrLn "WARNING: unknown concurrent message"
|
Unknown -> liftIO $ runIO $ logWarn "unknown concurrent message"
|
||||||
return (All True)
|
return (All True)
|
||||||
xMsgEventHook _ _ = return (All True)
|
xMsgEventHook _ _ _ = return (All True)
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- Keymap configuration
|
-- Keymap configuration
|
||||||
|
|
Loading…
Reference in New Issue