    {-# LANGUAGE ScopedTypeVariables #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module       : XMonad.Hooks.XPropManage
    -- Description  : ManageHook matching on XProperties.
    -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
    -- License      : BSD
    --
    -- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
    -- Stability    : unstable
    -- Portability  : unportable
    --
    -- A ManageHook matching on XProperties.
    -----------------------------------------------------------------------------

    module XMonad.Hooks.XPropManage (
                     -- * Usage
                     -- $usage
                     xPropManageHook, XPropMatch, pmX, pmP
                     ) where

    import Control.Exception as E
    import Control.Monad.Trans (lift)

    import XMonad
    import XMonad.Prelude (Endo (..), chr)

    -- $usage
    -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
    --
    -- > import XMonad.Hooks.XPropManage
    -- > import qualified XMonad.StackSet as W
    -- > import XMonad.Actions.TagWindows
    -- > import Data.List
    --
    -- > manageHook = xPropManageHook xPropMatches
    -- >
    -- > xPropMatches :: [XPropMatch]
    -- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==))], (\w -> float w >> return (W.shift "2")))
    -- >                , ([ (wM_COMMAND, any ("screen" ==)), (wM_CLASS, any ("xterm" ==))], pmX (addTag "screen"))
    -- >                , ([ (wM_NAME, any ("Iceweasel" `isInfixOf`))], pmP (W.shift "3"))
    -- >                ]
    --
    -- Properties known to work: wM_CLASS, wM_NAME, wM_COMMAND
    --
    -- A XPropMatch consists of a list of conditions and function telling what to do.
    --
    -- The list entries are pairs of an XProperty to match on (like wM_CLASS, wM_NAME)^1,
    -- and an function which matches onto the value of the property (represented as a List
    -- of Strings).
    --
    -- If a match succeeds the function is called immediately, can perform any action and then return
    -- a function to apply in 'windows' (see Operations.hs). So if the action does only work on the
    -- WindowSet use just 'pmP function'.
    --
    -- \*1 You can get the available properties of an application with the xprop utility. STRING properties
    -- should work fine. Others might not work.
    --

    type XPropMatch = ([(Atom, [String] -> Bool)], Window -> X (WindowSet -> WindowSet))

    pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet)
    pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet)
    pmX Window -> X ()
    f Window
    w = Window -> X ()
    f Window
    w X () -> X (WindowSet -> WindowSet) -> X (WindowSet -> WindowSet)
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (WindowSet -> WindowSet) -> X (WindowSet -> WindowSet)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return WindowSet -> WindowSet
    forall a. a -> a
    id

    pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet)
    pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet)
    pmP WindowSet -> WindowSet
    f Window
    _ = (WindowSet -> WindowSet) -> X (WindowSet -> WindowSet)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return WindowSet -> WindowSet
    f

    xPropManageHook :: [XPropMatch] -> ManageHook
    xPropManageHook :: [XPropMatch] -> ManageHook
    xPropManageHook [XPropMatch]
    tms = [ManageHook] -> ManageHook
    forall a. Monoid a => [a] -> a
    mconcat ([ManageHook] -> ManageHook) -> [ManageHook] -> ManageHook
    forall a b. (a -> b) -> a -> b
    $ (XPropMatch -> ManageHook) -> [XPropMatch] -> [ManageHook]
    forall a b. (a -> b) -> [a] -> [b]
    map XPropMatch -> ManageHook
    forall {t :: * -> *} {a}.
    Traversable t =>
    (t (Window, [String] -> Bool), Window -> X (a -> a))
    -> Query (Endo a)
    propToHook [XPropMatch]
    tms
        where
          propToHook :: (t (Window, [String] -> Bool), Window -> X (a -> a))
    -> Query (Endo a)
    propToHook (t (Window, [String] -> Bool)
    ms, Window -> X (a -> a)
    f) = (t Bool -> Bool) -> Query (t Bool) -> Query Bool
    forall a b. (a -> b) -> Query a -> Query b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap t Bool -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and (((Window, [String] -> Bool) -> Query Bool)
    -> t (Window, [String] -> Bool) -> Query (t Bool)
    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) -> t a -> m (t b)
    mapM (Window, [String] -> Bool) -> Query Bool
    forall {b}. (Window, [String] -> b) -> Query b
    mkQuery t (Window, [String] -> Bool)
    ms) Query Bool -> Query (Endo a) -> Query (Endo a)
    forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
    --> (Window -> X (a -> a)) -> Query (Endo a)
    forall {a}. (Window -> X (a -> a)) -> Query (Endo a)
    mkHook Window -> X (a -> a)
    f
          mkQuery :: (Window, [String] -> b) -> Query b
    mkQuery (Window
    a, [String] -> b
    tf)    = ([String] -> b) -> Query [String] -> Query b
    forall a b. (a -> b) -> Query a -> Query b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [String] -> b
    tf (Window -> Query [String]
    getQuery Window
    a)
          mkHook :: (Window -> X (a -> a)) -> Query (Endo a)
    mkHook Window -> X (a -> a)
    func        = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> Query (Endo a)) -> Query (Endo a)
    forall a b. Query a -> (a -> Query b) -> Query b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ReaderT Window X (Endo a) -> Query (Endo a)
    forall a. ReaderT Window X a -> Query a
    Query (ReaderT Window X (Endo a) -> Query (Endo a))
    -> (Window -> ReaderT Window X (Endo a))
    -> Window
    -> Query (Endo a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . X (Endo a) -> ReaderT Window X (Endo a)
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Window m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (X (Endo a) -> ReaderT Window X (Endo a))
    -> (Window -> X (Endo a)) -> Window -> ReaderT Window X (Endo a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a -> a) -> Endo a) -> X (a -> a) -> X (Endo a)
    forall a b. (a -> b) -> X a -> X b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> a) -> Endo a
    forall a. (a -> a) -> Endo a
    Endo (X (a -> a) -> X (Endo a))
    -> (Window -> X (a -> a)) -> Window -> X (Endo a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Window -> X (a -> a)
    func

    getProp :: Display -> Window -> Atom -> X [String]
    getProp :: Display -> Window -> Window -> X [String]
    getProp Display
    d Window
    w Window
    p = do
        [String]
    prop <- IO [String] -> X [String]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [String] -> X [String]) -> IO [String] -> X [String]
    forall a b. (a -> b) -> a -> b
    $ IO [String] -> (IOException -> IO [String]) -> IO [String]
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    E.catch (Display -> Window -> Window -> IO TextProperty
    getTextProperty Display
    d Window
    w Window
    p IO TextProperty -> (TextProperty -> IO [String]) -> IO [String]
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Display -> TextProperty -> IO [String]
    wcTextPropertyToTextList Display
    d) (\(IOException
    _ :: IOException) -> [String] -> IO [String]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[]])
        let filt :: Window -> [String] -> [String]
    filt Window
    q | Window
    q Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    wM_COMMAND = (String -> [String]) -> [String] -> [String]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap String -> [String]
    splitAtNull
                   | Bool
    otherwise       = [String] -> [String]
    forall a. a -> a
    id
        [String] -> X [String]
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Window -> [String] -> [String]
    filt Window
    p [String]
    prop)

    getQuery ::  Atom -> Query [String]
    getQuery :: Window -> Query [String]
    getQuery Window
    p = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> Query [String]) -> Query [String]
    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 ->  ReaderT Window X [String] -> Query [String]
    forall a. ReaderT Window X a -> Query a
    Query (ReaderT Window X [String] -> Query [String])
    -> (X [String] -> ReaderT Window X [String])
    -> X [String]
    -> Query [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . X [String] -> ReaderT Window X [String]
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Window m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (X [String] -> Query [String]) -> X [String] -> Query [String]
    forall a b. (a -> b) -> a -> b
    $ (Display -> X [String]) -> X [String]
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X [String]) -> X [String])
    -> (Display -> X [String]) -> X [String]
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> Display -> Window -> Window -> X [String]
    getProp Display
    d Window
    w Window
    p

    splitAtNull :: String -> [String]
    splitAtNull :: String -> [String]
    splitAtNull String
    s = case (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int -> Char
    chr Int
    0) String
    s of
        String
    "" -> []
        String
    s' -> String
    w String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> [String]
    splitAtNull String
    s''
              where (String
    w, String
    s'') = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int -> Char
    chr Int
    0) String
    s'