    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.ManageHook
    -- Copyright   :  (c) Spencer Janssen 2007
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  spencerjanssen@gmail.com
    -- Stability   :  unstable
    --
    -- An EDSL for ManageHooks
    --
    -----------------------------------------------------------------------------

    -- XXX examples required

    module XMonad.ManageHook where

    import XMonad.Core
    import Graphics.X11.Xlib.Extras
    import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME)
    import Control.Exception (bracket, SomeException(..))
    import qualified Control.Exception as E
    import Control.Monad.Reader
    import Data.Maybe
    import Data.Monoid
    import qualified XMonad.StackSet as W
    import XMonad.Operations (floatLocation, reveal, isFixedSizeOrTransient)

    -- | Lift an 'X' action to a 'Query'.
    liftX :: X a -> Query a
    liftX :: forall a. X a -> Query a
    liftX = ReaderT Window X a -> Query a
    forall a. ReaderT Window X a -> Query a
    Query (ReaderT Window X a -> Query a)
    -> (X a -> ReaderT Window X a) -> X a -> Query a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . X a -> ReaderT Window X 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

    -- | The identity hook that returns the WindowSet unchanged.
    idHook :: Monoid m => m
    idHook :: forall m. Monoid m => m
    idHook = m
    forall m. Monoid m => m
    mempty

    -- | Infix 'mappend'. Compose two 'ManageHook' from right to left.
    (<+>) :: Monoid m => m -> m -> m
    <+> :: forall m. Monoid m => m -> m -> m
    (<+>) = m -> m -> m
    forall m. Monoid m => m -> m -> m
    mappend

    -- | Compose the list of 'ManageHook's.
    composeAll :: Monoid m => [m] -> m
    composeAll :: forall m. Monoid m => [m] -> m
    composeAll = [m] -> m
    forall m. Monoid m => [m] -> m
    mconcat

    infix 0 -->

    -- | @p --> x@.  If @p@ returns 'True', execute the 'ManageHook'.
    --
    -- > (-->) :: Monoid m => Query Bool -> Query m -> Query m -- a simpler type
    (-->) :: (Monad m, Monoid a) => m Bool -> m a -> m a
    m Bool
    p --> :: forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
    --> m a
    f = m Bool
    p m Bool -> (Bool -> m a) -> m a
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Bool
    b -> if Bool
    b then m a
    f else a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    forall m. Monoid m => m
    mempty

    -- | @q =? x@. if the result of @q@ equals @x@, return 'True'.
    (=?) :: Eq a => Query a -> a -> Query Bool
    Query a
    q =? :: forall a. Eq a => Query a -> a -> Query Bool
    =? a
    x = (a -> Bool) -> Query a -> Query Bool
    forall a b. (a -> b) -> Query a -> Query b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    x) Query a
    q

    infixr 3 <&&>, <||>

    -- | '&&' lifted to a 'Monad'.
    (<&&>) :: Monad m => m Bool -> m Bool -> m Bool
    m Bool
    x <&&> :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    <&&> m Bool
    y = m Bool -> m Bool -> m Bool -> m Bool
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM m Bool
    x m Bool
    y (Bool -> m Bool
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False)

    -- | '||' lifted to a 'Monad'.
    (<||>) :: Monad m => m Bool -> m Bool -> m Bool
    m Bool
    x <||> :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    <||> m Bool
    y = m Bool -> m Bool -> m Bool -> m Bool
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM m Bool
    x (Bool -> m Bool
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True) m Bool
    y

    -- | Return the window title.
    title :: Query String
    title :: Query WorkspaceId
    title = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> Query WorkspaceId) -> Query WorkspaceId
    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 -> X WorkspaceId -> Query WorkspaceId
    forall a. X a -> Query a
    liftX (X WorkspaceId -> Query WorkspaceId)
    -> X WorkspaceId -> Query WorkspaceId
    forall a b. (a -> b) -> a -> b
    $ do
        d <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
        let
            getProp =
                (Display -> WorkspaceId -> Bool -> IO Window
    internAtom Display
    d WorkspaceId
    "_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
            extract TextProperty
    prop = do l <- Display -> TextProperty -> IO [WorkspaceId]
    wcTextPropertyToTextList Display
    d TextProperty
    prop
                              return $ fromMaybe "" $ listToMaybe l
        io $ bracket getProp (xFree . tp_value) extract `E.catch` \(SomeException e
    _) -> WorkspaceId -> IO WorkspaceId
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return WorkspaceId
    ""

    -- | Return the application name; i.e., the /first/ string returned by
    -- @WM_CLASS@.
    appName :: Query String
    appName :: Query WorkspaceId
    appName = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> Query WorkspaceId) -> Query WorkspaceId
    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 -> X WorkspaceId -> Query WorkspaceId
    forall a. X a -> Query a
    liftX (X WorkspaceId -> Query WorkspaceId)
    -> X WorkspaceId -> Query WorkspaceId
    forall a b. (a -> b) -> a -> b
    $ (Display -> X WorkspaceId) -> X WorkspaceId
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X WorkspaceId) -> X WorkspaceId)
    -> (Display -> X WorkspaceId) -> X WorkspaceId
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> (ClassHint -> WorkspaceId) -> X ClassHint -> X WorkspaceId
    forall a b. (a -> b) -> X a -> X b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ClassHint -> WorkspaceId
    resName (X ClassHint -> X WorkspaceId) -> X ClassHint -> X WorkspaceId
    forall a b. (a -> b) -> a -> b
    $ IO ClassHint -> X ClassHint
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO ClassHint -> X ClassHint) -> IO ClassHint -> X ClassHint
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> IO ClassHint
    getClassHint Display
    d Window
    w)

    -- | Backwards compatible alias for 'appName'.
    resource :: Query String
    resource :: Query WorkspaceId
    resource = Query WorkspaceId
    appName

    -- | Return the resource class; i.e., the /second/ string returned by
    -- @WM_CLASS@.
    className :: Query String
    className :: Query WorkspaceId
    className = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> Query WorkspaceId) -> Query WorkspaceId
    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 -> X WorkspaceId -> Query WorkspaceId
    forall a. X a -> Query a
    liftX (X WorkspaceId -> Query WorkspaceId)
    -> X WorkspaceId -> Query WorkspaceId
    forall a b. (a -> b) -> a -> b
    $ (Display -> X WorkspaceId) -> X WorkspaceId
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X WorkspaceId) -> X WorkspaceId)
    -> (Display -> X WorkspaceId) -> X WorkspaceId
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> (ClassHint -> WorkspaceId) -> X ClassHint -> X WorkspaceId
    forall a b. (a -> b) -> X a -> X b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ClassHint -> WorkspaceId
    resClass (X ClassHint -> X WorkspaceId) -> X ClassHint -> X WorkspaceId
    forall a b. (a -> b) -> a -> b
    $ IO ClassHint -> X ClassHint
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO ClassHint -> X ClassHint) -> IO ClassHint -> X ClassHint
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> IO ClassHint
    getClassHint Display
    d Window
    w)

    -- | A query that can return an arbitrary X property of type 'String',
    --   identified by name.
    stringProperty :: String -> Query String
    stringProperty :: WorkspaceId -> Query WorkspaceId
    stringProperty WorkspaceId
    p = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> Query WorkspaceId) -> Query WorkspaceId
    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 -> X WorkspaceId -> Query WorkspaceId
    forall a. X a -> Query a
    liftX (X WorkspaceId -> Query WorkspaceId)
    -> X WorkspaceId -> Query WorkspaceId
    forall a b. (a -> b) -> a -> b
    $ (Display -> X WorkspaceId) -> X WorkspaceId
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X WorkspaceId) -> X WorkspaceId)
    -> (Display -> X WorkspaceId) -> X WorkspaceId
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> WorkspaceId -> Maybe WorkspaceId -> WorkspaceId
    forall a. a -> Maybe a -> a
    fromMaybe WorkspaceId
    "" (Maybe WorkspaceId -> WorkspaceId)
    -> X (Maybe WorkspaceId) -> X WorkspaceId
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Display -> Window -> WorkspaceId -> X (Maybe WorkspaceId)
    getStringProperty Display
    d Window
    w WorkspaceId
    p)

    getStringProperty :: Display -> Window -> String -> X (Maybe String)
    getStringProperty :: Display -> Window -> WorkspaceId -> X (Maybe WorkspaceId)
    getStringProperty Display
    d Window
    w WorkspaceId
    p = do
      a  <- WorkspaceId -> X Window
    getAtom WorkspaceId
    p
      md <- io $ getWindowProperty8 d a w
      return $ fmap (map (toEnum . fromIntegral)) md

    -- | Return whether the window will be a floating window or not
    willFloat :: Query Bool
    willFloat :: Query Bool
    willFloat = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> Query Bool) -> Query Bool
    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 -> X Bool -> Query Bool
    forall a. X a -> Query a
    liftX (X Bool -> Query Bool) -> X Bool -> Query Bool
    forall a b. (a -> b) -> a -> b
    $ (Display -> X Bool) -> X Bool
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X Bool) -> X Bool) -> (Display -> X Bool) -> X Bool
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> Display -> Window -> X Bool
    isFixedSizeOrTransient Display
    d Window
    w

    -- | Modify the 'WindowSet' with a pure function.
    doF :: (s -> s) -> Query (Endo s)
    doF :: forall s. (s -> s) -> Query (Endo s)
    doF = Endo s -> Query (Endo s)
    forall a. a -> Query a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Endo s -> Query (Endo s))
    -> ((s -> s) -> Endo s) -> (s -> s) -> Query (Endo s)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (s -> s) -> Endo s
    forall a. (a -> a) -> Endo a
    Endo

    -- | Move the window to the floating layer.
    doFloat :: ManageHook
    doFloat :: ManageHook
    doFloat = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> ManageHook) -> ManageHook
    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 -> (WindowSet -> WindowSet) -> ManageHook
    forall s. (s -> s) -> Query (Endo s)
    doF ((WindowSet -> WindowSet) -> ManageHook)
    -> ((ScreenId, RationalRect) -> WindowSet -> WindowSet)
    -> (ScreenId, RationalRect)
    -> ManageHook
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Window -> RationalRect -> WindowSet -> WindowSet
    forall a i l s sd.
    Ord a =>
    a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
    W.float Window
    w (RationalRect -> WindowSet -> WindowSet)
    -> ((ScreenId, RationalRect) -> RationalRect)
    -> (ScreenId, RationalRect)
    -> WindowSet
    -> WindowSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ScreenId, RationalRect) -> RationalRect
    forall a b. (a, b) -> b
    snd ((ScreenId, RationalRect) -> ManageHook)
    -> Query (ScreenId, RationalRect) -> ManageHook
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< X (ScreenId, RationalRect) -> Query (ScreenId, RationalRect)
    forall a. X a -> Query a
    liftX (Window -> X (ScreenId, RationalRect)
    floatLocation Window
    w)

    -- | Map the window and remove it from the 'WindowSet'.
    doIgnore :: ManageHook
    doIgnore :: ManageHook
    doIgnore = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> ManageHook) -> ManageHook
    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 -> X () -> Query ()
    forall a. X a -> Query a
    liftX (Window -> X ()
    reveal Window
    w) Query () -> ManageHook -> ManageHook
    forall a b. Query a -> Query b -> Query b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> (WindowSet -> WindowSet) -> ManageHook
    forall s. (s -> s) -> Query (Endo s)
    doF (Window -> WindowSet -> WindowSet
    forall a i l s sd.
    Ord a =>
    a -> StackSet i l a s sd -> StackSet i l a s sd
    W.delete Window
    w)

    -- | Move the window to a given workspace
    doShift :: WorkspaceId -> ManageHook
    doShift :: WorkspaceId -> ManageHook
    doShift WorkspaceId
    i = (WindowSet -> WindowSet) -> ManageHook
    forall s. (s -> s) -> Query (Endo s)
    doF ((WindowSet -> WindowSet) -> ManageHook)
    -> (Window -> WindowSet -> WindowSet) -> Window -> ManageHook
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WorkspaceId -> Window -> WindowSet -> WindowSet
    forall a s i l sd.
    (Ord a, Eq s, Eq i) =>
    i -> a -> StackSet i l a s sd -> StackSet i l a s sd
    W.shiftWin WorkspaceId
    i (Window -> ManageHook) -> Query Window -> ManageHook
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask