{-# LANGUAGE ScopedTypeVariables #-}
module XMonad.Hooks.XPropManage (
xPropManageHook, XPropMatch, pmX, pmP
) where
import Control.Exception as E
import Control.Monad.Trans (lift)
import XMonad
import XMonad.Prelude (Endo (..), chr)
type XPropMatch = ([(Atom, [String] -> Bool)], Window -> X (WindowSet -> WindowSet))
pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet)
pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet)
pmX Window -> X ()
f Window
w = Window -> X ()
f Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id
pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet)
pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet)
pmP WindowSet -> WindowSet
f Window
_ = forall (m :: * -> *) a. Monad m => a -> m a
return WindowSet -> WindowSet
f
xPropManageHook :: [XPropMatch] -> ManageHook
xPropManageHook :: [XPropMatch] -> ManageHook
xPropManageHook [XPropMatch]
tms = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {t :: * -> *} {a}.
Traversable t =>
(t (Window, [String] -> Bool), Window -> X (a -> a))
-> Query (Endo a)
propToHook [XPropMatch]
tms
where
propToHook :: (t (Window, [String] -> Bool), Window -> X (a -> a))
-> Query (Endo a)
propToHook (t (Window, [String] -> Bool)
ms, Window -> X (a -> a)
f) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {b}. (Window, [String] -> b) -> Query b
mkQuery t (Window, [String] -> Bool)
ms) forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> forall {a}. (Window -> X (a -> a)) -> Query (Endo a)
mkHook Window -> X (a -> a)
f
mkQuery :: (Window, [String] -> b) -> Query b
mkQuery (Window
a, [String] -> b
tf) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> b
tf (Window -> Query [String]
getQuery Window
a)
mkHook :: (Window -> X (a -> a)) -> Query (Endo a)
mkHook Window -> X (a -> a)
func = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. ReaderT Window X a -> Query a
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (a -> a) -> Endo a
Endo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> X (a -> a)
func
getProp :: Display -> Window -> Atom -> X [String]
getProp :: Display -> Window -> Window -> X [String]
getProp Display
d Window
w Window
p = do
[String]
prop <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Display -> Window -> Window -> IO TextProperty
getTextProperty Display
d Window
w Window
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Display -> TextProperty -> IO [String]
wcTextPropertyToTextList Display
d) (\(IOException
_ :: IOException) -> forall (m :: * -> *) a. Monad m => a -> m a
return [[]])
let filt :: Window -> [String] -> [String]
filt Window
q | Window
q forall a. Eq a => a -> a -> Bool
== Window
wM_COMMAND = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [String]
splitAtNull
| Bool
otherwise = forall a. a -> a
id
forall (m :: * -> *) a. Monad m => a -> m a
return (Window -> [String] -> [String]
filt Window
p [String]
prop)
getQuery :: Atom -> Query [String]
getQuery :: Window -> Query [String]
getQuery Window
p = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> forall a. ReaderT Window X a -> Query a
Query forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> Display -> Window -> Window -> X [String]
getProp Display
d Window
w Window
p
splitAtNull :: String -> [String]
splitAtNull :: String -> [String]
splitAtNull String
s = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Int -> Char
chr Int
0) String
s of
String
"" -> []
String
s' -> String
w forall a. a -> [a] -> [a]
: String -> [String]
splitAtNull String
s''
where (String
w, String
s'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Int -> Char
chr Int
0) String
s'