ENH remove currentTitle from state transformer
This commit is contained in:
parent
08e3d39ce5
commit
a8e0dca368
34
app/Main.hs
34
app/Main.hs
|
@ -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 ()
|
||||||
|
|
Loading…
Reference in New Issue