-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.DynamicBars
-- Description :  Manage per-screen status bars.
-- Copyright   :  (c) Ben Boeckel 2012
-- License     :  BSD-style (as xmonad)
--
-- Maintainer  :  mathstuf@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- Manage per-screen status bars.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.DynamicBars {-# DEPRECATED "Use XMonad.Hooks.StatusBar instead" #-} (
  -- * Usage
  -- $usage
    DynamicStatusBar
  , DynamicStatusBarCleanup
  , DynamicStatusBarPartialCleanup
  , dynStatusBarStartup
  , dynStatusBarStartup'
  , dynStatusBarEventHook
  , dynStatusBarEventHook'
  , multiPP
  , multiPPFormat
  ) where

import Prelude

import Control.Monad.Trans (lift)
import Control.Monad.Writer (WriterT, execWriterT, tell)

import Graphics.X11.Xinerama
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xrandr

import System.IO

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Hooks.DynamicLog
import qualified XMonad.Util.ExtensibleState as XS

-- $usage
-- Provides a few helper functions to manage per-screen status bars while
-- dynamically responding to screen changes. A startup action, event hook, and
-- a way to separate PP styles based on the screen's focus are provided:
--
-- * The 'dynStatusBarStartup' hook which initializes the status bars. The
-- first argument is an `ScreenId -> IO Handle` which spawns a status bar on the
-- given screen and returns the pipe which the string should be written to.
-- The second argument is a `IO ()` to shut down all status bars. This should
-- be placed in your `startupHook`.
--
-- * The 'dynStatusBarEventHook' hook which respawns status bars when the
-- number of screens changes. The arguments are the same as for the
-- `dynStatusBarStartup` function. This should be placed in your
-- `handleEventHook`.
--
-- * Each of the above functions have an alternate form
-- (`dynStatusBarStartup'` and `dynStatusBarEventHook'`) which use a cleanup
-- function which takes an additional `ScreenId` argument which allows for
-- more fine-grained control for shutting down a specific screen's status bar.
--
-- * The 'multiPP' function which allows for different output based on whether
-- the screen for the status bar has focus (the first argument) or not (the
-- second argument). This is for use in your `logHook`.
--
-- * The 'multiPPFormat' function is the same as the 'multiPP' function, but it
-- also takes in a function that can customize the output to status bars.
--
-- The hooks take a 'DynamicStatusBar' function which is given the id of the
-- screen to start up and returns the 'Handle' to the pipe to write to. The
-- 'DynamicStatusBarCleanup' argument should tear down previous instances. It
-- is called when the number of screens changes and on startup.
--

newtype DynStatusBarInfo = DynStatusBarInfo
  { DynStatusBarInfo -> [(ScreenId, Handle)]
dsbInfo :: [(ScreenId, Handle)]
  }

instance ExtensionClass DynStatusBarInfo where
  initialValue :: DynStatusBarInfo
initialValue = [(ScreenId, Handle)] -> DynStatusBarInfo
DynStatusBarInfo []

type DynamicStatusBar = ScreenId -> IO Handle
type DynamicStatusBarCleanup = IO ()
type DynamicStatusBarPartialCleanup = ScreenId -> IO ()

dynStatusBarSetup :: X ()
dynStatusBarSetup :: X ()
dynStatusBarSetup = do
  Display
dpy <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  Window
root <- (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
  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 -> IO ()
xrrSelectInput Display
dpy Window
root Window
rrScreenChangeNotifyMask

dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
dynStatusBarStartup :: DynamicStatusBar -> IO () -> X ()
dynStatusBarStartup DynamicStatusBar
sb IO ()
cleanup = do
  X ()
dynStatusBarSetup
  DynamicStatusBar -> IO () -> X ()
updateStatusBars DynamicStatusBar
sb IO ()
cleanup

dynStatusBarStartup' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
dynStatusBarStartup' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
dynStatusBarStartup' DynamicStatusBar
sb DynamicStatusBarPartialCleanup
cleanup = do
  X ()
dynStatusBarSetup
  DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
updateStatusBars' DynamicStatusBar
sb DynamicStatusBarPartialCleanup
cleanup

dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All
dynStatusBarEventHook :: DynamicStatusBar -> IO () -> Event -> X All
dynStatusBarEventHook DynamicStatusBar
sb IO ()
cleanup = X () -> Event -> X All
dynStatusBarRun (DynamicStatusBar -> IO () -> X ()
updateStatusBars DynamicStatusBar
sb IO ()
cleanup)

dynStatusBarEventHook' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> Event -> X All
dynStatusBarEventHook' :: DynamicStatusBar
-> DynamicStatusBarPartialCleanup -> Event -> X All
dynStatusBarEventHook' DynamicStatusBar
sb DynamicStatusBarPartialCleanup
cleanup = X () -> Event -> X All
dynStatusBarRun (DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
updateStatusBars' DynamicStatusBar
sb DynamicStatusBarPartialCleanup
cleanup)

dynStatusBarRun :: X () -> Event -> X All
dynStatusBarRun :: X () -> Event -> X All
dynStatusBarRun X ()
action RRScreenChangeNotifyEvent{} = X ()
action X () -> X All -> X All
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
dynStatusBarRun X ()
_      Event
_                           = All -> X All
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)

updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
updateStatusBars :: DynamicStatusBar -> IO () -> X ()
updateStatusBars DynamicStatusBar
sb IO ()
cleanup = do
  ([ScreenId]
dsbInfoScreens, [Handle]
dsbInfoHandles) <- X DynStatusBarInfo
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get X DynStatusBarInfo
-> (DynStatusBarInfo -> ([ScreenId], [Handle]))
-> X ([ScreenId], [Handle])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(ScreenId, Handle)] -> ([ScreenId], [Handle])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ScreenId, Handle)] -> ([ScreenId], [Handle]))
-> (DynStatusBarInfo -> [(ScreenId, Handle)])
-> DynStatusBarInfo
-> ([ScreenId], [Handle])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynStatusBarInfo -> [(ScreenId, Handle)]
dsbInfo
  [ScreenId]
screens <- X [ScreenId]
forall (m :: * -> *). MonadIO m => m [ScreenId]
getScreens
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ScreenId]
screens [ScreenId] -> [ScreenId] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ScreenId]
dsbInfoScreens) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
      [Handle]
newHandles <- IO [Handle] -> X [Handle]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Handle] -> X [Handle]) -> IO [Handle] -> X [Handle]
forall a b. (a -> b) -> a -> b
$ do
          Handle -> IO ()
hClose (Handle -> IO ()) -> [Handle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
`mapM_` [Handle]
dsbInfoHandles
          IO ()
cleanup
          DynamicStatusBar -> [ScreenId] -> IO [Handle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM DynamicStatusBar
sb [ScreenId]
screens
      DynStatusBarInfo -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (DynStatusBarInfo -> X ()) -> DynStatusBarInfo -> X ()
forall a b. (a -> b) -> a -> b
$ [(ScreenId, Handle)] -> DynStatusBarInfo
DynStatusBarInfo ([ScreenId] -> [Handle] -> [(ScreenId, Handle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ScreenId]
screens [Handle]
newHandles)

updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
updateStatusBars' DynamicStatusBar
sb DynamicStatusBarPartialCleanup
cleanup = do
  ([ScreenId]
dsbInfoScreens, [Handle]
dsbInfoHandles) <- X DynStatusBarInfo
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get X DynStatusBarInfo
-> (DynStatusBarInfo -> ([ScreenId], [Handle]))
-> X ([ScreenId], [Handle])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([(ScreenId, Handle)] -> ([ScreenId], [Handle])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ScreenId, Handle)] -> ([ScreenId], [Handle]))
-> (DynStatusBarInfo -> [(ScreenId, Handle)])
-> DynStatusBarInfo
-> ([ScreenId], [Handle])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynStatusBarInfo -> [(ScreenId, Handle)]
dsbInfo)
  [ScreenId]
screens <- X [ScreenId]
forall (m :: * -> *). MonadIO m => m [ScreenId]
getScreens
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([ScreenId]
screens [ScreenId] -> [ScreenId] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ScreenId]
dsbInfoScreens) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
      let oldInfo :: [(ScreenId, Handle)]
oldInfo = [ScreenId] -> [Handle] -> [(ScreenId, Handle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ScreenId]
dsbInfoScreens [Handle]
dsbInfoHandles
      let ([(ScreenId, Handle)]
infoToKeep, [(ScreenId, Handle)]
infoToClose) = ((ScreenId, Handle) -> Bool)
-> [(ScreenId, Handle)]
-> ([(ScreenId, Handle)], [(ScreenId, Handle)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((ScreenId -> [ScreenId] -> Bool) -> [ScreenId] -> ScreenId -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ScreenId -> [ScreenId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [ScreenId]
screens (ScreenId -> Bool)
-> ((ScreenId, Handle) -> ScreenId) -> (ScreenId, Handle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, Handle) -> ScreenId
forall a b. (a, b) -> a
fst) [(ScreenId, Handle)]
oldInfo
      [(ScreenId, Handle)]
newInfo <- IO [(ScreenId, Handle)] -> X [(ScreenId, Handle)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(ScreenId, Handle)] -> X [(ScreenId, Handle)])
-> IO [(ScreenId, Handle)] -> X [(ScreenId, Handle)]
forall a b. (a -> b) -> a -> b
$ do
          ((ScreenId, Handle) -> IO ()) -> [(ScreenId, Handle)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> IO ()
hClose (Handle -> IO ())
-> ((ScreenId, Handle) -> Handle) -> (ScreenId, Handle) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, Handle) -> Handle
forall a b. (a, b) -> b
snd) [(ScreenId, Handle)]
infoToClose
          ((ScreenId, Handle) -> IO ()) -> [(ScreenId, Handle)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (DynamicStatusBarPartialCleanup
cleanup DynamicStatusBarPartialCleanup
-> ((ScreenId, Handle) -> ScreenId) -> (ScreenId, Handle) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, Handle) -> ScreenId
forall a b. (a, b) -> a
fst) [(ScreenId, Handle)]
infoToClose
          let newScreens :: [ScreenId]
newScreens = [ScreenId]
screens [ScreenId] -> [ScreenId] -> [ScreenId]
forall a. Eq a => [a] -> [a] -> [a]
\\ [ScreenId]
dsbInfoScreens
          [Handle]
newHandles <- DynamicStatusBar -> [ScreenId] -> IO [Handle]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM DynamicStatusBar
sb [ScreenId]
newScreens
          [(ScreenId, Handle)] -> IO [(ScreenId, Handle)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ScreenId, Handle)] -> IO [(ScreenId, Handle)])
-> [(ScreenId, Handle)] -> IO [(ScreenId, Handle)]
forall a b. (a -> b) -> a -> b
$ [ScreenId] -> [Handle] -> [(ScreenId, Handle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ScreenId]
newScreens [Handle]
newHandles
      DynStatusBarInfo -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (DynStatusBarInfo -> X ())
-> ([(ScreenId, Handle)] -> DynStatusBarInfo)
-> [(ScreenId, Handle)]
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ScreenId, Handle)] -> DynStatusBarInfo
DynStatusBarInfo ([(ScreenId, Handle)] -> X ()) -> [(ScreenId, Handle)] -> X ()
forall a b. (a -> b) -> a -> b
$ [(ScreenId, Handle)]
infoToKeep [(ScreenId, Handle)]
-> [(ScreenId, Handle)] -> [(ScreenId, Handle)]
forall a. [a] -> [a] -> [a]
++ [(ScreenId, Handle)]
newInfo

-----------------------------------------------------------------------------
-- The following code is from adamvo's xmonad.hs file.
-- http://www.haskell.org/haskellwiki/Xmonad/Config_archive/adamvo%27s_xmonad.hs

multiPP :: PP -- ^ The PP to use if the screen is focused
        -> PP -- ^ The PP to use otherwise
        -> X ()
multiPP :: PP -> PP -> X ()
multiPP = (PP -> X WorkspaceId) -> PP -> PP -> X ()
multiPPFormat PP -> X WorkspaceId
dynamicLogString

multiPPFormat :: (PP -> X String) -> PP -> PP -> X ()
multiPPFormat :: (PP -> X WorkspaceId) -> PP -> PP -> X ()
multiPPFormat PP -> X WorkspaceId
dynlStr PP
focusPP PP
unfocusPP = do
  ([ScreenId]
_, [Handle]
dsbInfoHandles) <- X DynStatusBarInfo
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get X DynStatusBarInfo
-> (DynStatusBarInfo -> ([ScreenId], [Handle]))
-> X ([ScreenId], [Handle])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(ScreenId, Handle)] -> ([ScreenId], [Handle])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ScreenId, Handle)] -> ([ScreenId], [Handle]))
-> (DynStatusBarInfo -> [(ScreenId, Handle)])
-> DynStatusBarInfo
-> ([ScreenId], [Handle])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynStatusBarInfo -> [(ScreenId, Handle)]
dsbInfo
  (PP -> X WorkspaceId) -> PP -> PP -> [Handle] -> X ()
multiPP' PP -> X WorkspaceId
dynlStr PP
focusPP PP
unfocusPP [Handle]
dsbInfoHandles

multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
multiPP' :: (PP -> X WorkspaceId) -> PP -> PP -> [Handle] -> X ()
multiPP' PP -> X WorkspaceId
dynlStr PP
focusPP PP
unfocusPP [Handle]
handles = do
  XState
st <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
  let pickPP :: WorkspaceId -> WriterT (Last XState) X String
      pickPP :: WorkspaceId -> WriterT (Last XState) X WorkspaceId
pickPP WorkspaceId
ws = do
        let isFoc :: Bool
isFoc = (WorkspaceId
ws WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
==) (WorkspaceId -> Bool)
-> (StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> WorkspaceId)
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WorkspaceId (Layout Window) Window)
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> (StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Bool)
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall a b. (a -> b) -> a -> b
$ XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset XState
st
        XState -> WriterT (Last XState) X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
st{ windowset :: StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset = WorkspaceId
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view WorkspaceId
ws (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall a b. (a -> b) -> a -> b
$ XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset XState
st }
        WorkspaceId
out <- X WorkspaceId -> WriterT (Last XState) X WorkspaceId
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (X WorkspaceId -> WriterT (Last XState) X WorkspaceId)
-> X WorkspaceId -> WriterT (Last XState) X WorkspaceId
forall a b. (a -> b) -> a -> b
$ PP -> X WorkspaceId
dynlStr (PP -> X WorkspaceId) -> PP -> X WorkspaceId
forall a b. (a -> b) -> a -> b
$ if Bool
isFoc then PP
focusPP else PP
unfocusPP
        Bool -> WriterT (Last XState) X () -> WriterT (Last XState) X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isFoc (WriterT (Last XState) X () -> WriterT (Last XState) X ())
-> WriterT (Last XState) X () -> WriterT (Last XState) X ()
forall a b. (a -> b) -> a -> b
$ WriterT (Last XState) X XState
forall s (m :: * -> *). MonadState s m => m s
get WriterT (Last XState) X XState
-> (XState -> WriterT (Last XState) X ())
-> WriterT (Last XState) X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Last XState -> WriterT (Last XState) X ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Last XState -> WriterT (Last XState) X ())
-> (XState -> Last XState) -> XState -> WriterT (Last XState) X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe XState -> Last XState
forall a. Maybe a -> Last a
Last (Maybe XState -> Last XState)
-> (XState -> Maybe XState) -> XState -> Last XState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> Maybe XState
forall a. a -> Maybe a
Just
        WorkspaceId -> WriterT (Last XState) X WorkspaceId
forall (m :: * -> *) a. Monad m => a -> m a
return WorkspaceId
out
  (XState -> X ()) -> Maybe XState -> X ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ XState -> X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Maybe XState -> X ())
-> (Last XState -> Maybe XState) -> Last XState -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Last XState -> Maybe XState
forall a. Last a -> Maybe a
getLast
    (Last XState -> X ()) -> X (Last XState) -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WriterT (Last XState) X () -> X (Last XState)
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT (Last XState) X () -> X (Last XState))
-> ([Maybe WorkspaceId] -> WriterT (Last XState) X ())
-> [Maybe WorkspaceId]
-> X (Last XState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO () -> WriterT (Last XState) X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> WriterT (Last XState) X ())
-> ([WorkspaceId] -> IO ())
-> [WorkspaceId]
-> WriterT (Last XState) X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Handle -> WorkspaceId -> IO ())
-> [Handle] -> [WorkspaceId] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Handle -> WorkspaceId -> IO ()
hPutStrLn [Handle]
handles ([WorkspaceId] -> WriterT (Last XState) X ())
-> ([WorkspaceId] -> WriterT (Last XState) X [WorkspaceId])
-> [WorkspaceId]
-> WriterT (Last XState) X ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (WorkspaceId -> WriterT (Last XState) X WorkspaceId)
-> [WorkspaceId] -> WriterT (Last XState) X [WorkspaceId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM WorkspaceId -> WriterT (Last XState) X WorkspaceId
pickPP) ([WorkspaceId] -> WriterT (Last XState) X ())
-> ([Maybe WorkspaceId] -> [WorkspaceId])
-> [Maybe WorkspaceId]
-> WriterT (Last XState) X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe WorkspaceId] -> [WorkspaceId]
forall a. [Maybe a] -> [a]
catMaybes
    ([Maybe WorkspaceId] -> X (Last XState))
-> X [Maybe WorkspaceId] -> X (Last XState)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ScreenId -> X (Maybe WorkspaceId))
-> [ScreenId] -> X [Maybe WorkspaceId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ((ScreenId -> Handle -> ScreenId)
-> [ScreenId] -> [Handle] -> [ScreenId]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ScreenId -> Handle -> ScreenId
forall a b. a -> b -> a
const [ScreenId
0 .. ] [Handle]
handles)

getScreens :: MonadIO m => m [ScreenId]
getScreens :: forall (m :: * -> *). MonadIO m => m [ScreenId]
getScreens = IO [ScreenId] -> m [ScreenId]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ScreenId] -> m [ScreenId]) -> IO [ScreenId] -> m [ScreenId]
forall a b. (a -> b) -> a -> b
$ do
  [Rectangle]
screens <- do
    Display
dpy <- WorkspaceId -> IO Display
openDisplay WorkspaceId
""
    [Rectangle]
rects <- Display -> IO [Rectangle]
getScreenInfo Display
dpy
    Display -> IO ()
closeDisplay Display
dpy
    [Rectangle] -> IO [Rectangle]
forall (m :: * -> *) a. Monad m => a -> m a
return [Rectangle]
rects
  let ids :: [(ScreenId, Rectangle)]
ids = [ScreenId] -> [Rectangle] -> [(ScreenId, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ScreenId
0 .. ] [Rectangle]
screens
  [ScreenId] -> IO [ScreenId]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ScreenId] -> IO [ScreenId]) -> [ScreenId] -> IO [ScreenId]
forall a b. (a -> b) -> a -> b
$ ((ScreenId, Rectangle) -> ScreenId)
-> [(ScreenId, Rectangle)] -> [ScreenId]
forall a b. (a -> b) -> [a] -> [b]
map (ScreenId, Rectangle) -> ScreenId
forall a b. (a, b) -> a
fst [(ScreenId, Rectangle)]
ids