    -----------------------------------------------------------------------------
    -- |
    -- Module       : XMonad.Hooks.FadeInactive
    -- Description :  Set the _NET_WM_WINDOW_OPACITY atom for inactive windows.
    -- Copyright    : (c) 2008 Justin Bogner <mail@justinbogner.com>
    -- License      : BSD
    --
    -- Maintainer   : Justin Bogner <mail@justinbogner.com>
    -- Stability    : unstable
    -- Portability  : unportable
    --
    -- Makes XMonad set the _NET_WM_WINDOW_OPACITY atom for inactive windows,
    -- which causes those windows to become slightly translucent if something
    -- like xcompmgr is running
    -----------------------------------------------------------------------------
    module XMonad.Hooks.FadeInactive (
        -- * Usage
        -- $usage
        setOpacity,
        isUnfocused,
        isUnfocusedOnCurrentWS,
        fadeIn,
        fadeOut,
        fadeIf,
        fadeInactiveLogHook,
        fadeInactiveCurrentWSLogHook,
        fadeOutLogHook
        ) where

    import XMonad
    import XMonad.Prelude
    import qualified XMonad.StackSet as W

    -- $usage
    -- You can use this module with the following in your @xmonad.hs@:
    --
    -- > import XMonad
    -- > import XMonad.Hooks.FadeInactive
    -- >
    -- > myLogHook :: X ()
    -- > myLogHook = fadeInactiveLogHook fadeAmount
    -- >     where fadeAmount = 0.8
    -- >
    -- > main = xmonad def { logHook = myLogHook }
    --
    -- fadeAmount can be any rational between 0 and 1.
    -- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps>
    -- or something similar for this to do anything
    --
    -- For more detailed instructions on editing the logHook see
    -- <https://xmonad.org/TUTORIAL.html#make-xmonad-and-xmobar-talk-to-each-other the tutorial>.
    --
    -- For more detailed instructions on editing the layoutHook see
    -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
    -- "XMonad.Doc.Extending#Editing_the_layout_hook".

    -- | Converts a percentage to the format required for _NET_WM_WINDOW_OPACITY
    rationalToOpacity :: Integral a => Rational -> a
    rationalToOpacity :: forall a. Integral a => Rational -> a
    rationalToOpacity Rational
    perc
        | Rational
    perc Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    < Rational
    0 Bool -> Bool -> Bool
    || Rational
    perc Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    > Rational
    1 = Rational -> a
    forall a. Integral a => Rational -> a
    forall a b. (RealFrac a, Integral b) => a -> b
    round Rational
    perc -- to maintain backwards-compatability
        | Bool
    otherwise = Rational -> a
    forall a. Integral a => Rational -> a
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Rational -> a) -> Rational -> a
    forall a b. (a -> b) -> a -> b
    $ Rational
    perc Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    0xffffffff

    -- | Sets the opacity of a window
    setOpacity :: Window -> Rational -> X ()
    setOpacity :: Window -> Rational -> X ()
    setOpacity Window
    w Rational
    t = (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Display
    dpy -> do
        a <- String -> X Window
    getAtom String
    "_NET_WM_WINDOW_OPACITY"
        io $ changeProperty32 dpy w a cARDINAL propModeReplace [rationalToOpacity t]

    -- | Fades a window out by setting the opacity
    fadeOut :: Rational -> Window -> X ()
    fadeOut :: Rational -> Window -> X ()
    fadeOut = (Window -> Rational -> X ()) -> Rational -> Window -> X ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Window -> Rational -> X ()
    setOpacity

    -- | Makes a window completely opaque
    fadeIn :: Window -> X ()
    fadeIn :: Window -> X ()
    fadeIn = Rational -> Window -> X ()
    fadeOut Rational
    1

    -- | Fades a window by the specified amount if it satisfies the first query, otherwise
    -- makes it opaque.
    fadeIf :: Query Bool -> Rational -> Query Rational
    fadeIf :: Query Bool -> Rational -> Query Rational
    fadeIf Query Bool
    qry Rational
    amt = Query Bool
    qry Query Bool -> (Bool -> Query Rational) -> Query Rational
    forall a b. Query a -> (a -> Query b) -> Query b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Bool
    b -> Rational -> Query Rational
    forall a. a -> Query a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Rational -> Query Rational) -> Rational -> Query Rational
    forall a b. (a -> b) -> a -> b
    $ if Bool
    b then Rational
    amt else Rational
    1

    -- | Sets the opacity of inactive windows to the specified amount
    fadeInactiveLogHook :: Rational -> X ()
    fadeInactiveLogHook :: Rational -> X ()
    fadeInactiveLogHook = Query Rational -> X ()
    fadeOutLogHook (Query Rational -> X ())
    -> (Rational -> Query Rational) -> Rational -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Query Bool -> Rational -> Query Rational
    fadeIf Query Bool
    isUnfocused

    -- | Set the opacity of inactive windows, on the current workspace, to the
    -- specified amount. This is specifically usefull in a multi monitor setup. See
    -- 'isUnfocusedOnCurrentWS'.
    fadeInactiveCurrentWSLogHook :: Rational -> X ()
    fadeInactiveCurrentWSLogHook :: Rational -> X ()
    fadeInactiveCurrentWSLogHook = Query Rational -> X ()
    fadeOutLogHook (Query Rational -> X ())
    -> (Rational -> Query Rational) -> Rational -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Query Bool -> Rational -> Query Rational
    fadeIf Query Bool
    isUnfocusedOnCurrentWS

    -- | Returns True if the window doesn't have the focus.
    isUnfocused :: Query Bool
    isUnfocused :: Query Bool
    isUnfocused = 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)
    -> ((XState -> Bool) -> X Bool) -> (XState -> Bool) -> Query Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (XState -> Bool) -> X Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XState -> Bool) -> Query Bool) -> (XState -> Bool) -> Query Bool
    forall a b. (a -> b) -> a -> b
    $ (Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    w Maybe Window -> Maybe Window -> Bool
    forall a. Eq a => a -> a -> Bool
    /=) (Maybe Window -> Bool)
    -> (XState -> Maybe Window) -> XState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe Window
    forall i l a s sd. StackSet i l a s sd -> Maybe a
    W.peek (StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> Maybe Window)
    -> (XState
        -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Maybe Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset

    -- | Returns True if the window doesn't have the focus, and the window is on the
    -- current workspace. This is specifically handy in a multi monitor setup
    -- (xinerama) where multiple workspaces are visible. Using this, non-focused
    -- workspaces are are not faded out making it easier to look and read the
    -- content on them.
    isUnfocusedOnCurrentWS :: Query Bool
    isUnfocusedOnCurrentWS :: Query Bool
    isUnfocusedOnCurrentWS = do
      w <- Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask
      ws <- liftX $ gets windowset
      let thisWS = Window
    w Window -> [Window] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> [Window]
    forall i l a s sd. StackSet i l a s sd -> [a]
    W.index StackSet String (Layout Window) Window ScreenId ScreenDetail
    ws
          unfocused = Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    w Maybe Window -> Maybe Window -> Bool
    forall a. Eq a => a -> a -> Bool
    /= StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe Window
    forall i l a s sd. StackSet i l a s sd -> Maybe a
    W.peek StackSet String (Layout Window) Window ScreenId ScreenDetail
    ws
      return $ thisWS && unfocused

    -- | Fades out every window by the amount returned by the query.
    fadeOutLogHook :: Query Rational -> X ()
    fadeOutLogHook :: Query Rational -> X ()
    fadeOutLogHook Query Rational
    qry = (StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> X ())
    -> X ()
    forall a.
    (StackSet String (Layout Window) Window ScreenId ScreenDetail
     -> X a)
    -> X a
    withWindowSet ((StackSet String (Layout Window) Window ScreenId ScreenDetail
      -> X ())
     -> X ())
    -> (StackSet String (Layout Window) Window ScreenId ScreenDetail
        -> X ())
    -> X ()
    forall a b. (a -> b) -> a -> b
    $ \StackSet String (Layout Window) Window ScreenId ScreenDetail
    s -> do
        let visibleWins :: [Window]
    visibleWins = (Maybe (Stack Window) -> [Window]
    forall a. Maybe (Stack a) -> [a]
    W.integrate' (Maybe (Stack Window) -> [Window])
    -> (StackSet String (Layout Window) Window ScreenId ScreenDetail
        -> Maybe (Stack Window))
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace String (Layout Window) Window -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
    -> (StackSet String (Layout Window) Window ScreenId ScreenDetail
        -> Workspace String (Layout Window) Window)
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
     -> Workspace String (Layout Window) Window)
    -> (StackSet String (Layout Window) Window ScreenId ScreenDetail
        -> Screen String (Layout Window) Window ScreenId ScreenDetail)
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Screen String (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 String (Layout Window) Window ScreenId ScreenDetail
     -> [Window])
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> [Window]
    forall a b. (a -> b) -> a -> b
    $ StackSet String (Layout Window) Window ScreenId ScreenDetail
    s) [Window] -> [Window] -> [Window]
    forall a. [a] -> [a] -> [a]
    ++
                          (Screen String (Layout Window) Window ScreenId ScreenDetail
     -> [Window])
    -> [Screen String (Layout Window) Window ScreenId ScreenDetail]
    -> [Window]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Maybe (Stack Window) -> [Window]
    forall a. Maybe (Stack a) -> [a]
    W.integrate' (Maybe (Stack Window) -> [Window])
    -> (Screen String (Layout Window) Window ScreenId ScreenDetail
        -> Maybe (Stack Window))
    -> Screen String (Layout Window) Window ScreenId ScreenDetail
    -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace String (Layout Window) Window -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
    -> (Screen String (Layout Window) Window ScreenId ScreenDetail
        -> Workspace String (Layout Window) Window)
    -> Screen String (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace) (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> [Screen String (Layout Window) Window ScreenId ScreenDetail]
    forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
    W.visible StackSet String (Layout Window) Window ScreenId ScreenDetail
    s)
        [Window] -> (Window -> X ()) -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Window]
    visibleWins ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ ((Rational -> X ()) -> X Rational -> X ())
    -> (Window -> Rational -> X ())
    -> (Window -> X Rational)
    -> Window
    -> X ()
    forall a b c.
    (a -> b -> c) -> (Window -> a) -> (Window -> b) -> Window -> c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (Rational -> X ()) -> X Rational -> X ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    (=<<) Window -> Rational -> X ()
    setOpacity (Query Rational -> Window -> X Rational
    forall a. Query a -> Window -> X a
    runQuery Query Rational
    qry)