ENH remove currentTitle from state transformer

This commit is contained in:
Nathan Dwarshuis 2020-04-01 13:16:31 -04:00
parent 08e3d39ce5
commit a8e0dca368
1 changed files with 13 additions and 21 deletions

View File

@ -1,5 +1,6 @@
{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Xcape MANager (XMan) - a wrapper for managing xcape -- | Xcape MANager (XMan) - a wrapper for managing xcape
@ -23,6 +24,9 @@
-- will not be updated or restarted. Furthermore, it is outside the scope of -- will not be updated or restarted. Furthermore, it is outside the scope of
-- this program to bind multiple xcape mappings with multiple keymaps -- this program to bind multiple xcape mappings with multiple keymaps
-- TODO actually match the command associated with the window? Might be simpler
-- and more reliable since the title can be changed on the fly
module Main where module Main where
import Control.Monad (forM_, forever, void, when) import Control.Monad (forM_, forever, void, when)
@ -60,7 +64,6 @@ type WindowTitle = String
-- pass the xcape command. -- pass the xcape command.
-- --
-- The State portion holds the xcape process handle (so we can kill it later) -- The State portion holds the xcape process handle (so we can kill it later)
-- and the current window title.
newtype XMan a = XMan (ReaderT XMConf (StateT XMState IO) a) deriving newtype XMan a = XMan (ReaderT XMConf (StateT XMState IO) a) deriving
(Functor, Monad, MonadIO, MonadState XMState, MonadReader XMConf) (Functor, Monad, MonadIO, MonadState XMState, MonadReader XMConf)
@ -68,10 +71,7 @@ instance Applicative XMan where
pure = return pure = return
(<*>) = ap (<*>) = ap
data XMState = XMState newtype XMState = XMState { xcapeProcess :: Maybe ProcessHandle }
{ currentTitle :: Maybe WindowTitle
, xcapeProcess :: Maybe ProcessHandle
}
data XMConf = XMConf data XMConf = XMConf
{ display :: Display { display :: Display
@ -117,7 +117,7 @@ initXMan x r = do
, regexps = r , regexps = r
, xcapeKeys = x , xcapeKeys = x
} }
st = XMState { currentTitle = Nothing, xcapeProcess = Nothing } st = XMState { xcapeProcess = Nothing }
-- listen only for PropertyNotify events on the root window -- listen only for PropertyNotify events on the root window
allocaSetWindowAttributes $ \a -> do allocaSetWindowAttributes $ \a -> do
set_event_mask a propertyChangeMask set_event_mask a propertyChangeMask
@ -143,7 +143,7 @@ updateXCape = do
root <- asks theRoot root <- asks theRoot
prop <- io $ getWindowProperty32 dpy atom root prop <- io $ getWindowProperty32 dpy atom root
case prop of case prop of
Just [aw] -> getTitle aw >>= updateTitle >> startOrKillXCape Just [aw] -> getTitle aw >>= startOrKillXCape
_ -> return () _ -> return ()
-- | Given an event, call a handler. In this case the only thing we care about -- | Given an event, call a handler. In this case the only thing we care about
@ -194,20 +194,12 @@ permitBadWindow action = do
| fromIntegral t == badWindow = return () | fromIntegral t == badWindow = return ()
handleError _ = print "actual error" handleError _ = print "actual error"
-- | Given a window title that may exist, update the window title in XMan's -- | Given a window title that may exist, start or stop xcape given
-- state startOrKillXCape :: Maybe WindowTitle -> XMan ()
updateTitle :: Maybe WindowTitle -> XMan () startOrKillXCape = \case
updateTitle newTitle = modify (\s -> s { currentTitle = newTitle } ) Just title -> asks regexps >>= \rs ->
if any (title =~) rs then stopXCape else startXCape
-- | Start or stop xcape given the state in XMan Nothing -> startXCape
startOrKillXCape :: XMan ()
startOrKillXCape = do
-- TODO this is redundant
title <- gets currentTitle
case title of
Just t -> asks regexps >>= \r ->
if any (t =~) r then stopXCape else startXCape
Nothing -> startXCape
-- | Start xcape if it is not already running -- | Start xcape if it is not already running
startXCape :: XMan () startXCape :: XMan ()