module XMonad.ManageHook where
import XMonad.Core
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME)
import Control.Exception (bracket, SomeException(..))
import qualified Control.Exception as E
import Control.Monad.Reader
import Data.Maybe
import Data.Monoid
import qualified XMonad.StackSet as W
import XMonad.Operations (floatLocation, reveal, isFixedSizeOrTransient)
liftX :: X a -> Query a
liftX :: forall a. X a -> Query a
liftX = 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
idHook :: Monoid m => m
idHook :: forall m. Monoid m => m
idHook = forall m. Monoid m => m
mempty
(<+>) :: Monoid m => m -> m -> m
<+> :: forall m. Monoid m => m -> m -> m
(<+>) = forall m. Monoid m => m -> m -> m
mappend
composeAll :: Monoid m => [m] -> m
composeAll :: forall m. Monoid m => [m] -> m
composeAll = forall m. Monoid m => [m] -> m
mconcat
infix 0 -->
(-->) :: (Monad m, Monoid a) => m Bool -> m a -> m a
m Bool
p --> :: forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> m a
f = m Bool
p forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> if Bool
b then m a
f else forall (m :: * -> *) a. Monad m => a -> m a
return forall m. Monoid m => m
mempty
(=?) :: Eq a => Query a -> a -> Query Bool
Query a
q =? :: forall a. Eq a => Query a -> a -> Query Bool
=? a
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
== a
x) Query a
q
infixr 3 <&&>, <||>
(<&&>) :: Monad m => m Bool -> m Bool -> m Bool
m Bool
x <&&> :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> m Bool
y = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
x m Bool
y (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
(<||>) :: Monad m => m Bool -> m Bool -> m Bool
m Bool
x <||> :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> m Bool
y = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
x (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) m Bool
y
title :: Query String
title :: Query WorkspaceId
title = 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. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ do
Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
let
getProp :: IO TextProperty
getProp =
(Display -> WorkspaceId -> Bool -> IO Window
internAtom Display
d WorkspaceId
"_NET_WM_NAME" Bool
False forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Display -> Window -> Window -> IO TextProperty
getTextProperty Display
d Window
w)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException e
_) -> Display -> Window -> Window -> IO TextProperty
getTextProperty Display
d Window
w Window
wM_NAME
extract :: TextProperty -> IO WorkspaceId
extract TextProperty
prop = do [WorkspaceId]
l <- Display -> TextProperty -> IO [WorkspaceId]
wcTextPropertyToTextList Display
d TextProperty
prop
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe WorkspaceId
"" forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe [WorkspaceId]
l
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO TextProperty
getProp (forall a. Ptr a -> IO CInt
xFree forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextProperty -> CString
tp_value) TextProperty -> IO WorkspaceId
extract forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return WorkspaceId
""
appName :: Query String
appName :: Query WorkspaceId
appName = 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. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClassHint -> WorkspaceId
resName forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ClassHint
getClassHint Display
d Window
w)
resource :: Query String
resource :: Query WorkspaceId
resource = Query WorkspaceId
appName
className :: Query String
className :: Query WorkspaceId
className = 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. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ClassHint -> WorkspaceId
resClass forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO ClassHint
getClassHint Display
d Window
w)
stringProperty :: String -> Query String
stringProperty :: WorkspaceId -> Query WorkspaceId
stringProperty WorkspaceId
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. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
d -> forall a. a -> Maybe a -> a
fromMaybe WorkspaceId
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Display -> Window -> WorkspaceId -> X (Maybe WorkspaceId)
getStringProperty Display
d Window
w WorkspaceId
p)
getStringProperty :: Display -> Window -> String -> X (Maybe String)
getStringProperty :: Display -> Window -> WorkspaceId -> X (Maybe WorkspaceId)
getStringProperty Display
d Window
w WorkspaceId
p = do
Window
a <- WorkspaceId -> X Window
getAtom WorkspaceId
p
Maybe [CChar]
md <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO (Maybe [CChar])
getWindowProperty8 Display
d Window
a Window
w
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral)) Maybe [CChar]
md
willFloat :: Query Bool
willFloat :: Query Bool
willFloat = 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. X a -> Query a
liftX 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 -> X Bool
isFixedSizeOrTransient Display
d Window
w
doF :: (s -> s) -> Query (Endo s)
doF :: forall s. (s -> s) -> Query (Endo s)
doF = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> Endo a
Endo
doFloat :: ManageHook
doFloat :: ManageHook
doFloat = 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 s. (s -> s) -> Query (Endo s)
doF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
W.float Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. X a -> Query a
liftX (Window -> X (ScreenId, RationalRect)
floatLocation Window
w)
doIgnore :: ManageHook
doIgnore :: ManageHook
doIgnore = 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. X a -> Query a
liftX (Window -> X ()
reveal Window
w) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. (s -> s) -> Query (Endo s)
doF (forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.delete Window
w)
doShift :: WorkspaceId -> ManageHook
doShift :: WorkspaceId -> ManageHook
doShift WorkspaceId
i = forall s. (s -> s) -> Query (Endo s)
doF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin WorkspaceId
i forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *). MonadReader r m => m r
ask