    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Util.NamedWindows
    -- Description :  Associate the X titles of windows with them.
    -- Copyright   :  (c) David Roundy <droundy@darcs.net>
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  none
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- This module allows you to associate the X titles of windows with
    -- them.
    --
    -----------------------------------------------------------------------------

    module XMonad.Util.NamedWindows (
                                       -- * Usage
                                       -- $usage
                                       NamedWindow,
                                       getName,
                                       getNameWMClass,
                                       withNamedWindow,
                                       unName
                                      ) where

    import Control.Exception as E
    import XMonad.Prelude ( fromMaybe, listToMaybe, (>=>) )

    import qualified XMonad.StackSet as W ( peek )

    import XMonad

    -- $usage
    -- See "XMonad.Layout.Tabbed" for an example of its use.

    data NamedWindow = NW !String !Window
    instance Eq NamedWindow where
        (NW String
    s Window
    _) == :: NamedWindow -> NamedWindow -> Bool
    == (NW String
    s' Window
    _) = String
    s String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    s'
    instance Ord NamedWindow where
        compare :: NamedWindow -> NamedWindow -> Ordering
    compare (NW String
    s Window
    _) (NW String
    s' Window
    _) = String -> String -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare String
    s String
    s'
    instance Show NamedWindow where
        show :: NamedWindow -> String
    show (NW String
    n Window
    _) = String
    n

    getName :: Window -> X NamedWindow
    getName :: Window -> X NamedWindow
    getName Window
    w = (Display -> X NamedWindow) -> X NamedWindow
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X NamedWindow) -> X NamedWindow)
    -> (Display -> X NamedWindow) -> X NamedWindow
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> do
        -- TODO, this code is ugly and convoluted -- clean it up
        let getIt :: IO NamedWindow
    getIt = IO TextProperty
    -> (TextProperty -> IO CInt)
    -> (TextProperty -> IO NamedWindow)
    -> IO NamedWindow
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket IO TextProperty
    getProp (Ptr CChar -> IO CInt
    forall a. Ptr a -> IO CInt
    xFree (Ptr CChar -> IO CInt)
    -> (TextProperty -> Ptr CChar) -> TextProperty -> IO CInt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TextProperty -> Ptr CChar
    tp_value) ((String -> NamedWindow) -> IO String -> IO NamedWindow
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> Window -> NamedWindow
    `NW` Window
    w) (IO String -> IO NamedWindow)
    -> (TextProperty -> IO String) -> TextProperty -> IO NamedWindow
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TextProperty -> IO String
    copy)

            getProp :: IO TextProperty
    getProp = (Display -> String -> Bool -> IO Window
    internAtom Display
    d String
    "_NET_WM_NAME" Bool
    False IO Window -> (Window -> IO TextProperty) -> IO TextProperty
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Display -> Window -> Window -> IO TextProperty
    getTextProperty Display
    d Window
    w)
                          IO TextProperty
    -> (SomeException -> IO TextProperty) -> IO TextProperty
    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

            copy :: TextProperty -> IO String
    copy TextProperty
    prop = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "" (Maybe String -> String)
    -> ([String] -> Maybe String) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> Maybe String
    forall a. [a] -> Maybe a
    listToMaybe ([String] -> String) -> IO [String] -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Display -> TextProperty -> IO [String]
    wcTextPropertyToTextList Display
    d TextProperty
    prop

        IO NamedWindow -> X NamedWindow
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO NamedWindow -> X NamedWindow)
    -> IO NamedWindow -> X NamedWindow
    forall a b. (a -> b) -> a -> b
    $ IO NamedWindow
    getIt IO NamedWindow
    -> (SomeException -> IO NamedWindow) -> IO NamedWindow
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \(SomeException e
    _) ->  (String -> Window -> NamedWindow
    `NW` Window
    w) (String -> NamedWindow)
    -> (ClassHint -> String) -> ClassHint -> NamedWindow
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClassHint -> String
    resName (ClassHint -> NamedWindow) -> IO ClassHint -> IO NamedWindow
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Display -> Window -> IO ClassHint
    getClassHint Display
    d Window
    w

    -- | Get 'NamedWindow' using 'wM_CLASS'
    getNameWMClass :: Window -> X NamedWindow
    getNameWMClass :: Window -> X NamedWindow
    getNameWMClass Window
    w =
      (Display -> X NamedWindow) -> X NamedWindow
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X NamedWindow) -> X NamedWindow)
    -> (Display -> X NamedWindow) -> X NamedWindow
    forall a b. (a -> b) -> a -> b
    $ \Display
    d
        -- TODO, this code is ugly and convoluted -- clean it up
       -> do
        let getIt :: IO NamedWindow
    getIt = IO TextProperty
    -> (TextProperty -> IO CInt)
    -> (TextProperty -> IO NamedWindow)
    -> IO NamedWindow
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracket IO TextProperty
    getProp (Ptr CChar -> IO CInt
    forall a. Ptr a -> IO CInt
    xFree (Ptr CChar -> IO CInt)
    -> (TextProperty -> Ptr CChar) -> TextProperty -> IO CInt
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TextProperty -> Ptr CChar
    tp_value) ((String -> NamedWindow) -> IO String -> IO NamedWindow
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> Window -> NamedWindow
    `NW` Window
    w) (IO String -> IO NamedWindow)
    -> (TextProperty -> IO String) -> TextProperty -> IO NamedWindow
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TextProperty -> IO String
    copy)
            getProp :: IO TextProperty
    getProp = Display -> Window -> Window -> IO TextProperty
    getTextProperty Display
    d Window
    w Window
    wM_CLASS
            copy :: TextProperty -> IO String
    copy TextProperty
    prop =
              String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    "" (Maybe String -> String)
    -> ([String] -> Maybe String) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> Maybe String
    forall a. [a] -> Maybe a
    listToMaybe ([String] -> String) -> IO [String] -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Display -> TextProperty -> IO [String]
    wcTextPropertyToTextList Display
    d TextProperty
    prop
        IO NamedWindow -> X NamedWindow
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO NamedWindow -> X NamedWindow)
    -> IO NamedWindow -> X NamedWindow
    forall a b. (a -> b) -> a -> b
    $
          IO NamedWindow
    getIt IO NamedWindow
    -> (SomeException -> IO NamedWindow) -> IO NamedWindow
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \(SomeException e
    _) ->
            (String -> Window -> NamedWindow
    `NW` Window
    w) (String -> NamedWindow)
    -> (ClassHint -> String) -> ClassHint -> NamedWindow
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClassHint -> String
    resName (ClassHint -> NamedWindow) -> IO ClassHint -> IO NamedWindow
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Display -> Window -> IO ClassHint
    getClassHint Display
    d Window
    w

    unName :: NamedWindow -> Window
    unName :: NamedWindow -> Window
    unName (NW String
    _ Window
    w) = Window
    w

    withNamedWindow :: (NamedWindow -> X ()) -> X ()
    withNamedWindow :: (NamedWindow -> X ()) -> X ()
    withNamedWindow NamedWindow -> X ()
    f = do ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
                           whenJust (W.peek ws) (getName >=> f)