{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.RemoteWindows
-- Description :  A module to find out whether the window is remote or local.
-- Copyright   :  (c) Anton Vorontsov <anton@enomsg.org> 2014
-- License     :  BSD-style (as xmonad)
--
-- Maintainer  :  Anton Vorontsov <anton@enomsg.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module implements a proper way of finding out whether the window
-- is remote or local.
--
-- Just checking for a hostname and WM_CLIENT_MACHINE being equal is often
-- not enough because the hostname is a changing subject (without any
-- established notification mechanisms), and thus WM_CLIENT_MACHINE and
-- the hostname can diverge even for a local window.
--
-- This module solves the problem. As soon as there is a new window
-- created, we check the hostname and WM_CLIENT_MACHINE, and then we cache
-- the result into the XMONAD_REMOTE property.
--
-- Notice that XMonad itself does not know anything about hostnames, nor
-- does it have any dependency on Network.* modules. For this module it is
-- not a problem: you can provide a mean to get the hostname through your
-- config file (see usage). Or, if you don't like the hassle of handling
-- dynamic hostnames (suppose your hostname never changes), it is also
-- fine: this module will fallback to using environment variables.
--
-----------------------------------------------------------------------------

module XMonad.Util.RemoteWindows
    ( -- $usage
      isLocalWindow
    , manageRemote
    , manageRemoteG
    ) where

import XMonad
import XMonad.Util.WindowProperties
import XMonad.Prelude
import System.Posix.Env

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Util.RemoteWindows
-- > import Network.BSD
-- >
-- > main = xmonad def
-- >    { manageHook = manageRemote =<< io getHostName }

guessHostName :: IO String
guessHostName :: IO String
guessHostName = [Maybe String] -> String
forall {a}. [Maybe [a]] -> [a]
pickOneMaybe ([Maybe String] -> String) -> IO [Maybe String] -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Maybe String)
getEnv (String -> IO (Maybe String)) -> [String] -> IO [Maybe String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` [String]
vars)
  where
    pickOneMaybe :: [Maybe [a]] -> [a]
pickOneMaybe = [[a]] -> [a]
forall a. HasCallStack => [a] -> a
last ([[a]] -> [a]) -> ([Maybe [a]] -> [[a]]) -> [Maybe [a]] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a]
forall a. [a]
forall (m :: * -> *) a. MonadPlus m => m a
mzero[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:) ([[a]] -> [[a]]) -> ([Maybe [a]] -> [[a]]) -> [Maybe [a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[a]] -> [[a]]
forall a. Int -> [a] -> [a]
take Int
1 ([[a]] -> [[a]]) -> ([Maybe [a]] -> [[a]]) -> [Maybe [a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe [a]] -> [[a]]
forall a. [Maybe a] -> [a]
catMaybes
    vars :: [String]
vars = [String
"XAUTHLOCALHOSTNAME",String
"HOST",String
"HOSTNAME"]

setRemoteProp :: Window -> String -> X ()
setRemoteProp :: Window -> String -> X ()
setRemoteProp Window
w String
host = do
    Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
    Window
p <- String -> X Window
getAtom String
"XMONAD_REMOTE"
    Bool
v <- Property -> Window -> X Bool
hasProperty (String -> Property
Machine String
host) Window
w
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> Window -> CInt -> [CLong] -> IO ()
changeProperty32 Display
d Window
w Window
p Window
cARDINAL CInt
propModeReplace
                          [Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CLong) -> (Bool -> Int) -> Bool -> CLong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool -> CLong) -> Bool -> CLong
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
v]

-- | Given a window, tell if it is a local or a remote process. Normally,
-- it checks XMONAD_REMOTE property. If it does not exist (i.e. the
-- manageRemote hook was not deployed in user's config), it falls back to
-- checking environment variables and assuming that hostname never
-- changes.
isLocalWindow :: Window -> X Bool
isLocalWindow :: Window -> X Bool
isLocalWindow Window
w = String -> Window -> X (Maybe [CLong])
getProp32s String
"XMONAD_REMOTE" Window
w X (Maybe [CLong]) -> (Maybe [CLong] -> X Bool) -> X Bool
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just [CLong
y] -> Bool -> X Bool
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X Bool) -> Bool -> X Bool
forall a b. (a -> b) -> a -> b
$ CLong
y CLong -> CLong -> Bool
forall a. Eq a => a -> a -> Bool
== CLong
0
    Maybe [CLong]
_ -> IO String -> X String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO String
guessHostName X String -> (String -> X Bool) -> X Bool
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
host -> Property -> Window -> X Bool
hasProperty (String -> Property
Machine String
host) Window
w

-- | Use this hook to let XMonad properly track remote/local windows. For
-- example, @manageHook = manageRemote =<< io getHostName@.
manageRemote :: String -> ManageHook
manageRemote :: String -> ManageHook
manageRemote String
host = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> ManageHook) -> ManageHook
forall a b. Query a -> (a -> Query b) -> Query b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> X () -> Query ()
forall a. X a -> Query a
liftX (Window -> String -> X ()
setRemoteProp Window
w String
host) Query () -> ManageHook -> ManageHook
forall a b. Query a -> Query b -> Query b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Endo WindowSet -> ManageHook
forall a. a -> Query a
forall (m :: * -> *) a. Monad m => a -> m a
return Endo WindowSet
forall a. Monoid a => a
mempty

-- | Use this hook if you want to manage XMONAD_REMOTE properties, but
-- don't want to use an external getHostName in your config. That way you
-- are retreating to environment variables.
manageRemoteG :: ManageHook
manageRemoteG :: ManageHook
manageRemoteG = String -> ManageHook
manageRemote (String -> ManageHook) -> Query String -> ManageHook
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String -> Query String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO String
guessHostName