{-# OPTIONS_GHC -w #-}
{-# LANGUAGE CPP, NamedFieldPuns, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TupleSections, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.EWMH
-- Copyright   :  (c) Spencer Janssen
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- An experimental plugin to display EWMH pager information
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.EWMH (EWMH(..)) where

import Control.Applicative (Applicative(..))
import Control.Monad.State
import Control.Monad.Reader
import Graphics.X11 hiding (Modifier, Color)
import Graphics.X11.Xlib.Extras
import Xmobar.Run.Exec
import Codec.Binary.UTF8.String as UTF8
import Foreign.C (CChar, CLong)
import Xmobar.X11.Events (nextEvent')

import Data.List (intersperse, intercalate)

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Set (Set)
import qualified Data.Set as Set


data EWMH = EWMH | EWMHFMT Component deriving (ReadPrec [EWMH]
ReadPrec EWMH
Int -> ReadS EWMH
ReadS [EWMH]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EWMH]
$creadListPrec :: ReadPrec [EWMH]
readPrec :: ReadPrec EWMH
$creadPrec :: ReadPrec EWMH
readList :: ReadS [EWMH]
$creadList :: ReadS [EWMH]
readsPrec :: Int -> ReadS EWMH
$creadsPrec :: Int -> ReadS EWMH
Read, Int -> EWMH -> ShowS
[EWMH] -> ShowS
EWMH -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EWMH] -> ShowS
$cshowList :: [EWMH] -> ShowS
show :: EWMH -> String
$cshow :: EWMH -> String
showsPrec :: Int -> EWMH -> ShowS
$cshowsPrec :: Int -> EWMH -> ShowS
Show)

instance Exec EWMH where
    alias :: EWMH -> String
alias EWMH
EWMH = String
"EWMH"

    start :: EWMH -> (String -> IO ()) -> IO ()
start EWMH
ew String -> IO ()
cb = forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent forall a b. (a -> b) -> a -> b
$ \XEventPtr
ep -> forall a. M a -> IO a
execM forall a b. (a -> b) -> a -> b
$ do
        Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Display
display
        Window
r <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Window
root

        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
xSetErrorHandler

        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO ()
selectInput Display
d Window
r Window
propertyChangeMask
        [(Window, Updater)]
handlers' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(String
a, Updater
h) -> forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (String -> M Window
getAtom String
a) (forall (m :: * -> *) a. Monad m => a -> m a
return Updater
h)) [(String, Updater)]
handlers
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Window
root) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Window, Updater)]
handlers'

        forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
cb forall b c a. (b -> c) -> (a -> b) -> a -> c
. EWMH -> EwmhState -> String
fmtOf EWMH
ew forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> XEventPtr -> IO ()
nextEvent' Display
d XEventPtr
ep
            Event
e <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ XEventPtr -> IO Event
getEvent XEventPtr
ep
            case Event
e of
                PropertyEvent { ev_atom :: Event -> Window
ev_atom = Window
a, ev_window :: Event -> Window
ev_window = Window
w } ->
                    case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Window
a [(Window, Updater)]
handlers' of
                        Just Updater
f -> Updater
f Window
w
                        Maybe Updater
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

        forall (m :: * -> *) a. Monad m => a -> m a
return ()

defaultPP :: Component
defaultPP = Component -> [Component] -> Component
Sep (String -> Component
Text String
" : ") [ [WsOpt] -> Component
Workspaces [String -> String -> Modifier
Color String
"white" String
"black" Modifier -> WsType -> WsOpt
:% WsType
Current, Modifier
Hide Modifier -> WsType -> WsOpt
:% WsType
Empty]
                             , Component
Layout
                             , String -> String -> Modifier
Color String
"#00ee00" String
"" Modifier -> Component -> Component
:$ Int -> Modifier
Short Int
120 Modifier -> Component -> Component
:$ Component
WindowName]

fmtOf :: EWMH -> EwmhState -> String
fmtOf EWMH
EWMH = forall a b c. (a -> b -> c) -> b -> a -> c
flip EwmhState -> Component -> String
fmt Component
defaultPP
fmtOf (EWMHFMT Component
f) = forall a b c. (a -> b -> c) -> b -> a -> c
flip EwmhState -> Component -> String
fmt Component
f

sep :: [a] -> [[a]] -> [a]
sep :: forall a. [a] -> [[a]] -> [a]
sep [a]
x [[a]]
xs = forall a. [a] -> [[a]] -> [a]
intercalate [a]
x forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[a]]
xs

fmt :: EwmhState -> Component -> String
fmt :: EwmhState -> Component -> String
fmt EwmhState
e (Text String
s) = String
s
fmt EwmhState
e (Component
l :+ Component
r) = EwmhState -> Component -> String
fmt EwmhState
e Component
l forall a. [a] -> [a] -> [a]
++ EwmhState -> Component -> String
fmt EwmhState
e Component
r
fmt EwmhState
e (Modifier
m :$ Component
r) = Modifier -> ShowS
modifier Modifier
m forall a b. (a -> b) -> a -> b
$ EwmhState -> Component -> String
fmt EwmhState
e Component
r
fmt EwmhState
e (Sep Component
c [Component]
xs) = forall a. [a] -> [[a]] -> [a]
sep (EwmhState -> Component -> String
fmt EwmhState
e Component
c) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (EwmhState -> Component -> String
fmt EwmhState
e) [Component]
xs
fmt EwmhState
e Component
WindowName = Client -> String
windowName forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Client
initialClient (EwmhState -> Window
activeWindow EwmhState
e) (EwmhState -> Map Window Client
clients EwmhState
e)
fmt EwmhState
e Component
Layout = EwmhState -> String
layout EwmhState
e
fmt EwmhState
e (Workspaces [WsOpt]
opts) = forall a. [a] -> [[a]] -> [a]
sep String
" "
                            [forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (a -> b) -> a -> b
($) String
n [Modifier -> ShowS
modifier Modifier
m | (Modifier
m :% WsType
a) <- [WsOpt]
opts, WsType
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WsType]
as]
                                | (String
n, [WsType]
as) <- [(String, [WsType])]
attrs]
 where
    stats :: CLong -> [(WsType, Bool)]
stats CLong
i = [ (WsType
Current, CLong
i forall a. Eq a => a -> a -> Bool
== EwmhState -> CLong
currentDesktop EwmhState
e)
              , (WsType
Empty, forall a. Ord a => a -> Set a -> Bool
Set.notMember CLong
i Set CLong
nonEmptys Bool -> Bool -> Bool
&& CLong
i forall a. Eq a => a -> a -> Bool
/= EwmhState -> CLong
currentDesktop EwmhState
e)
              -- TODO for visible , (Visibl
              ]
    attrs :: [(String, [WsType])]
    attrs :: [(String, [WsType])]
attrs = [(String
n, [WsType
s | (WsType
s, Bool
b) <- CLong -> [(WsType, Bool)]
stats CLong
i, Bool
b]) | (CLong
i, String
n) <- forall a b. [a] -> [b] -> [(a, b)]
zip [CLong
0 ..] (EwmhState -> [String]
desktopNames EwmhState
e)]
    nonEmptys :: Set CLong
nonEmptys = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Client -> Set CLong
desktops forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ EwmhState -> Map Window Client
clients EwmhState
e

modifier :: Modifier -> String -> String
modifier :: Modifier -> ShowS
modifier Modifier
Hide = forall a b. a -> b -> a
const String
""
modifier (Color String
fg String
bg) = \String
x -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"<fc=", String
fg, if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
bg then String
"" else String
"," forall a. [a] -> [a] -> [a]
++ String
bg
                                      , String
">", String
x, String
"</fc>"]
modifier (Short Int
n) = forall a. Int -> [a] -> [a]
take Int
n
modifier (Wrap String
l String
r) = \String
x -> String
l forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
r

data Component = Text String
               | Component :+ Component
               | Modifier :$ Component
               | Sep Component [Component]
               | WindowName
               | Layout
               | Workspaces [WsOpt]
    deriving (ReadPrec [Component]
ReadPrec Component
Int -> ReadS Component
ReadS [Component]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Component]
$creadListPrec :: ReadPrec [Component]
readPrec :: ReadPrec Component
$creadPrec :: ReadPrec Component
readList :: ReadS [Component]
$creadList :: ReadS [Component]
readsPrec :: Int -> ReadS Component
$creadsPrec :: Int -> ReadS Component
Read, Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Show)

infixr 0 :$
infixr 5 :+

data Modifier = Hide
              | Color String String
              | Short Int
              | Wrap String String
    deriving (ReadPrec [Modifier]
ReadPrec Modifier
Int -> ReadS Modifier
ReadS [Modifier]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Modifier]
$creadListPrec :: ReadPrec [Modifier]
readPrec :: ReadPrec Modifier
$creadPrec :: ReadPrec Modifier
readList :: ReadS [Modifier]
$creadList :: ReadS [Modifier]
readsPrec :: Int -> ReadS Modifier
$creadsPrec :: Int -> ReadS Modifier
Read, Int -> Modifier -> ShowS
[Modifier] -> ShowS
Modifier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modifier] -> ShowS
$cshowList :: [Modifier] -> ShowS
show :: Modifier -> String
$cshow :: Modifier -> String
showsPrec :: Int -> Modifier -> ShowS
$cshowsPrec :: Int -> Modifier -> ShowS
Show)

data WsOpt = Modifier :% WsType
           | WSep Component
    deriving (ReadPrec [WsOpt]
ReadPrec WsOpt
Int -> ReadS WsOpt
ReadS [WsOpt]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WsOpt]
$creadListPrec :: ReadPrec [WsOpt]
readPrec :: ReadPrec WsOpt
$creadPrec :: ReadPrec WsOpt
readList :: ReadS [WsOpt]
$creadList :: ReadS [WsOpt]
readsPrec :: Int -> ReadS WsOpt
$creadsPrec :: Int -> ReadS WsOpt
Read, Int -> WsOpt -> ShowS
[WsOpt] -> ShowS
WsOpt -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WsOpt] -> ShowS
$cshowList :: [WsOpt] -> ShowS
show :: WsOpt -> String
$cshow :: WsOpt -> String
showsPrec :: Int -> WsOpt -> ShowS
$cshowsPrec :: Int -> WsOpt -> ShowS
Show)
infixr 0 :%

data WsType = Current | Empty | Visible
    deriving (ReadPrec [WsType]
ReadPrec WsType
Int -> ReadS WsType
ReadS [WsType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WsType]
$creadListPrec :: ReadPrec [WsType]
readPrec :: ReadPrec WsType
$creadPrec :: ReadPrec WsType
readList :: ReadS [WsType]
$creadList :: ReadS [WsType]
readsPrec :: Int -> ReadS WsType
$creadsPrec :: Int -> ReadS WsType
Read, Int -> WsType -> ShowS
[WsType] -> ShowS
WsType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WsType] -> ShowS
$cshowList :: [WsType] -> ShowS
show :: WsType -> String
$cshow :: WsType -> String
showsPrec :: Int -> WsType -> ShowS
$cshowsPrec :: Int -> WsType -> ShowS
Show, WsType -> WsType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WsType -> WsType -> Bool
$c/= :: WsType -> WsType -> Bool
== :: WsType -> WsType -> Bool
$c== :: WsType -> WsType -> Bool
Eq)

data EwmhConf  = C { EwmhConf -> Window
root :: Window
                   , EwmhConf -> Display
display :: Display }

data EwmhState = S { EwmhState -> CLong
currentDesktop :: CLong
                   , EwmhState -> Window
activeWindow :: Window
                   , EwmhState -> [String]
desktopNames :: [String]
                   , EwmhState -> String
layout :: String
                   , EwmhState -> Map Window Client
clients :: Map Window Client }
    deriving Int -> EwmhState -> ShowS
[EwmhState] -> ShowS
EwmhState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EwmhState] -> ShowS
$cshowList :: [EwmhState] -> ShowS
show :: EwmhState -> String
$cshow :: EwmhState -> String
showsPrec :: Int -> EwmhState -> ShowS
$cshowsPrec :: Int -> EwmhState -> ShowS
Show

data Client = Cl { Client -> String
windowName :: String
                 , Client -> Set CLong
desktops :: Set CLong }
    deriving Int -> Client -> ShowS
[Client] -> ShowS
Client -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Client] -> ShowS
$cshowList :: [Client] -> ShowS
show :: Client -> String
$cshow :: Client -> String
showsPrec :: Int -> Client -> ShowS
$cshowsPrec :: Int -> Client -> ShowS
Show

getAtom :: String -> M Atom
getAtom :: String -> M Window
getAtom String
s = do
    Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Display
display
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Window
internAtom Display
d String
s Bool
False

windowProperty32 :: String -> Window -> M (Maybe [CLong])
windowProperty32 :: String -> Window -> M (Maybe [CLong])
windowProperty32 String
s Window
w = do
    C {Display
display :: Display
display :: EwmhConf -> Display
display} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    Window
a <- String -> M Window
getAtom String
s
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO (Maybe [CLong])
getWindowProperty32 Display
display Window
a Window
w

windowProperty8 :: String -> Window -> M (Maybe [CChar])
windowProperty8 :: String -> Window -> M (Maybe [CChar])
windowProperty8 String
s Window
w = do
    C {Display
display :: Display
display :: EwmhConf -> Display
display} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    Window
a <- String -> M Window
getAtom String
s
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO (Maybe [CChar])
getWindowProperty8 Display
display Window
a Window
w

initialState :: EwmhState
initialState :: EwmhState
initialState = CLong
-> Window -> [String] -> String -> Map Window Client -> EwmhState
S CLong
0 Window
0 [] [] forall k a. Map k a
Map.empty

initialClient :: Client
initialClient :: Client
initialClient = String -> Set CLong -> Client
Cl String
"" forall a. Set a
Set.empty

handlers, clientHandlers :: [(String, Updater)]
handlers :: [(String, Updater)]
handlers = [ (String
"_NET_CURRENT_DESKTOP", Updater
updateCurrentDesktop)
           , (String
"_NET_DESKTOP_NAMES", Updater
updateDesktopNames )
           , (String
"_NET_ACTIVE_WINDOW", Updater
updateActiveWindow)
           , (String
"_NET_CLIENT_LIST", forall {p}. p -> M ()
updateClientList)
           ] forall a. [a] -> [a] -> [a]
++ [(String, Updater)]
clientHandlers

clientHandlers :: [(String, Updater)]
clientHandlers = [ (String
"_NET_WM_NAME", Updater
updateName)
                 , (String
"_NET_WM_DESKTOP", Updater
updateDesktop) ]

newtype M a = M (ReaderT EwmhConf (StateT EwmhState IO) a)
    deriving (Applicative M
forall a. a -> M a
forall a b. M a -> M b -> M b
forall a b. M a -> (a -> M b) -> M b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> M a
$creturn :: forall a. a -> M a
>> :: forall a b. M a -> M b -> M b
$c>> :: forall a b. M a -> M b -> M b
>>= :: forall a b. M a -> (a -> M b) -> M b
$c>>= :: forall a b. M a -> (a -> M b) -> M b
Monad, forall a b. a -> M b -> M a
forall a b. (a -> b) -> M a -> M b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> M b -> M a
$c<$ :: forall a b. a -> M b -> M a
fmap :: forall a b. (a -> b) -> M a -> M b
$cfmap :: forall a b. (a -> b) -> M a -> M b
Functor, Functor M
forall a. a -> M a
forall a b. M a -> M b -> M a
forall a b. M a -> M b -> M b
forall a b. M (a -> b) -> M a -> M b
forall a b c. (a -> b -> c) -> M a -> M b -> M c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. M a -> M b -> M a
$c<* :: forall a b. M a -> M b -> M a
*> :: forall a b. M a -> M b -> M b
$c*> :: forall a b. M a -> M b -> M b
liftA2 :: forall a b c. (a -> b -> c) -> M a -> M b -> M c
$cliftA2 :: forall a b c. (a -> b -> c) -> M a -> M b -> M c
<*> :: forall a b. M (a -> b) -> M a -> M b
$c<*> :: forall a b. M (a -> b) -> M a -> M b
pure :: forall a. a -> M a
$cpure :: forall a. a -> M a
Applicative, Monad M
forall a. IO a -> M a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> M a
$cliftIO :: forall a. IO a -> M a
MonadIO, MonadReader EwmhConf, MonadState EwmhState)

execM :: M a -> IO a
execM :: forall a. M a -> IO a
execM (M ReaderT EwmhConf (StateT EwmhState IO) a
m) = do
    Display
d <- String -> IO Display
openDisplay String
""
    Window
r <- Display -> ScreenNumber -> IO Window
rootWindow Display
d (Display -> ScreenNumber
defaultScreen Display
d)
    let conf :: EwmhConf
conf = Window -> Display -> EwmhConf
C Window
r Display
d
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT EwmhConf (StateT EwmhState IO) a
m (Window -> Display -> EwmhConf
C Window
r Display
d)) EwmhState
initialState

type Updater = Window -> M ()

updateCurrentDesktop, updateDesktopNames, updateActiveWindow :: Updater
updateCurrentDesktop :: Updater
updateCurrentDesktop Window
_ = do
    C {Window
root :: Window
root :: EwmhConf -> Window
root} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    Maybe [CLong]
mwp <- String -> Window -> M (Maybe [CLong])
windowProperty32 String
"_NET_CURRENT_DESKTOP" Window
root
    case Maybe [CLong]
mwp of
        Just [CLong
x] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EwmhState
s -> EwmhState
s { currentDesktop :: CLong
currentDesktop = CLong
x })
        Maybe [CLong]
_        -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

updateActiveWindow :: Updater
updateActiveWindow Window
_ = do
    C {Window
root :: Window
root :: EwmhConf -> Window
root} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    Maybe [CLong]
mwp <- String -> Window -> M (Maybe [CLong])
windowProperty32 String
"_NET_ACTIVE_WINDOW" Window
root
    case Maybe [CLong]
mwp of
        Just [CLong
x] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EwmhState
s -> EwmhState
s { activeWindow :: Window
activeWindow = forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
x })
        Maybe [CLong]
_        -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

updateDesktopNames :: Updater
updateDesktopNames Window
_ = do
    C {Window
root :: Window
root :: EwmhConf -> Window
root} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    Maybe [CChar]
mwp <- String -> Window -> M (Maybe [CChar])
windowProperty8 String
"_NET_DESKTOP_NAMES" Window
root
    case Maybe [CChar]
mwp of
        Just [CChar]
xs -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EwmhState
s -> EwmhState
s { desktopNames :: [String]
desktopNames = [CChar] -> [String]
parse [CChar]
xs })
        Maybe [CChar]
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
    dropNull :: ShowS
dropNull (Char
'\0':String
xs) = String
xs
    dropNull String
xs        = String
xs

    split :: String -> [String]
split []        = []
    split String
xs        = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'\0') String
xs of
                        (String
x, String
ys) -> String
x forall a. a -> [a] -> [a]
: String -> [String]
split (ShowS
dropNull String
ys)
    parse :: [CChar] -> [String]
parse = String -> [String]
split forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CChar] -> String
decodeCChar

updateClientList :: p -> M ()
updateClientList p
_ = do
    C {Window
root :: Window
root :: EwmhConf -> Window
root} <- forall r (m :: * -> *). MonadReader r m => m r
ask
    Maybe [CLong]
mwp <- String -> Window -> M (Maybe [CLong])
windowProperty32 String
"_NET_CLIENT_LIST" Window
root
    case Maybe [CLong]
mwp of
        Just [CLong]
xs -> do
                    Map Window Client
cl <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets EwmhState -> Map Window Client
clients
                    let cl' :: Map Window Client
cl' = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((, Client
initialClient) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) [CLong]
xs
                        dels :: Map Window Client
dels = forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map Window Client
cl Map Window Client
cl'
                        new :: Map Window Client
new = forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map Window Client
cl' Map Window Client
cl
                    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EwmhState
s -> EwmhState
s { clients :: Map Window Client
clients = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map Window Client
cl Map Window Client
cl') Map Window Client
cl'})
                    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {m :: * -> *}.
(MonadReader EwmhConf m, MonadIO m) =>
Window -> m ()
unmanage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k a. Map k a -> [(k, a)]
Map.toList Map Window Client
dels)
                    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {m :: * -> *}.
(MonadReader EwmhConf m, MonadIO m) =>
Window -> m ()
listen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)   (forall k a. Map k a -> [(k, a)]
Map.toList Map Window Client
cl')
                    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Updater
update forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)   (forall k a. Map k a -> [(k, a)]
Map.toList Map Window Client
new)
        Maybe [CLong]
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
 where
    unmanage :: Window -> m ()
unmanage Window
w = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Display
display forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO ()
selectInput Display
d Window
w Window
0
    listen :: Window -> m ()
listen Window
w = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks EwmhConf -> Display
display forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Display
d -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> Window -> IO ()
selectInput Display
d Window
w Window
propertyChangeMask
    update :: Updater
update Window
w = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((forall a b. (a -> b) -> a -> b
$ Window
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(String, Updater)]
clientHandlers

modifyClient :: Window -> (Client -> Client) -> M ()
modifyClient :: Window -> (Client -> Client) -> M ()
modifyClient Window
w Client -> Client
f = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\EwmhState
s -> EwmhState
s { clients :: Map Window Client
clients = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe Client -> Maybe Client
f' Window
w forall a b. (a -> b) -> a -> b
$ EwmhState -> Map Window Client
clients EwmhState
s })
 where
    f' :: Maybe Client -> Maybe Client
f' Maybe Client
Nothing  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Client -> Client
f Client
initialClient
    f' (Just Client
x) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Client -> Client
f Client
x

updateName :: Updater
updateName Window
w = do
    Maybe [CChar]
mwp <- String -> Window -> M (Maybe [CChar])
windowProperty8 String
"_NET_WM_NAME" Window
w
    case Maybe [CChar]
mwp of
        Just [CChar]
xs -> Window -> (Client -> Client) -> M ()
modifyClient Window
w (\Client
c -> Client
c { windowName :: String
windowName = [CChar] -> String
decodeCChar [CChar]
xs })
        Maybe [CChar]
_       -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

updateDesktop :: Updater
updateDesktop Window
w = do
    Maybe [CLong]
mwp <- String -> Window -> M (Maybe [CLong])
windowProperty32 String
"_NET_WM_DESKTOP" Window
w
    case Maybe [CLong]
mwp of
        Just [CLong]
x -> Window -> (Client -> Client) -> M ()
modifyClient Window
w (\Client
c -> Client
c { desktops :: Set CLong
desktops = forall a. Ord a => [a] -> Set a
Set.fromList [CLong]
x })
        Maybe [CLong]
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

decodeCChar :: [CChar] -> String
decodeCChar :: [CChar] -> String
decodeCChar = [Word8] -> String
UTF8.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral