    -----------------------------------------------------------------------------
    -- |
    -- 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
      dpy <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
      root <- asks theRoot
      io $ xrrSelectInput dpy root 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 a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)
    dynStatusBarRun X ()
    _      Event
    _                           = All -> X All
    forall a. a -> X a
    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
      (dsbInfoScreens, 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
      screens <- getScreens
      when (screens /= dsbInfoScreens) $ do
          newHandles <- liftIO $ do
              hClose `mapM_` dsbInfoHandles
              cleanup
              mapM sb screens
          XS.put $ DynStatusBarInfo (zip screens newHandles)

    updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
    updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
    updateStatusBars' DynamicStatusBar
    sb DynamicStatusBarPartialCleanup
    cleanup = do
      (dsbInfoScreens, 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)
      screens <- getScreens
      when (screens /= dsbInfoScreens) $ do
          let oldInfo = [ScreenId] -> [Handle] -> [(ScreenId, Handle)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [ScreenId]
    dsbInfoScreens [Handle]
    dsbInfoHandles
          let (infoToKeep, infoToClose) = partition (flip elem screens . fst) oldInfo
          newInfo <- liftIO $ do
              mapM_ (hClose . snd) infoToClose
              mapM_ (cleanup . fst) infoToClose
              let newScreens = [ScreenId]
    screens [ScreenId] -> [ScreenId] -> [ScreenId]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [ScreenId]
    dsbInfoScreens
              newHandles <- mapM sb newScreens
              return $ zip newScreens newHandles
          XS.put . DynStatusBarInfo $ infoToKeep ++ 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
      (_, 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
      multiPP' dynlStr focusPP unfocusPP 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
      st <- X XState
    forall s (m :: * -> *). MonadState s m => m s
    get
      let pickPP :: WorkspaceId -> WriterT (Last XState) X String
          pickPP WorkspaceId
    ws = do
            let isFoc :: Bool
    isFoc = (WorkspaceId
    ws WorkspaceId -> WorkspaceId -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (WorkspaceId -> Bool)
    -> (WindowSet -> WorkspaceId) -> WindowSet -> 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)
    -> (WindowSet -> Workspace WorkspaceId (Layout Window) Window)
    -> WindowSet
    -> 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)
    -> (WindowSet
        -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
    -> WindowSet
    -> Workspace WorkspaceId (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet
    -> 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 (WindowSet -> Bool) -> WindowSet -> Bool
    forall a b. (a -> b) -> a -> b
    $ XState -> WindowSet
    windowset XState
    st
            XState -> WriterT (Last XState) X ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put XState
    st{ windowset = W.view ws $ windowset st }
            out <- X WorkspaceId -> WriterT (Last XState) X WorkspaceId
    forall (m :: * -> *) a. Monad m => m a -> WriterT (Last XState) m a
    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
            when isFoc $ get >>= tell . Last . Just
            return out
      traverse_ put . getLast
        =<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes
        =<< mapM screenWorkspace (zipWith const [0 .. ] handles)

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