    {-# LANGUAGE FlexibleInstances #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Hooks.FadeWindows
    -- Description :  A more flexible and general compositing interface than FadeInactive.
    -- Copyright   :  Brandon S Allbery KF8NH <allbery.b@gmail.com>
    -- License     :  BSD
    --
    -- Maintainer  :  Brandon S Allbery KF8NH
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- A more flexible and general compositing interface than FadeInactive.
    -- Windows can be selected and opacity specified by means of FadeHooks,
    -- which are very similar to ManageHooks and use the same machinery.
    --
    -----------------------------------------------------------------------------

    module XMonad.Hooks.FadeWindows (-- * Usage
                                     -- $usage

                                     -- * The 'logHook' for window fading
                                     fadeWindowsLogHook

                                     -- * The 'FadeHook'
                                    ,FadeHook
                                    ,Opacity
                                    ,idFadeHook

                                     -- * Predefined 'FadeHook's
                                    ,opaque
                                    ,solid
                                    ,transparent
                                    ,invisible
                                    ,transparency
                                    ,translucence
                                    ,fadeBy
                                    ,opacity
                                    ,fadeTo

                                    -- * 'handleEventHook' for mapped/unmapped windows
                                    ,fadeWindowsEventHook

                                    -- * 'doF' for simple hooks
                                    ,doS

                                    -- * Useful 'Query's for 'FadeHook's
                                    ,isFloating
                                    ,isUnfocused
                                    ) where

    import           XMonad.Core
    import           XMonad.Prelude
    import           XMonad.ManageHook                       (liftX)
    import qualified XMonad.StackSet             as W

    import           XMonad.Hooks.FadeInactive               (setOpacity
                                                             ,isUnfocused
                                                             )

    import           Control.Monad.Reader                    (ask
                                                             ,asks)
    import           Control.Monad.State                     (gets)
    import qualified Data.Map                    as M

    import           Graphics.X11.Xlib.Extras                (Event(..))

    -- $usage
    -- To use this module, make sure your @xmonad@ core supports generalized
    -- 'ManageHook's (check the type of 'idHook'; if it's @ManageHook@ then
    -- your @xmonad@ is too old) and then add @fadeWindowsLogHook@ to your
    -- 'logHook' and @fadeWindowsEventHook@ to your 'handleEventHook':
    --
    -- >     , logHook = fadeWindowsLogHook myFadeHook
    -- >     , handleEventHook = fadeWindowsEventHook
    -- >     {- ... -}
    -- >
    -- > myFadeHook = composeAll [                 opaque
    -- >                         , isUnfocused --> transparency 0.2
    -- >                         ]
    --
    -- The above is like FadeInactive with a fade value of 0.2.
    --
    -- 'FadeHook's do not accumulate; instead, they compose from right to
    -- left like 'ManageHook's, so in the above example @myFadeHook@ will
    -- render unfocused windows at 4/5 opacity and the focused window as
    -- opaque.  This means that, in particular, the order in the above
    -- example is important.
    --
    -- The 'opaque' hook above is optional, by the way, as any unmatched
    -- window will be opaque by default.  If you want to make all windows a
    -- bit transparent by default, you can replace 'opaque' with something
    -- like
    --
    -- > transparency 0.93
    --
    -- at the top of @myFadeHook@.
    --
    -- This module is best used with "XMonad.Hooks.MoreManageHelpers", which
    -- exports a number of Queries that can be used in either @ManageHook@
    -- or @FadeHook@.
    --
    -- Note that you need a compositing manager such as @xcompmgr@,
    -- @dcompmgr@, or @cairo-compmgr@ for window fading to work.  If you
    -- aren't running a compositing manager, the opacity will be recorded
    -- but won't take effect until a compositing manager is started.
    --
    -- For more detailed instructions on editing the 'logHook' see:
    --
    -- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
    --
    -- For more detailed instructions on editing the 'handleEventHook',
    -- see:
    --
    -- "XMonad.Doc.Extending#Editing_the_event_hook"
    -- (which sadly doesnt exist at the time of writing...)
    --
    -- /WARNING:/  This module is very good at triggering bugs in
    -- compositing managers.  Symptoms range from windows not being
    -- repainted until the compositing manager is restarted or the
    -- window is unmapped and remapped, to the machine becoming sluggish
    -- until the compositing manager is restarted (at which point a
    -- popup/dialog will suddenly appear; apparently it's getting into
    -- a tight loop trying to fade the popup in).  I find it useful to
    -- have a key binding to restart the compositing manager; for example,
    --
    -- main = xmonad $ def {
    --                   {- ... -}
    --                 }
    --                 `additionalKeysP`
    --                 [("M-S-4",spawn "killall xcompmgr; sleep 1; xcompmgr -cCfF &")]
    --                 {- ... -}
    --                 ]
    --
    -- (See "XMonad.Util.EZConfig" for 'additionalKeysP'.)

    -- a window opacity to be carried in a Query.  OEmpty is sort of a hack
    -- to make it obay the monoid laws
    data Opacity = Opacity Rational | OEmpty

    instance Semigroup Opacity where
      Opacity
    r <> :: Opacity -> Opacity -> Opacity
    <> Opacity
    OEmpty = Opacity
    r
      Opacity
    _ <> Opacity
    r      = Opacity
    r

    instance Monoid Opacity where
      mempty :: Opacity
    mempty                  = Opacity
    OEmpty

    -- | A FadeHook is similar to a ManageHook, but records window opacity.
    type FadeHook = Query Opacity

    -- | Render a window fully opaque.
    opaque :: FadeHook
    opaque :: FadeHook
    opaque =  Opacity -> FadeHook
    forall m. Monoid m => m -> Query m
    doS (Rational -> Opacity
    Opacity Rational
    1)

    -- | Render a window fully transparent.
    transparent :: FadeHook
    transparent :: FadeHook
    transparent =  Opacity -> FadeHook
    forall m. Monoid m => m -> Query m
    doS (Rational -> Opacity
    Opacity Rational
    0)

    -- | Specify a window's transparency.
    transparency :: Rational -- ^ The window's transparency as a fraction.
                             --   @transparency 1@ is the same as 'transparent',
                             --   whereas @transparency 0@ is the same as 'opaque'.
                 -> FadeHook
    transparency :: Rational -> FadeHook
    transparency =  Opacity -> FadeHook
    forall m. Monoid m => m -> Query m
    doS (Opacity -> FadeHook)
    -> (Rational -> Opacity) -> Rational -> FadeHook
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rational -> Opacity
    Opacity (Rational -> Opacity)
    -> (Rational -> Rational) -> Rational -> Opacity
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Rational
    1Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    -) (Rational -> Rational)
    -> (Rational -> Rational) -> Rational -> Rational
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rational -> Rational
    clampRatio

    -- | Specify a window's opacity; this is the inverse of 'transparency'.
    opacity :: Rational -- ^ The opacity of a window as a fraction.
                        --   @opacity 1@ is the same as 'opaque',
                        --   whereas @opacity 0@ is the same as 'transparent'.
            -> FadeHook
    opacity :: Rational -> FadeHook
    opacity =  Opacity -> FadeHook
    forall m. Monoid m => m -> Query m
    doS (Opacity -> FadeHook)
    -> (Rational -> Opacity) -> Rational -> FadeHook
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rational -> Opacity
    Opacity (Rational -> Opacity)
    -> (Rational -> Rational) -> Rational -> Opacity
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rational -> Rational
    clampRatio

    fadeTo, translucence, fadeBy :: Rational -> FadeHook
    -- | An alias for 'transparency'.
    fadeTo :: Rational -> FadeHook
    fadeTo       = Rational -> FadeHook
    transparency
    -- | An alias for 'transparency'.
    translucence :: Rational -> FadeHook
    translucence = Rational -> FadeHook
    transparency
    -- | An alias for 'opacity'.
    fadeBy :: Rational -> FadeHook
    fadeBy       = Rational -> FadeHook
    opacity

    invisible, solid :: FadeHook
    -- | An alias for 'transparent'.
    invisible :: FadeHook
    invisible    = FadeHook
    transparent
    -- | An alias for 'opaque'.
    solid :: FadeHook
    solid        = FadeHook
    opaque

    -- | Like 'doF', but usable with 'ManageHook'-like hooks that
    -- aren't 'Query' wrapped around transforming functions ('Endo').
    doS :: Monoid m => m -> Query m
    doS :: forall m. Monoid m => m -> Query m
    doS =  m -> Query m
    forall a. a -> Query a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    -- | The identity 'FadeHook', which renders windows 'opaque'.
    idFadeHook :: FadeHook
    idFadeHook :: FadeHook
    idFadeHook =  FadeHook
    opaque

    -- | A Query to determine if a window is floating.
    isFloating :: Query Bool
    isFloating :: Query Bool
    isFloating =  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 -> Map Window RationalRect -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    M.member Window
    w (Map Window RationalRect -> Bool)
    -> (XState -> Map Window RationalRect) -> XState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Map Window RationalRect
    forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
    W.floating (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
     -> Map Window RationalRect)
    -> (XState
        -> StackSet
             WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Map Window RationalRect
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    windowset

    -- boring windows can't be seen outside of a layout, so we watch messages with
    -- a dummy LayoutModifier and stow them in a persistent bucket.  this is not
    -- entirely reliable given that boringAuto still isn't observable; we just hope
    -- those aren't visible and won;t be affected anyway
    -- @@@ punted for now, will be a separate module.  it's still slimy, though

    -- | A 'logHook' to fade windows under control of a 'FadeHook', which is
    --   similar to but not identical to 'ManageHook'.
    fadeWindowsLogHook   :: FadeHook -> X ()
    fadeWindowsLogHook :: FadeHook -> X ()
    fadeWindowsLogHook FadeHook
    h =  (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
     -> X ())
    -> X ()
    forall a.
    (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
     -> X a)
    -> X a
    withWindowSet ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
      -> X ())
     -> X ())
    -> (StackSet
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail
        -> X ())
    -> X ()
    forall a b. (a -> b) -> a -> b
    $ \StackSet WorkspaceId (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
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail
        -> Maybe (Stack Window))
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace WorkspaceId (Layout Window) Window
    -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack (Workspace WorkspaceId (Layout Window) Window
     -> Maybe (Stack Window))
    -> (StackSet
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail
        -> Workspace WorkspaceId (Layout Window) Window)
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window)
    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)
    -> (StackSet
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail
        -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WorkspaceId (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> 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 (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
     -> [Window])
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> [Window]
    forall a b. (a -> b) -> a -> b
    $ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    s) [Window] -> [Window] -> [Window]
    forall a. [a] -> [a] -> [a]
    ++
                        (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
     -> [Window])
    -> [Screen
          WorkspaceId (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 WorkspaceId (Layout Window) Window ScreenId ScreenDetail
        -> Maybe (Stack Window))
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace WorkspaceId (Layout Window) Window
    -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack (Workspace WorkspaceId (Layout Window) Window
     -> Maybe (Stack Window))
    -> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
        -> Workspace WorkspaceId (Layout Window) Window)
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window)
    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) (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> [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.visible StackSet WorkspaceId (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
    $ \Window
    w -> do
        Opacity
    o <- Opacity -> X Opacity -> X Opacity
    forall a. a -> X a -> X a
    userCodeDef (Rational -> Opacity
    Opacity Rational
    1) (FadeHook -> Window -> X Opacity
    forall a. Query a -> Window -> X a
    runQuery FadeHook
    h Window
    w)
        Window -> Rational -> X ()
    setOpacity Window
    w (Rational -> X ()) -> Rational -> X ()
    forall a b. (a -> b) -> a -> b
    $ case Opacity
    o of
                         Opacity
    OEmpty    -> Rational
    1
                         Opacity Rational
    r -> Rational
    r

    -- | A 'handleEventHook' to handle fading and unfading of newly mapped
    --   or unmapped windows; this avoids problems with layouts such as
    --   "XMonad.Layout.Full" or "XMonad.Layout.Tabbed".  This hook may
    --   also be useful with "XMonad.Hooks.FadeInactive".
    fadeWindowsEventHook                     :: Event -> X All
    fadeWindowsEventHook :: Event -> X All
    fadeWindowsEventHook MapNotifyEvent{} =
      -- we need to run the fadeWindowsLogHook.  only one way...
      (XConf -> XConfig Layout) -> X (XConfig Layout)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> XConfig Layout
    config X (XConfig Layout) -> (XConfig Layout -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= XConfig Layout -> X ()
    forall (l :: * -> *). XConfig l -> X ()
    logHook 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)
    fadeWindowsEventHook Event
    _                   =  All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)

    -- A utility to clamp opacity fractions to the range (0,1)
    clampRatio   :: Rational         -> Rational
    clampRatio :: Rational -> Rational
    clampRatio Rational
    r |  Rational
    r Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Rational
    0 Bool -> Bool -> Bool
    && Rational
    r Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Rational
    1 =  Rational
    r
                 |  Rational
    r Rational -> Rational -> Bool
    forall a. Ord a => a -> a -> Bool
    < Rational
    0            =  Rational
    0
                 |  Bool
    otherwise        =  Rational
    1