    {-# LANGUAGE CPP                   #-}
    {-# LANGUAGE FlexibleContexts      #-}
    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE PatternGuards         #-}
    {-# LANGUAGE TupleSections         #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.Decoration
    -- Description :  A layout modifier and a class for easily creating decorated layouts.
    -- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger
    -- License     :  BSD-style (see xmonad/LICENSE)
    --
    -- Maintainer  :  andrea.rossato@unibz.it
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- A layout modifier and a class for easily creating decorated
    -- layouts.
    -----------------------------------------------------------------------------

    module XMonad.Layout.Decoration
        ( -- * Usage:
          -- $usage
          decoration
        , Theme (..), def
        , Decoration
        , DecorationMsg (..)
        , DecorationStyle (..)
        , DefaultDecoration (..)
        , Shrinker (..), DefaultShrinker
        , shrinkText, CustomShrink ( CustomShrink ), shrinkWhile
        , isInStack, isVisible, isInvisible, isWithin, fi
        , findWindowByDecoration
        , module XMonad.Layout.LayoutModifier
        , DecorationState, OrigWin
        ) where

    import Foreign.C.Types(CInt)

    import XMonad
    import XMonad.Prelude
    import qualified XMonad.StackSet as W
    import XMonad.Hooks.UrgencyHook
    import XMonad.Layout.LayoutModifier
    import XMonad.Layout.WindowArranger (WindowArrangerMsg (..), diff, listFromList)
    import XMonad.Util.NamedWindows (getName)
    import XMonad.Util.Invisible
    import XMonad.Util.XUtils
    import XMonad.Util.Font
    import XMonad.Util.Image

    -- $usage
    -- This module is intended for layout developers, who want to decorate
    -- their layouts. End users will not find here very much for them.
    --
    -- For examples of 'DecorationStyle' instances you can have a look at
    -- "XMonad.Layout.SimpleDecoration", "XMonad.Layout.Tabbed",
    -- "XMonad.Layout.DwmStyle", or "XMonad.Layout.TabBarDecoration".

    -- | A layout modifier that, with a 'Shrinker', a 'Theme', a
    -- 'DecorationStyle', and a layout, will decorate this layout
    -- according to the decoration style provided.
    --
    -- For some usage examples see "XMonad.Layout.DecorationMadness".
    decoration :: (DecorationStyle ds a, Shrinker s) => s -> Theme -> ds a
               -> l a -> ModifiedLayout (Decoration ds s) l a
    decoration :: forall (ds :: * -> *) a s (l :: * -> *).
    (DecorationStyle ds a, Shrinker s) =>
    s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
    decoration s
    s Theme
    t ds a
    ds = Decoration ds s a -> l a -> ModifiedLayout (Decoration ds s) l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout (Invisible Maybe DecorationState
    -> s -> Theme -> ds a -> Decoration ds s a
    forall (ds :: * -> *) s a.
    Invisible Maybe DecorationState
    -> s -> Theme -> ds a -> Decoration ds s a
    Decoration (Maybe DecorationState -> Invisible Maybe DecorationState
    forall (m :: * -> *) a. m a -> Invisible m a
    I Maybe DecorationState
    forall a. Maybe a
    Nothing) s
    s Theme
    t ds a
    ds)

    -- | A 'Theme' is a record of colors, font etc., to customize a
    -- 'DecorationStyle'.
    --
    -- For a collection of 'Theme's see "XMonad.Util.Themes"
    data Theme =
        Theme { Theme -> String
    activeColor         :: String                  -- ^ Color of the active window
              , Theme -> String
    inactiveColor       :: String                  -- ^ Color of the inactive window
              , Theme -> String
    urgentColor         :: String                  -- ^ Color of the urgent window
              , Theme -> String
    activeBorderColor   :: String                  -- ^ Color of the border of the active window
              , Theme -> String
    inactiveBorderColor :: String                  -- ^ Color of the border of the inactive window
              , Theme -> String
    urgentBorderColor   :: String                  -- ^ Color of the border of the urgent window
              , Theme -> Dimension
    activeBorderWidth   :: Dimension               -- ^ Width of the border of the active window
              , Theme -> Dimension
    inactiveBorderWidth :: Dimension               -- ^ Width of the border of the inactive window
              , Theme -> Dimension
    urgentBorderWidth   :: Dimension               -- ^ Width of the border of the urgent window
              , Theme -> String
    activeTextColor     :: String                  -- ^ Color of the text of the active window
              , Theme -> String
    inactiveTextColor   :: String                  -- ^ Color of the text of the inactive window
              , Theme -> String
    urgentTextColor     :: String                  -- ^ Color of the text of the urgent window
              , Theme -> String
    fontName            :: String                  -- ^ Font name
              , Theme -> Dimension
    decoWidth           :: Dimension               -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')
              , Theme -> Dimension
    decoHeight          :: Dimension               -- ^ Height of the decorations
              , Theme -> [(String, Align)]
    windowTitleAddons   :: [(String, Align)]       -- ^ Extra text to appear in a window's title bar.
                                                               --    Refer to for a use "XMonad.Layout.ImageButtonDecoration"
              , Theme -> [([[Bool]], Placement)]
    windowTitleIcons    :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar.
                                                               --    Inner @[Bool]@ is a row in a icon bitmap.
              } deriving (Int -> Theme -> ShowS
    [Theme] -> ShowS
    Theme -> String
    (Int -> Theme -> ShowS)
    -> (Theme -> String) -> ([Theme] -> ShowS) -> Show Theme
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Theme -> ShowS
    showsPrec :: Int -> Theme -> ShowS
    $cshow :: Theme -> String
    show :: Theme -> String
    $cshowList :: [Theme] -> ShowS
    showList :: [Theme] -> ShowS
    Show, ReadPrec [Theme]
    ReadPrec Theme
    Int -> ReadS Theme
    ReadS [Theme]
    (Int -> ReadS Theme)
    -> ReadS [Theme]
    -> ReadPrec Theme
    -> ReadPrec [Theme]
    -> Read Theme
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS Theme
    readsPrec :: Int -> ReadS Theme
    $creadList :: ReadS [Theme]
    readList :: ReadS [Theme]
    $creadPrec :: ReadPrec Theme
    readPrec :: ReadPrec Theme
    $creadListPrec :: ReadPrec [Theme]
    readListPrec :: ReadPrec [Theme]
    Read)

    -- | The default xmonad 'Theme'.
    instance Default Theme where
      def :: Theme
    def =
        Theme { activeColor :: String
    activeColor         = String
    "#999999"
              , inactiveColor :: String
    inactiveColor       = String
    "#666666"
              , urgentColor :: String
    urgentColor         = String
    "#FFFF00"
              , activeBorderColor :: String
    activeBorderColor   = String
    "#FFFFFF"
              , inactiveBorderColor :: String
    inactiveBorderColor = String
    "#BBBBBB"
              , urgentBorderColor :: String
    urgentBorderColor   = String
    "##00FF00"
              , activeBorderWidth :: Dimension
    activeBorderWidth   = Dimension
    1
              , inactiveBorderWidth :: Dimension
    inactiveBorderWidth = Dimension
    1
              , urgentBorderWidth :: Dimension
    urgentBorderWidth   = Dimension
    1
              , activeTextColor :: String
    activeTextColor     = String
    "#FFFFFF"
              , inactiveTextColor :: String
    inactiveTextColor   = String
    "#BFBFBF"
              , urgentTextColor :: String
    urgentTextColor     = String
    "#FF0000"
    #ifdef XFT
              , fontName :: String
    fontName            = String
    "xft:monospace"
    #else
              , fontName            = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
    #endif
              , decoWidth :: Dimension
    decoWidth           = Dimension
    200
              , decoHeight :: Dimension
    decoHeight          = Dimension
    20
              , windowTitleAddons :: [(String, Align)]
    windowTitleAddons   = []
              , windowTitleIcons :: [([[Bool]], Placement)]
    windowTitleIcons    = []
              }

    -- | A 'Decoration' layout modifier will handle 'SetTheme', a message
    -- to dynamically change the decoration 'Theme'.
    newtype DecorationMsg = SetTheme Theme
    instance Message DecorationMsg

    -- | The 'Decoration' state component, where the list of decorated
    -- window's is zipped with a list of decoration. A list of decoration
    -- is a list of tuples, a 'Maybe' 'Window' and a 'Maybe Rectangle'.
    -- The 'Window' will be displayed only if the rectangle is of type
    -- 'Just'.
    data DecorationState =
        DS { DecorationState -> [(OrigWin, DecoWin)]
    decos :: [(OrigWin,DecoWin)]
           , DecorationState -> XMonadFont
    font  :: XMonadFont
           }
    type DecoWin = (Maybe Window, Maybe Rectangle)
    type OrigWin = (Window,Rectangle)

    -- | The 'Decoration' 'LayoutModifier'. This data type is an instance
    -- of the 'LayoutModifier' class. This data type will be passed,
    -- together with a layout, to the 'ModifiedLayout' type constructor
    -- to modify the layout by adding decorations according to a
    -- 'DecorationStyle'.
    data Decoration ds s a =
        Decoration (Invisible Maybe DecorationState) s Theme (ds a)
        deriving (Int -> Decoration ds s a -> ShowS
    [Decoration ds s a] -> ShowS
    Decoration ds s a -> String
    (Int -> Decoration ds s a -> ShowS)
    -> (Decoration ds s a -> String)
    -> ([Decoration ds s a] -> ShowS)
    -> Show (Decoration ds s a)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall (ds :: * -> *) s a.
    (Show s, Show (ds a)) =>
    Int -> Decoration ds s a -> ShowS
    forall (ds :: * -> *) s a.
    (Show s, Show (ds a)) =>
    [Decoration ds s a] -> ShowS
    forall (ds :: * -> *) s a.
    (Show s, Show (ds a)) =>
    Decoration ds s a -> String
    $cshowsPrec :: forall (ds :: * -> *) s a.
    (Show s, Show (ds a)) =>
    Int -> Decoration ds s a -> ShowS
    showsPrec :: Int -> Decoration ds s a -> ShowS
    $cshow :: forall (ds :: * -> *) s a.
    (Show s, Show (ds a)) =>
    Decoration ds s a -> String
    show :: Decoration ds s a -> String
    $cshowList :: forall (ds :: * -> *) s a.
    (Show s, Show (ds a)) =>
    [Decoration ds s a] -> ShowS
    showList :: [Decoration ds s a] -> ShowS
    Show, ReadPrec [Decoration ds s a]
    ReadPrec (Decoration ds s a)
    Int -> ReadS (Decoration ds s a)
    ReadS [Decoration ds s a]
    (Int -> ReadS (Decoration ds s a))
    -> ReadS [Decoration ds s a]
    -> ReadPrec (Decoration ds s a)
    -> ReadPrec [Decoration ds s a]
    -> Read (Decoration ds s a)
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    forall (ds :: * -> *) s a.
    (Read s, Read (ds a)) =>
    ReadPrec [Decoration ds s a]
    forall (ds :: * -> *) s a.
    (Read s, Read (ds a)) =>
    ReadPrec (Decoration ds s a)
    forall (ds :: * -> *) s a.
    (Read s, Read (ds a)) =>
    Int -> ReadS (Decoration ds s a)
    forall (ds :: * -> *) s a.
    (Read s, Read (ds a)) =>
    ReadS [Decoration ds s a]
    $creadsPrec :: forall (ds :: * -> *) s a.
    (Read s, Read (ds a)) =>
    Int -> ReadS (Decoration ds s a)
    readsPrec :: Int -> ReadS (Decoration ds s a)
    $creadList :: forall (ds :: * -> *) s a.
    (Read s, Read (ds a)) =>
    ReadS [Decoration ds s a]
    readList :: ReadS [Decoration ds s a]
    $creadPrec :: forall (ds :: * -> *) s a.
    (Read s, Read (ds a)) =>
    ReadPrec (Decoration ds s a)
    readPrec :: ReadPrec (Decoration ds s a)
    $creadListPrec :: forall (ds :: * -> *) s a.
    (Read s, Read (ds a)) =>
    ReadPrec [Decoration ds s a]
    readListPrec :: ReadPrec [Decoration ds s a]
    Read)

    -- | The 'DecorationStyle' class, defines methods used in the
    -- implementation of the 'Decoration' 'LayoutModifier' instance. A
    -- type instance of this class is passed to the 'Decoration' type in
    -- order to decorate a layout, by using these methods.
    class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where

        -- | The description that the 'Decoration' modifier will display.
        describeDeco :: ds a -> String
        describeDeco = ds a -> String
    forall a. Show a => a -> String
    show

        -- | Shrink the window's rectangle when applying a decoration.
        shrink :: ds a -> Rectangle -> Rectangle -> Rectangle
        shrink ds a
    _ (Rectangle Position
    _ Position
    _ Dimension
    _ Dimension
    dh) (Rectangle Position
    x Position
    y Dimension
    w Dimension
    h) = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x (Position
    y Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    dh) Dimension
    w (Dimension
    h Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    dh)

        -- | The decoration event hook
        decorationEventHook :: ds a -> DecorationState -> Event -> X ()
        decorationEventHook = ds a -> DecorationState -> Event -> X ()
    forall (ds :: * -> *) a.
    DecorationStyle ds a =>
    ds a -> DecorationState -> Event -> X ()
    handleMouseFocusDrag

        -- | A hook that can be used to catch the cases when the user
        -- clicks on the decoration. If you return True here, the click event
        -- will be considered as dealt with and no further processing will take place.
        decorationCatchClicksHook :: ds a
                                  -> Window
                                  -> Int    -- ^ distance from the left where the click happened on the decoration
                                  -> Int    -- ^ distance from the right where the click happened on the decoration
                                  -> X Bool
        decorationCatchClicksHook ds a
    _ Window
    _ Int
    _ Int
    _ = Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

        -- | This hook is called while a window is dragged using the decoration.
        -- The hook can be overwritten if a different way of handling the dragging
        -- is required.
        decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
        decorationWhileDraggingHook ds a
    _ = CInt -> CInt -> OrigWin -> Position -> Position -> X ()
    handleDraggingInProgress

        -- | This hoook is called after a window has been dragged using the decoration.
        decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X ()
        decorationAfterDraggingHook ds a
    _ds (Window
    mainw, Rectangle
    _r) Window
    _decoWin = Window -> X ()
    focus Window
    mainw

        -- | The pure version of the main method, 'decorate'.
        pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle
                       -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> Maybe Rectangle
        pureDecoration ds a
    _ Dimension
    _ Dimension
    ht Rectangle
    _ Stack a
    s [(a, Rectangle)]
    _ (a
    w,Rectangle Position
    x Position
    y Dimension
    wh Dimension
    ht') = if Stack a -> a -> Bool
    forall a. Eq a => Stack a -> a -> Bool
    isInStack Stack a
    s a
    w Bool -> Bool -> Bool
    && (Dimension
    ht Dimension -> Dimension -> Bool
    forall a. Ord a => a -> a -> Bool
    < Dimension
    ht')
                                                                 then Rectangle -> Maybe Rectangle
    forall a. a -> Maybe a
    Just (Rectangle -> Maybe Rectangle) -> Rectangle -> Maybe Rectangle
    forall a b. (a -> b) -> a -> b
    $ Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x Position
    y Dimension
    wh Dimension
    ht
                                                                 else Maybe Rectangle
    forall a. Maybe a
    Nothing

        -- | Given the theme's decoration width and height, the screen
        -- rectangle, the windows stack, the list of windows and
        -- rectangles returned by the underlying layout and window to be
        -- decorated, tupled with its rectangle, produce a 'Just'
        -- 'Rectangle' or 'Nothing' if the window is not to be decorated.
        decorate :: ds a -> Dimension -> Dimension -> Rectangle
                 -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> X (Maybe Rectangle)
        decorate ds a
    ds Dimension
    w Dimension
    h Rectangle
    r Stack a
    s [(a, Rectangle)]
    wrs (a, Rectangle)
    wr = Maybe Rectangle -> X (Maybe Rectangle)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Rectangle -> X (Maybe Rectangle))
    -> Maybe Rectangle -> X (Maybe Rectangle)
    forall a b. (a -> b) -> a -> b
    $ ds a
    -> Dimension
    -> Dimension
    -> Rectangle
    -> Stack a
    -> [(a, Rectangle)]
    -> (a, Rectangle)
    -> Maybe Rectangle
    forall (ds :: * -> *) a.
    DecorationStyle ds a =>
    ds a
    -> Dimension
    -> Dimension
    -> Rectangle
    -> Stack a
    -> [(a, Rectangle)]
    -> (a, Rectangle)
    -> Maybe Rectangle
    pureDecoration ds a
    ds Dimension
    w Dimension
    h Rectangle
    r Stack a
    s [(a, Rectangle)]
    wrs (a, Rectangle)
    wr

    -- | The default 'DecorationStyle', with just the default methods'
    -- implementations.
    data DefaultDecoration a = DefaultDecoration deriving ( ReadPrec [DefaultDecoration a]
    ReadPrec (DefaultDecoration a)
    Int -> ReadS (DefaultDecoration a)
    ReadS [DefaultDecoration a]
    (Int -> ReadS (DefaultDecoration a))
    -> ReadS [DefaultDecoration a]
    -> ReadPrec (DefaultDecoration a)
    -> ReadPrec [DefaultDecoration a]
    -> Read (DefaultDecoration a)
    forall a. ReadPrec [DefaultDecoration a]
    forall a. ReadPrec (DefaultDecoration a)
    forall a. Int -> ReadS (DefaultDecoration a)
    forall a. ReadS [DefaultDecoration a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Int -> ReadS (DefaultDecoration a)
    readsPrec :: Int -> ReadS (DefaultDecoration a)
    $creadList :: forall a. ReadS [DefaultDecoration a]
    readList :: ReadS [DefaultDecoration a]
    $creadPrec :: forall a. ReadPrec (DefaultDecoration a)
    readPrec :: ReadPrec (DefaultDecoration a)
    $creadListPrec :: forall a. ReadPrec [DefaultDecoration a]
    readListPrec :: ReadPrec [DefaultDecoration a]
    Read, Int -> DefaultDecoration a -> ShowS
    [DefaultDecoration a] -> ShowS
    DefaultDecoration a -> String
    (Int -> DefaultDecoration a -> ShowS)
    -> (DefaultDecoration a -> String)
    -> ([DefaultDecoration a] -> ShowS)
    -> Show (DefaultDecoration a)
    forall a. Int -> DefaultDecoration a -> ShowS
    forall a. [DefaultDecoration a] -> ShowS
    forall a. DefaultDecoration a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Int -> DefaultDecoration a -> ShowS
    showsPrec :: Int -> DefaultDecoration a -> ShowS
    $cshow :: forall a. DefaultDecoration a -> String
    show :: DefaultDecoration a -> String
    $cshowList :: forall a. [DefaultDecoration a] -> ShowS
    showList :: [DefaultDecoration a] -> ShowS
    Show )
    instance Eq a => DecorationStyle DefaultDecoration a

    -- | The long 'LayoutModifier' instance for the 'Decoration' type.
    --
    -- In 'redoLayout' we check the state: if there is no state we
    -- initialize it.
    --
    -- The state is 'diff'ed against the list of windows produced by the
    -- underlying layout: removed windows get deleted and new ones
    -- decorated by 'createDecos', which will call 'decorate' to decide if
    -- a window must be given a 'Rectangle', in which case a decoration
    -- window will be created.
    --
    -- After that we resync the updated state with the windows' list and
    -- then we process the resynced stated (as we do with a new state).
    --
    -- First we map the decoration windows, we update each decoration to
    -- reflect any decorated window's change, and we insert, in the list
    -- of windows and rectangles returned by the underlying layout, the
    -- decoration for each window. This way xmonad will restack the
    -- decorations and their windows accordingly. At the end we remove
    -- invisible\/stacked windows.
    --
    -- Message handling is quite simple: when needed we release the state
    -- component of the 'Decoration' 'LayoutModifier'. Otherwise we call
    -- 'handleEvent', which will call the appropriate 'DecorationStyle'
    -- methods to perform its tasks.
    instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where
        redoLayout :: Decoration ds s Window
    -> Rectangle
    -> Maybe (Stack Window)
    -> [OrigWin]
    -> X ([OrigWin], Maybe (Decoration ds s Window))
    redoLayout (Decoration (I (Just DecorationState
    s)) s
    sh Theme
    t ds Window
    ds) Rectangle
    _ Maybe (Stack Window)
    Nothing [OrigWin]
    _ = do
            DecorationState -> X ()
    releaseResources DecorationState
    s
            ([OrigWin], Maybe (Decoration ds s Window))
    -> X ([OrigWin], Maybe (Decoration ds s Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], Decoration ds s Window -> Maybe (Decoration ds s Window)
    forall a. a -> Maybe a
    Just (Decoration ds s Window -> Maybe (Decoration ds s Window))
    -> Decoration ds s Window -> Maybe (Decoration ds s Window)
    forall a b. (a -> b) -> a -> b
    $ Invisible Maybe DecorationState
    -> s -> Theme -> ds Window -> Decoration ds s Window
    forall (ds :: * -> *) s a.
    Invisible Maybe DecorationState
    -> s -> Theme -> ds a -> Decoration ds s a
    Decoration (Maybe DecorationState -> Invisible Maybe DecorationState
    forall (m :: * -> *) a. m a -> Invisible m a
    I Maybe DecorationState
    forall a. Maybe a
    Nothing) s
    sh Theme
    t ds Window
    ds)
        redoLayout Decoration ds s Window
    _                                 Rectangle
    _ Maybe (Stack Window)
    Nothing [OrigWin]
    _  = ([OrigWin], Maybe (Decoration ds s Window))
    -> X ([OrigWin], Maybe (Decoration ds s Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], Maybe (Decoration ds s Window)
    forall a. Maybe a
    Nothing)

        redoLayout (Decoration Invisible Maybe DecorationState
    st s
    sh Theme
    t ds Window
    ds) Rectangle
    sc (Just Stack Window
    stack) [OrigWin]
    wrs
            | I Maybe DecorationState
    Nothing  <- Invisible Maybe DecorationState
    st = Theme
    -> ds Window
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> X DecorationState
    forall (ds :: * -> *).
    DecorationStyle ds Window =>
    Theme
    -> ds Window
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> X DecorationState
    initState Theme
    t ds Window
    ds Rectangle
    sc Stack Window
    stack [OrigWin]
    wrs X DecorationState
    -> (DecorationState
        -> X ([OrigWin], Maybe (Decoration ds s Window)))
    -> X ([OrigWin], Maybe (Decoration ds s Window))
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= DecorationState -> X ([OrigWin], Maybe (Decoration ds s Window))
    processState
            | I (Just DecorationState
    s) <- Invisible Maybe DecorationState
    st = do let dwrs :: [(OrigWin, DecoWin)]
    dwrs  = DecorationState -> [(OrigWin, DecoWin)]
    decos DecorationState
    s
                                        ([Window]
    d,[Window]
    a) = (([Window], [Window]) -> ([Window], [Window]))
    -> [Window] -> [Window] -> ([Window], [Window])
    forall a b c. ((a, b) -> c) -> a -> b -> c
    curry ([Window], [Window]) -> ([Window], [Window])
    forall a. Eq a => ([a], [a]) -> ([a], [a])
    diff ([(OrigWin, DecoWin)] -> [Window]
    forall {b} {b} {b}. [((b, b), b)] -> [b]
    get_ws [(OrigWin, DecoWin)]
    dwrs) [Window]
    ws
                                        toDel :: [(OrigWin, DecoWin)]
    toDel = [Window] -> [(OrigWin, DecoWin)] -> [(OrigWin, DecoWin)]
    forall {t :: * -> *} {b} {b} {b}.
    (Foldable t, Eq b) =>
    t b -> [((b, b), b)] -> [((b, b), b)]
    todel [Window]
    d [(OrigWin, DecoWin)]
    dwrs
                                        toAdd :: [OrigWin]
    toAdd = [Window] -> [OrigWin] -> [OrigWin]
    forall {t :: * -> *} {b} {b}.
    (Foldable t, Eq b) =>
    t b -> [(b, b)] -> [(b, b)]
    toadd [Window]
    a [OrigWin]
    wrs
                                    [DecoWin] -> X ()
    deleteDecos (((OrigWin, DecoWin) -> DecoWin)
    -> [(OrigWin, DecoWin)] -> [DecoWin]
    forall a b. (a -> b) -> [a] -> [b]
    map (OrigWin, DecoWin) -> DecoWin
    forall a b. (a, b) -> b
    snd [(OrigWin, DecoWin)]
    toDel)
                                    let ndwrs :: [(OrigWin, (Maybe a, Maybe a))]
    ndwrs = (OrigWin -> (OrigWin, (Maybe a, Maybe a)))
    -> [OrigWin] -> [(OrigWin, (Maybe a, Maybe a))]
    forall a b. (a -> b) -> [a] -> [b]
    map (, (Maybe a
    forall a. Maybe a
    Nothing,Maybe a
    forall a. Maybe a
    Nothing)) [OrigWin]
    toAdd
                                    [(OrigWin, DecoWin)]
    ndecos <- [(OrigWin, DecoWin)] -> [OrigWin] -> X [(OrigWin, DecoWin)]
    forall {b} {b}.
    [((Window, b), (Maybe Window, b))]
    -> [OrigWin] -> X [(OrigWin, DecoWin)]
    resync ([(OrigWin, DecoWin)]
    forall {a} {a}. [(OrigWin, (Maybe a, Maybe a))]
    ndwrs [(OrigWin, DecoWin)]
    -> [(OrigWin, DecoWin)] -> [(OrigWin, DecoWin)]
    forall a. [a] -> [a] -> [a]
    ++ [Window] -> [(OrigWin, DecoWin)] -> [(OrigWin, DecoWin)]
    forall {b} {b}.
    [Window] -> [((Window, b), b)] -> [((Window, b), b)]
    del_dwrs [Window]
    d [(OrigWin, DecoWin)]
    dwrs) [OrigWin]
    wrs
                                    DecorationState -> X ([OrigWin], Maybe (Decoration ds s Window))
    processState (DecorationState
    s {decos = ndecos })

            where
              ws :: [Window]
    ws        = (OrigWin -> Window) -> [OrigWin] -> [Window]
    forall a b. (a -> b) -> [a] -> [b]
    map OrigWin -> Window
    forall a b. (a, b) -> a
    fst [OrigWin]
    wrs
              get_w :: ((c, b), b) -> c
    get_w     = (c, b) -> c
    forall a b. (a, b) -> a
    fst ((c, b) -> c) -> (((c, b), b) -> (c, b)) -> ((c, b), b) -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((c, b), b) -> (c, b)
    forall a b. (a, b) -> a
    fst
              get_ws :: [((b, b), b)] -> [b]
    get_ws    = (((b, b), b) -> b) -> [((b, b), b)] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map ((b, b), b) -> b
    forall {c} {b} {b}. ((c, b), b) -> c
    get_w
              del_dwrs :: [Window] -> [((Window, b), b)] -> [((Window, b), b)]
    del_dwrs  = (((Window, b), b) -> Window)
    -> (Window -> [Window] -> Bool)
    -> [Window]
    -> [((Window, b), b)]
    -> [((Window, b), b)]
    forall b c a. (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b]
    listFromList ((Window, b), b) -> Window
    forall {c} {b} {b}. ((c, b), b) -> c
    get_w Window -> [Window] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    notElem
              find_dw :: Int -> [(a, (c, b))] -> c
    find_dw Int
    i = (c, b) -> c
    forall a b. (a, b) -> a
    fst ((c, b) -> c) -> ([(a, (c, b))] -> (c, b)) -> [(a, (c, b))] -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, (c, b)) -> (c, b)
    forall a b. (a, b) -> b
    snd ((a, (c, b)) -> (c, b))
    -> ([(a, (c, b))] -> (a, (c, b))) -> [(a, (c, b))] -> (c, b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(a, (c, b))] -> Int -> (a, (c, b)))
    -> Int -> [(a, (c, b))] -> (a, (c, b))
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [(a, (c, b))] -> Int -> (a, (c, b))
    forall a. HasCallStack => [a] -> Int -> a
    (!!) Int
    i
              todel :: t b -> [((b, b), b)] -> [((b, b), b)]
    todel   t b
    d = (((b, b), b) -> Bool) -> [((b, b), b)] -> [((b, b), b)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((b -> t b -> Bool) -> t b -> b -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip b -> t b -> Bool
    forall a. Eq a => a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem t b
    d (b -> Bool) -> (((b, b), b) -> b) -> ((b, b), b) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((b, b), b) -> b
    forall {c} {b} {b}. ((c, b), b) -> c
    get_w)
              toadd :: t b -> [(b, b)] -> [(b, b)]
    toadd   t b
    a = ((b, b) -> Bool) -> [(b, b)] -> [(b, b)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((b -> t b -> Bool) -> t b -> b -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip b -> t b -> Bool
    forall a. Eq a => a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem t b
    a (b -> Bool) -> ((b, b) -> b) -> (b, b) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b, b) -> b
    forall a b. (a, b) -> a
    fst  )

              check_dwr :: DecoWin -> X DecoWin
    check_dwr DecoWin
    dwr = case DecoWin
    dwr of
                                (Maybe Window
    Nothing, Just Rectangle
    dr) -> do Window
    dw <- Theme -> Rectangle -> X Window
    createDecoWindow Theme
    t Rectangle
    dr
                                                         DecoWin -> X DecoWin
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    dw, Rectangle -> Maybe Rectangle
    forall a. a -> Maybe a
    Just Rectangle
    dr)
                                DecoWin
    _                 -> DecoWin -> X DecoWin
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return DecoWin
    dwr

              resync :: [((Window, b), (Maybe Window, b))]
    -> [OrigWin] -> X [(OrigWin, DecoWin)]
    resync [((Window, b), (Maybe Window, b))]
    _         [] = [(OrigWin, DecoWin)] -> X [(OrigWin, DecoWin)]
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
              resync [((Window, b), (Maybe Window, b))]
    d ((Window
    w,Rectangle
    r):[OrigWin]
    xs) = case  Window
    w Window -> [Window] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    `elemIndex` [((Window, b), (Maybe Window, b))] -> [Window]
    forall {b} {b} {b}. [((b, b), b)] -> [b]
    get_ws [((Window, b), (Maybe Window, b))]
    d of
                                      Just Int
    i  -> do Maybe Rectangle
    dr   <- ds Window
    -> Dimension
    -> Dimension
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> OrigWin
    -> X (Maybe Rectangle)
    forall (ds :: * -> *) a.
    DecorationStyle ds a =>
    ds a
    -> Dimension
    -> Dimension
    -> Rectangle
    -> Stack a
    -> [(a, Rectangle)]
    -> (a, Rectangle)
    -> X (Maybe Rectangle)
    decorate ds Window
    ds (Theme -> Dimension
    decoWidth Theme
    t) (Theme -> Dimension
    decoHeight Theme
    t) Rectangle
    sc Stack Window
    stack [OrigWin]
    wrs (Window
    w,Rectangle
    r)
                                                    DecoWin
    dwr  <- DecoWin -> X DecoWin
    check_dwr (Int -> [((Window, b), (Maybe Window, b))] -> Maybe Window
    forall {a} {c} {b}. Int -> [(a, (c, b))] -> c
    find_dw Int
    i [((Window, b), (Maybe Window, b))]
    d, Maybe Rectangle
    dr)
                                                    [(OrigWin, DecoWin)]
    dwrs <- [((Window, b), (Maybe Window, b))]
    -> [OrigWin] -> X [(OrigWin, DecoWin)]
    resync [((Window, b), (Maybe Window, b))]
    d [OrigWin]
    xs
                                                    [(OrigWin, DecoWin)] -> X [(OrigWin, DecoWin)]
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(OrigWin, DecoWin)] -> X [(OrigWin, DecoWin)])
    -> [(OrigWin, DecoWin)] -> X [(OrigWin, DecoWin)]
    forall a b. (a -> b) -> a -> b
    $ ((Window
    w,Rectangle
    r),DecoWin
    dwr) (OrigWin, DecoWin) -> [(OrigWin, DecoWin)] -> [(OrigWin, DecoWin)]
    forall a. a -> [a] -> [a]
    : [(OrigWin, DecoWin)]
    dwrs
                                      Maybe Int
    Nothing -> [((Window, b), (Maybe Window, b))]
    -> [OrigWin] -> X [(OrigWin, DecoWin)]
    resync [((Window, b), (Maybe Window, b))]
    d [OrigWin]
    xs

              -- We drop any windows that are *precisely* stacked underneath
              -- another window: these must be intended to be tabbed!
              remove_stacked :: [b] -> [(a, b)] -> [(a, b)]
    remove_stacked [b]
    rs ((a
    w,b
    r):[(a, b)]
    xs)
                  | b
    r b -> [b] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [b]
    rs   = [b] -> [(a, b)] -> [(a, b)]
    remove_stacked [b]
    rs [(a, b)]
    xs
                  | Bool
    otherwise     = (a
    w,b
    r) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : [b] -> [(a, b)] -> [(a, b)]
    remove_stacked (b
    rb -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    rs) [(a, b)]
    xs
              remove_stacked [b]
    _ [] = []

              insert_dwr :: ((a, Rectangle), (Maybe a, Maybe Rectangle))
    -> [(a, Rectangle)] -> [(a, Rectangle)]
    insert_dwr ((a
    w,Rectangle
    r),(Just a
    dw,Just Rectangle
    dr)) [(a, Rectangle)]
    xs = (a
    dw,Rectangle
    dr)(a, Rectangle) -> [(a, Rectangle)] -> [(a, Rectangle)]
    forall a. a -> [a] -> [a]
    :(a
    w, ds Window -> Rectangle -> Rectangle -> Rectangle
    forall (ds :: * -> *) a.
    DecorationStyle ds a =>
    ds a -> Rectangle -> Rectangle -> Rectangle
    shrink ds Window
    ds Rectangle
    dr Rectangle
    r)(a, Rectangle) -> [(a, Rectangle)] -> [(a, Rectangle)]
    forall a. a -> [a] -> [a]
    :[(a, Rectangle)]
    xs
              insert_dwr ((a, Rectangle)
    x    ,(     Maybe a
    _ ,     Maybe Rectangle
    _ )) [(a, Rectangle)]
    xs = (a, Rectangle)
    x(a, Rectangle) -> [(a, Rectangle)] -> [(a, Rectangle)]
    forall a. a -> [a] -> [a]
    :[(a, Rectangle)]
    xs

              dwrs_to_wrs :: [((a, Rectangle), (Maybe a, Maybe Rectangle))] -> [(a, Rectangle)]
    dwrs_to_wrs    = [Rectangle] -> [(a, Rectangle)] -> [(a, Rectangle)]
    forall {b} {a}. Eq b => [b] -> [(a, b)] -> [(a, b)]
    remove_stacked [] ([(a, Rectangle)] -> [(a, Rectangle)])
    -> ([((a, Rectangle), (Maybe a, Maybe Rectangle))]
        -> [(a, Rectangle)])
    -> [((a, Rectangle), (Maybe a, Maybe Rectangle))]
    -> [(a, Rectangle)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((a, Rectangle), (Maybe a, Maybe Rectangle))
     -> [(a, Rectangle)] -> [(a, Rectangle)])
    -> [(a, Rectangle)]
    -> [((a, Rectangle), (Maybe a, Maybe Rectangle))]
    -> [(a, Rectangle)]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((a, Rectangle), (Maybe a, Maybe Rectangle))
    -> [(a, Rectangle)] -> [(a, Rectangle)]
    forall {a}.
    ((a, Rectangle), (Maybe a, Maybe Rectangle))
    -> [(a, Rectangle)] -> [(a, Rectangle)]
    insert_dwr []

              processState :: DecorationState -> X ([OrigWin], Maybe (Decoration ds s Window))
    processState DecorationState
    s = do let ndwrs :: [(OrigWin, DecoWin)]
    ndwrs = DecorationState -> [(OrigWin, DecoWin)]
    decos DecorationState
    s
                                  [DecoWin] -> X ()
    showDecos (((OrigWin, DecoWin) -> DecoWin)
    -> [(OrigWin, DecoWin)] -> [DecoWin]
    forall a b. (a -> b) -> [a] -> [b]
    map (OrigWin, DecoWin) -> DecoWin
    forall a b. (a, b) -> b
    snd [(OrigWin, DecoWin)]
    ndwrs)
                                  s -> Theme -> XMonadFont -> [(OrigWin, DecoWin)] -> X ()
    forall s.
    Shrinker s =>
    s -> Theme -> XMonadFont -> [(OrigWin, DecoWin)] -> X ()
    updateDecos s
    sh Theme
    t (DecorationState -> XMonadFont
    font DecorationState
    s) [(OrigWin, DecoWin)]
    ndwrs
                                  ([OrigWin], Maybe (Decoration ds s Window))
    -> X ([OrigWin], Maybe (Decoration ds s Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(OrigWin, DecoWin)] -> [OrigWin]
    forall {a}.
    [((a, Rectangle), (Maybe a, Maybe Rectangle))] -> [(a, Rectangle)]
    dwrs_to_wrs [(OrigWin, DecoWin)]
    ndwrs, Decoration ds s Window -> Maybe (Decoration ds s Window)
    forall a. a -> Maybe a
    Just (Invisible Maybe DecorationState
    -> s -> Theme -> ds Window -> Decoration ds s Window
    forall (ds :: * -> *) s a.
    Invisible Maybe DecorationState
    -> s -> Theme -> ds a -> Decoration ds s a
    Decoration (Maybe DecorationState -> Invisible Maybe DecorationState
    forall (m :: * -> *) a. m a -> Invisible m a
    I (DecorationState -> Maybe DecorationState
    forall a. a -> Maybe a
    Just (DecorationState
    s {decos = ndwrs}))) s
    sh Theme
    t ds Window
    ds))

        handleMess :: Decoration ds s Window
    -> SomeMessage -> X (Maybe (Decoration ds s Window))
    handleMess (Decoration (I (Just s :: DecorationState
    s@DS{decos :: DecorationState -> [(OrigWin, DecoWin)]
    decos = [(OrigWin, DecoWin)]
    dwrs})) s
    sh Theme
    t ds Window
    ds) SomeMessage
    m
            | Just Event
    e <- SomeMessage -> Maybe Event
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m                = do ds Window -> DecorationState -> Event -> X ()
    forall (ds :: * -> *) a.
    DecorationStyle ds a =>
    ds a -> DecorationState -> Event -> X ()
    decorationEventHook ds Window
    ds DecorationState
    s Event
    e
                                                          s -> Theme -> DecorationState -> Event -> X ()
    forall s.
    Shrinker s =>
    s -> Theme -> DecorationState -> Event -> X ()
    handleEvent s
    sh Theme
    t DecorationState
    s Event
    e
                                                          Maybe (Decoration ds s Window)
    -> X (Maybe (Decoration ds s Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Decoration ds s Window)
    forall a. Maybe a
    Nothing
            | Just LayoutMessages
    Hide             <- SomeMessage -> Maybe LayoutMessages
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m = do [DecoWin] -> X ()
    hideDecos (((OrigWin, DecoWin) -> DecoWin)
    -> [(OrigWin, DecoWin)] -> [DecoWin]
    forall a b. (a -> b) -> [a] -> [b]
    map (OrigWin, DecoWin) -> DecoWin
    forall a b. (a, b) -> b
    snd [(OrigWin, DecoWin)]
    dwrs)
                                                          Maybe (Decoration ds s Window)
    -> X (Maybe (Decoration ds s Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Decoration ds s Window)
    forall a. Maybe a
    Nothing
            | Just (SetTheme Theme
    nt)    <- SomeMessage -> Maybe DecorationMsg
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m = do DecorationState -> X ()
    releaseResources DecorationState
    s
                                                          Maybe (Decoration ds s Window)
    -> X (Maybe (Decoration ds s Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Decoration ds s Window)
     -> X (Maybe (Decoration ds s Window)))
    -> Maybe (Decoration ds s Window)
    -> X (Maybe (Decoration ds s Window))
    forall a b. (a -> b) -> a -> b
    $ Decoration ds s Window -> Maybe (Decoration ds s Window)
    forall a. a -> Maybe a
    Just (Decoration ds s Window -> Maybe (Decoration ds s Window))
    -> Decoration ds s Window -> Maybe (Decoration ds s Window)
    forall a b. (a -> b) -> a -> b
    $ Invisible Maybe DecorationState
    -> s -> Theme -> ds Window -> Decoration ds s Window
    forall (ds :: * -> *) s a.
    Invisible Maybe DecorationState
    -> s -> Theme -> ds a -> Decoration ds s a
    Decoration (Maybe DecorationState -> Invisible Maybe DecorationState
    forall (m :: * -> *) a. m a -> Invisible m a
    I Maybe DecorationState
    forall a. Maybe a
    Nothing) s
    sh Theme
    nt ds Window
    ds
            | Just LayoutMessages
    ReleaseResources <- SomeMessage -> Maybe LayoutMessages
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m = do DecorationState -> X ()
    releaseResources DecorationState
    s
                                                          Maybe (Decoration ds s Window)
    -> X (Maybe (Decoration ds s Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Decoration ds s Window)
     -> X (Maybe (Decoration ds s Window)))
    -> Maybe (Decoration ds s Window)
    -> X (Maybe (Decoration ds s Window))
    forall a b. (a -> b) -> a -> b
    $ Decoration ds s Window -> Maybe (Decoration ds s Window)
    forall a. a -> Maybe a
    Just (Decoration ds s Window -> Maybe (Decoration ds s Window))
    -> Decoration ds s Window -> Maybe (Decoration ds s Window)
    forall a b. (a -> b) -> a -> b
    $ Invisible Maybe DecorationState
    -> s -> Theme -> ds Window -> Decoration ds s Window
    forall (ds :: * -> *) s a.
    Invisible Maybe DecorationState
    -> s -> Theme -> ds a -> Decoration ds s a
    Decoration (Maybe DecorationState -> Invisible Maybe DecorationState
    forall (m :: * -> *) a. m a -> Invisible m a
    I Maybe DecorationState
    forall a. Maybe a
    Nothing) s
    sh Theme
    t  ds Window
    ds
        handleMess Decoration ds s Window
    _ SomeMessage
    _ = Maybe (Decoration ds s Window)
    -> X (Maybe (Decoration ds s Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Decoration ds s Window)
    forall a. Maybe a
    Nothing

        modifierDescription :: Decoration ds s Window -> String
    modifierDescription (Decoration Invisible Maybe DecorationState
    _ s
    _ Theme
    _ ds Window
    ds) = ds Window -> String
    forall (ds :: * -> *) a. DecorationStyle ds a => ds a -> String
    describeDeco ds Window
    ds

    -- | By default 'Decoration' handles 'PropertyEvent' and 'ExposeEvent'
    -- only.
    handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X ()
    handleEvent :: forall s.
    Shrinker s =>
    s -> Theme -> DecorationState -> Event -> X ()
    handleEvent s
    sh Theme
    t (DS [(OrigWin, DecoWin)]
    dwrs XMonadFont
    fs) Event
    e
        | PropertyEvent {ev_window :: Event -> Window
    ev_window = Window
    w} <- Event
    e
        , Just Int
    i <- Window
    w Window -> [Window] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    `elemIndex` ((OrigWin, DecoWin) -> Window) -> [(OrigWin, DecoWin)] -> [Window]
    forall a b. (a -> b) -> [a] -> [b]
    map (OrigWin -> Window
    forall a b. (a, b) -> a
    fst (OrigWin -> Window)
    -> ((OrigWin, DecoWin) -> OrigWin) -> (OrigWin, DecoWin) -> Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (OrigWin, DecoWin) -> OrigWin
    forall a b. (a, b) -> a
    fst) [(OrigWin, DecoWin)]
    dwrs      = s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X ()
    forall s.
    Shrinker s =>
    s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X ()
    updateDeco s
    sh Theme
    t XMonadFont
    fs ([(OrigWin, DecoWin)]
    dwrs [(OrigWin, DecoWin)] -> Int -> (OrigWin, DecoWin)
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i)
        | ExposeEvent   {ev_window :: Event -> Window
    ev_window = Window
    w} <- Event
    e
        , Just Int
    i <- Window
    w Window -> [Window] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    `elemIndex` ((OrigWin, DecoWin) -> Maybe Window)
    -> [(OrigWin, DecoWin)] -> [Window]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (DecoWin -> Maybe Window
    forall a b. (a, b) -> a
    fst (DecoWin -> Maybe Window)
    -> ((OrigWin, DecoWin) -> DecoWin)
    -> (OrigWin, DecoWin)
    -> Maybe Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (OrigWin, DecoWin) -> DecoWin
    forall a b. (a, b) -> b
    snd) [(OrigWin, DecoWin)]
    dwrs = s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X ()
    forall s.
    Shrinker s =>
    s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X ()
    updateDeco s
    sh Theme
    t XMonadFont
    fs ([(OrigWin, DecoWin)]
    dwrs [(OrigWin, DecoWin)] -> Int -> (OrigWin, DecoWin)
    forall a. HasCallStack => [a] -> Int -> a
    !! Int
    i)
    handleEvent s
    _ Theme
    _ DecorationState
    _ Event
    _ = () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Mouse focus and mouse drag are handled by the same function, this
    -- way we can start dragging unfocused windows too.
    handleMouseFocusDrag :: (DecorationStyle ds a) => ds a -> DecorationState -> Event -> X ()
    handleMouseFocusDrag :: forall (ds :: * -> *) a.
    DecorationStyle ds a =>
    ds a -> DecorationState -> Event -> X ()
    handleMouseFocusDrag ds a
    ds (DS [(OrigWin, DecoWin)]
    dwrs XMonadFont
    _) ButtonEvent { ev_window :: Event -> Window
    ev_window     = Window
    ew
                                                    , ev_event_type :: Event -> Dimension
    ev_event_type = Dimension
    et
                                                    , ev_x_root :: Event -> CInt
    ev_x_root     = CInt
    ex
                                                    , ev_y_root :: Event -> CInt
    ev_y_root     = CInt
    ey }
        | Dimension
    et Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    buttonPress
        , Just ((Window
    mainw,Rectangle
    r), (Window
    _, Maybe Rectangle
    decoRectM)) <- Window
    -> [(OrigWin, DecoWin)]
    -> Maybe (OrigWin, (Window, Maybe Rectangle))
    lookFor Window
    ew [(OrigWin, DecoWin)]
    dwrs = do
            let Rectangle Position
    dx Position
    _ Dimension
    dwh Dimension
    _ = Maybe Rectangle -> Rectangle
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe Rectangle
    decoRectM
                distFromLeft :: CInt
    distFromLeft = CInt
    ex CInt -> CInt -> CInt
    forall a. Num a => a -> a -> a
    - Position -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    dx
                distFromRight :: CInt
    distFromRight = Dimension -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    dwh CInt -> CInt -> CInt
    forall a. Num a => a -> a -> a
    - (CInt
    ex CInt -> CInt -> CInt
    forall a. Num a => a -> a -> a
    - Position -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    dx)
            Bool
    dealtWith <- ds a -> Window -> Int -> Int -> X Bool
    forall (ds :: * -> *) a.
    DecorationStyle ds a =>
    ds a -> Window -> Int -> Int -> X Bool
    decorationCatchClicksHook ds a
    ds Window
    mainw (CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    distFromLeft) (CInt -> Int
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    distFromRight)
            Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    dealtWith (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $
                (Position -> Position -> X ()) -> X () -> X ()
    mouseDrag (\Position
    x Position
    y -> Window -> X ()
    focus Window
    mainw X () -> X () -> X ()
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ds a -> CInt -> CInt -> OrigWin -> Position -> Position -> X ()
    forall (ds :: * -> *) a.
    DecorationStyle ds a =>
    ds a -> CInt -> CInt -> OrigWin -> Position -> Position -> X ()
    decorationWhileDraggingHook ds a
    ds CInt
    ex CInt
    ey (Window
    mainw, Rectangle
    r) Position
    x Position
    y)
                            (ds a -> OrigWin -> Window -> X ()
    forall (ds :: * -> *) a.
    DecorationStyle ds a =>
    ds a -> OrigWin -> Window -> X ()
    decorationAfterDraggingHook ds a
    ds (Window
    mainw, Rectangle
    r) Window
    ew)
    handleMouseFocusDrag ds a
    _ DecorationState
    _ Event
    _ = () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
    handleDraggingInProgress :: CInt -> CInt -> OrigWin -> Position -> Position -> X ()
    handleDraggingInProgress CInt
    ex CInt
    ey (Window
    _, Rectangle
    r) Position
    x Position
    y = do
        let rect :: Rectangle
    rect = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (Position
    x Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    ex Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Rectangle -> Position
    rect_x Rectangle
    r))
                             (Position
    y Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    ey Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Rectangle -> Position
    rect_y Rectangle
    r))
                             (Rectangle -> Dimension
    rect_width  Rectangle
    r)
                             (Rectangle -> Dimension
    rect_height Rectangle
    r)
        WindowArrangerMsg -> X ()
    forall a. Message a => a -> X ()
    sendMessage (WindowArrangerMsg -> X ()) -> WindowArrangerMsg -> X ()
    forall a b. (a -> b) -> a -> b
    $ Rectangle -> WindowArrangerMsg
    SetGeometry Rectangle
    rect

    -- | Given a window and the state, if a matching decoration is in the
    -- state return it with its ('Maybe') 'Rectangle'.
    lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle))
    lookFor :: Window
    -> [(OrigWin, DecoWin)]
    -> Maybe (OrigWin, (Window, Maybe Rectangle))
    lookFor Window
    w ((OrigWin
    wr,(Just Window
    dw,Maybe Rectangle
    dr)):[(OrigWin, DecoWin)]
    dwrs) | Window
    w Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    dw = (OrigWin, (Window, Maybe Rectangle))
    -> Maybe (OrigWin, (Window, Maybe Rectangle))
    forall a. a -> Maybe a
    Just (OrigWin
    wr,(Window
    dw,Maybe Rectangle
    dr))
                                       | Bool
    otherwise = Window
    -> [(OrigWin, DecoWin)]
    -> Maybe (OrigWin, (Window, Maybe Rectangle))
    lookFor Window
    w [(OrigWin, DecoWin)]
    dwrs
    lookFor Window
    w ((OrigWin
    _, (Maybe Window
    Nothing, Maybe Rectangle
    _)):[(OrigWin, DecoWin)]
    dwrs) = Window
    -> [(OrigWin, DecoWin)]
    -> Maybe (OrigWin, (Window, Maybe Rectangle))
    lookFor Window
    w [(OrigWin, DecoWin)]
    dwrs
    lookFor Window
    _ [] = Maybe (OrigWin, (Window, Maybe Rectangle))
    forall a. Maybe a
    Nothing

    findWindowByDecoration :: Window -> DecorationState -> Maybe (OrigWin,(Window,Maybe Rectangle))
    findWindowByDecoration :: Window
    -> DecorationState -> Maybe (OrigWin, (Window, Maybe Rectangle))
    findWindowByDecoration Window
    w DecorationState
    ds = Window
    -> [(OrigWin, DecoWin)]
    -> Maybe (OrigWin, (Window, Maybe Rectangle))
    lookFor Window
    w (DecorationState -> [(OrigWin, DecoWin)]
    decos DecorationState
    ds)

    -- | Initialize the 'DecorationState' by initializing the font
    -- structure and by creating the needed decorations.
    initState :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle
              -> W.Stack Window -> [(Window,Rectangle)] -> X DecorationState
    initState :: forall (ds :: * -> *).
    DecorationStyle ds Window =>
    Theme
    -> ds Window
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> X DecorationState
    initState Theme
    t ds Window
    ds Rectangle
    sc Stack Window
    s [OrigWin]
    wrs = do
      XMonadFont
    fs   <- String -> X XMonadFont
    initXMF (Theme -> String
    fontName Theme
    t)
      [(OrigWin, DecoWin)]
    dwrs <- Theme
    -> ds Window
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> [OrigWin]
    -> X [(OrigWin, DecoWin)]
    forall (ds :: * -> *).
    DecorationStyle ds Window =>
    Theme
    -> ds Window
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> [OrigWin]
    -> X [(OrigWin, DecoWin)]
    createDecos Theme
    t ds Window
    ds Rectangle
    sc Stack Window
    s [OrigWin]
    wrs [OrigWin]
    wrs
      DecorationState -> X DecorationState
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DecorationState -> X DecorationState)
    -> DecorationState -> X DecorationState
    forall a b. (a -> b) -> a -> b
    $ [(OrigWin, DecoWin)] -> XMonadFont -> DecorationState
    DS [(OrigWin, DecoWin)]
    dwrs XMonadFont
    fs

    -- | Delete windows stored in the state and release the font structure.
    releaseResources :: DecorationState -> X ()
    releaseResources :: DecorationState -> X ()
    releaseResources DecorationState
    s = do
      [DecoWin] -> X ()
    deleteDecos (((OrigWin, DecoWin) -> DecoWin)
    -> [(OrigWin, DecoWin)] -> [DecoWin]
    forall a b. (a -> b) -> [a] -> [b]
    map (OrigWin, DecoWin) -> DecoWin
    forall a b. (a, b) -> b
    snd ([(OrigWin, DecoWin)] -> [DecoWin])
    -> [(OrigWin, DecoWin)] -> [DecoWin]
    forall a b. (a -> b) -> a -> b
    $ DecorationState -> [(OrigWin, DecoWin)]
    decos DecorationState
    s)
      XMonadFont -> X ()
    releaseXMF  (DecorationState -> XMonadFont
    font DecorationState
    s)

    -- | Create the decoration windows of a list of windows and their
    -- rectangles, by calling the 'decorate' method of the
    -- 'DecorationStyle' received.
    createDecos :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle -> W.Stack Window
                -> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)]
    createDecos :: forall (ds :: * -> *).
    DecorationStyle ds Window =>
    Theme
    -> ds Window
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> [OrigWin]
    -> X [(OrigWin, DecoWin)]
    createDecos Theme
    t ds Window
    ds Rectangle
    sc Stack Window
    s [OrigWin]
    wrs ((Window
    w,Rectangle
    r):[OrigWin]
    xs) = do
      Maybe Rectangle
    deco <- ds Window
    -> Dimension
    -> Dimension
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> OrigWin
    -> X (Maybe Rectangle)
    forall (ds :: * -> *) a.
    DecorationStyle ds a =>
    ds a
    -> Dimension
    -> Dimension
    -> Rectangle
    -> Stack a
    -> [(a, Rectangle)]
    -> (a, Rectangle)
    -> X (Maybe Rectangle)
    decorate ds Window
    ds (Theme -> Dimension
    decoWidth Theme
    t) (Theme -> Dimension
    decoHeight Theme
    t) Rectangle
    sc Stack Window
    s [OrigWin]
    wrs (Window
    w,Rectangle
    r)
      case Maybe Rectangle
    deco of
        Just Rectangle
    dr -> do Window
    dw   <- Theme -> Rectangle -> X Window
    createDecoWindow Theme
    t Rectangle
    dr
                      [(OrigWin, DecoWin)]
    dwrs <- Theme
    -> ds Window
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> [OrigWin]
    -> X [(OrigWin, DecoWin)]
    forall (ds :: * -> *).
    DecorationStyle ds Window =>
    Theme
    -> ds Window
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> [OrigWin]
    -> X [(OrigWin, DecoWin)]
    createDecos Theme
    t ds Window
    ds Rectangle
    sc Stack Window
    s [OrigWin]
    wrs [OrigWin]
    xs
                      [(OrigWin, DecoWin)] -> X [(OrigWin, DecoWin)]
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(OrigWin, DecoWin)] -> X [(OrigWin, DecoWin)])
    -> [(OrigWin, DecoWin)] -> X [(OrigWin, DecoWin)]
    forall a b. (a -> b) -> a -> b
    $ ((Window
    w,Rectangle
    r), (Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    dw, Rectangle -> Maybe Rectangle
    forall a. a -> Maybe a
    Just Rectangle
    dr)) (OrigWin, DecoWin) -> [(OrigWin, DecoWin)] -> [(OrigWin, DecoWin)]
    forall a. a -> [a] -> [a]
    : [(OrigWin, DecoWin)]
    dwrs
        Maybe Rectangle
    Nothing -> do [(OrigWin, DecoWin)]
    dwrs <- Theme
    -> ds Window
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> [OrigWin]
    -> X [(OrigWin, DecoWin)]
    forall (ds :: * -> *).
    DecorationStyle ds Window =>
    Theme
    -> ds Window
    -> Rectangle
    -> Stack Window
    -> [OrigWin]
    -> [OrigWin]
    -> X [(OrigWin, DecoWin)]
    createDecos Theme
    t ds Window
    ds Rectangle
    sc Stack Window
    s [OrigWin]
    wrs [OrigWin]
    xs
                      [(OrigWin, DecoWin)] -> X [(OrigWin, DecoWin)]
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(OrigWin, DecoWin)] -> X [(OrigWin, DecoWin)])
    -> [(OrigWin, DecoWin)] -> X [(OrigWin, DecoWin)]
    forall a b. (a -> b) -> a -> b
    $ ((Window
    w,Rectangle
    r), (Maybe Window
    forall a. Maybe a
    Nothing, Maybe Rectangle
    forall a. Maybe a
    Nothing)) (OrigWin, DecoWin) -> [(OrigWin, DecoWin)] -> [(OrigWin, DecoWin)]
    forall a. a -> [a] -> [a]
    : [(OrigWin, DecoWin)]
    dwrs
    createDecos Theme
    _ ds Window
    _ Rectangle
    _ Stack Window
    _ [OrigWin]
    _ [] = [(OrigWin, DecoWin)] -> X [(OrigWin, DecoWin)]
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    createDecoWindow :: Theme -> Rectangle -> X Window
    createDecoWindow :: Theme -> Rectangle -> X Window
    createDecoWindow Theme
    t Rectangle
    r = do
      let mask :: Maybe Window
    mask = Window -> Maybe Window
    forall a. a -> Maybe a
    Just (Window
    exposureMask Window -> Window -> Window
    forall a. Bits a => a -> a -> a
    .|. Window
    buttonPressMask)
      Window
    w <- Rectangle -> Maybe Window -> String -> Bool -> X Window
    createNewWindow Rectangle
    r Maybe Window
    mask (Theme -> String
    inactiveColor Theme
    t) Bool
    True
      Display
    d <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
      IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> ClassHint -> IO ()
    setClassHint Display
    d Window
    w (String -> String -> ClassHint
    ClassHint String
    "xmonad-decoration" String
    "xmonad")
      Window -> X Window
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Window
    w

    showDecos :: [DecoWin] -> X ()
    showDecos :: [DecoWin] -> X ()
    showDecos = [Window] -> X ()
    showWindows ([Window] -> X ()) -> ([DecoWin] -> [Window]) -> [DecoWin] -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DecoWin -> Maybe Window) -> [DecoWin] -> [Window]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe DecoWin -> Maybe Window
    forall a b. (a, b) -> a
    fst ([DecoWin] -> [Window])
    -> ([DecoWin] -> [DecoWin]) -> [DecoWin] -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DecoWin -> Bool) -> [DecoWin] -> [DecoWin]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Maybe Rectangle -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe Rectangle -> Bool)
    -> (DecoWin -> Maybe Rectangle) -> DecoWin -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DecoWin -> Maybe Rectangle
    forall a b. (a, b) -> b
    snd)

    hideDecos :: [DecoWin] -> X ()
    hideDecos :: [DecoWin] -> X ()
    hideDecos = [Window] -> X ()
    hideWindows ([Window] -> X ()) -> ([DecoWin] -> [Window]) -> [DecoWin] -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DecoWin -> Maybe Window) -> [DecoWin] -> [Window]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe DecoWin -> Maybe Window
    forall a b. (a, b) -> a
    fst

    deleteDecos :: [DecoWin] -> X ()
    deleteDecos :: [DecoWin] -> X ()
    deleteDecos = [Window] -> X ()
    deleteWindows ([Window] -> X ()) -> ([DecoWin] -> [Window]) -> [DecoWin] -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DecoWin -> Maybe Window) -> [DecoWin] -> [Window]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe DecoWin -> Maybe Window
    forall a b. (a, b) -> a
    fst

    updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin,DecoWin)] -> X ()
    updateDecos :: forall s.
    Shrinker s =>
    s -> Theme -> XMonadFont -> [(OrigWin, DecoWin)] -> X ()
    updateDecos s
    s Theme
    t XMonadFont
    f = ((OrigWin, DecoWin) -> X ()) -> [(OrigWin, DecoWin)] -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (((OrigWin, DecoWin) -> X ()) -> [(OrigWin, DecoWin)] -> X ())
    -> ((OrigWin, DecoWin) -> X ()) -> [(OrigWin, DecoWin)] -> X ()
    forall a b. (a -> b) -> a -> b
    $ s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X ()
    forall s.
    Shrinker s =>
    s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X ()
    updateDeco s
    s Theme
    t XMonadFont
    f

    -- | Update a decoration window given a shrinker, a theme, the font
    -- structure and the needed 'Rectangle's
    updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin,DecoWin) -> X ()
    updateDeco :: forall s.
    Shrinker s =>
    s -> Theme -> XMonadFont -> (OrigWin, DecoWin) -> X ()
    updateDeco s
    sh Theme
    t XMonadFont
    fs ((Window
    w,Rectangle
    _),(Just Window
    dw,Just (Rectangle Position
    _ Position
    _ Dimension
    wh Dimension
    ht))) = do
      -- xmonad-contrib #809
      -- qutebrowser will happily shovel a 389K multiline string into @_NET_WM_NAME@
      -- and the 'defaultShrinker' (a) doesn't handle multiline strings well (b) is
      -- quadratic due to using 'init'
      String
    nw  <- (NamedWindow -> String) -> X NamedWindow -> X String
    forall a b. (a -> b) -> X a -> X b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int -> ShowS
    forall a. Int -> [a] -> [a]
    take Int
    2048 ShowS -> (NamedWindow -> String) -> NamedWindow -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n') ShowS -> (NamedWindow -> String) -> NamedWindow -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NamedWindow -> String
    forall a. Show a => a -> String
    show) (Window -> X NamedWindow
    getName Window
    w)
      [Window]
    ur  <- X [Window]
    readUrgents
      Display
    dpy <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
      let focusColor :: Window -> b -> b -> b -> f b
    focusColor Window
    win b
    ic b
    ac b
    uc = b -> (Window -> b) -> Maybe Window -> b
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe b
    ic (\Window
    focusw -> case () of
                                                          ()
    _ | Window
    focusw Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    win -> b
    ac
                                                            | Window
    win Window -> [Window] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Window]
    ur -> b
    uc
                                                            | Bool
    otherwise     -> b
    ic) (Maybe Window -> b)
    -> (StackSet String (Layout Window) Window ScreenId ScreenDetail
        -> Maybe Window)
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> b
    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 -> b)
    -> f (StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> f b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (XState
     -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
    -> f (StackSet String (Layout Window) Window ScreenId ScreenDetail)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState
    -> StackSet String (Layout Window) Window ScreenId ScreenDetail
    windowset
      (String
    bc,String
    borderc,Dimension
    borderw,String
    tc) <-
        Window
    -> (String, String, Dimension, String)
    -> (String, String, Dimension, String)
    -> (String, String, Dimension, String)
    -> X (String, String, Dimension, String)
    forall {f :: * -> *} {b}.
    MonadState XState f =>
    Window -> b -> b -> b -> f b
    focusColor Window
    w (Theme -> String
    inactiveColor Theme
    t, Theme -> String
    inactiveBorderColor Theme
    t, Theme -> Dimension
    inactiveBorderWidth Theme
    t, Theme -> String
    inactiveTextColor Theme
    t)
                     (Theme -> String
    activeColor   Theme
    t, Theme -> String
    activeBorderColor   Theme
    t, Theme -> Dimension
    activeBorderWidth   Theme
    t, Theme -> String
    activeTextColor   Theme
    t)
                     (Theme -> String
    urgentColor   Theme
    t, Theme -> String
    urgentBorderColor   Theme
    t, Theme -> Dimension
    urgentBorderWidth   Theme
    t, Theme -> String
    urgentTextColor   Theme
    t)
      let s :: String -> [String]
    s = s -> String -> [String]
    forall s. Shrinker s => s -> String -> [String]
    shrinkIt s
    sh
      String
    name <- (String -> [String]) -> (String -> X Bool) -> String -> X String
    shrinkWhile String -> [String]
    s (\String
    n -> do Int
    size <- IO Int -> X Int
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Int -> X Int) -> IO Int -> X Int
    forall a b. (a -> b) -> a -> b
    $ Display -> XMonadFont -> String -> IO Int
    forall (m :: * -> *).
    MonadIO m =>
    Display -> XMonadFont -> String -> m Int
    textWidthXMF Display
    dpy XMonadFont
    fs String
    n
                                      Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> X Bool) -> Bool -> X Bool
    forall a b. (a -> b) -> a -> b
    $ Int
    size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Dimension -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Dimension
    wh Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Dimension -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Dimension
    ht Dimension -> Dimension -> Dimension
    forall a. Integral a => a -> a -> a
    `div` Dimension
    2)) String
    nw
      let als :: [Align]
    als = Align
    AlignCenter Align -> [Align] -> [Align]
    forall a. a -> [a] -> [a]
    : ((String, Align) -> Align) -> [(String, Align)] -> [Align]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Align) -> Align
    forall a b. (a, b) -> b
    snd (Theme -> [(String, Align)]
    windowTitleAddons Theme
    t)
          strs :: [String]
    strs = String
    name String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : ((String, Align) -> String) -> [(String, Align)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Align) -> String
    forall a b. (a, b) -> a
    fst (Theme -> [(String, Align)]
    windowTitleAddons Theme
    t)
          i_als :: [Placement]
    i_als = (([[Bool]], Placement) -> Placement)
    -> [([[Bool]], Placement)] -> [Placement]
    forall a b. (a -> b) -> [a] -> [b]
    map ([[Bool]], Placement) -> Placement
    forall a b. (a, b) -> b
    snd (Theme -> [([[Bool]], Placement)]
    windowTitleIcons Theme
    t)
          icons :: [[[Bool]]]
    icons = (([[Bool]], Placement) -> [[Bool]])
    -> [([[Bool]], Placement)] -> [[[Bool]]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([[Bool]], Placement) -> [[Bool]]
    forall a b. (a, b) -> a
    fst (Theme -> [([[Bool]], Placement)]
    windowTitleIcons Theme
    t)
      Window
    -> XMonadFont
    -> Dimension
    -> Dimension
    -> Dimension
    -> String
    -> String
    -> String
    -> String
    -> [Align]
    -> [String]
    -> [Placement]
    -> [[[Bool]]]
    -> X ()
    paintTextAndIcons Window
    dw XMonadFont
    fs Dimension
    wh Dimension
    ht Dimension
    borderw String
    bc String
    borderc String
    tc String
    bc [Align]
    als [String]
    strs [Placement]
    i_als [[[Bool]]]
    icons
    updateDeco s
    _ Theme
    _ XMonadFont
    _ (OrigWin
    _,(Just Window
    w,Maybe Rectangle
    Nothing)) = Window -> X ()
    hideWindow Window
    w
    updateDeco s
    _ Theme
    _ XMonadFont
    _ (OrigWin, DecoWin)
    _ = () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | True if the window is in the 'Stack'. The 'Window' comes second
    -- to facilitate list processing, even though @w \`isInStack\` s@ won't
    -- work...;)
    isInStack :: Eq a => W.Stack a -> a -> Bool
    isInStack :: forall a. Eq a => Stack a -> a -> Bool
    isInStack Stack a
    s = (a -> [a] -> Bool) -> [a] -> a -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip a -> [a] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem (Stack a -> [a]
    forall a. Stack a -> [a]
    W.integrate Stack a
    s)

    -- | Given a 'Rectangle' and a list of 'Rectangle's is True if the
    -- 'Rectangle' is not completely contained by any 'Rectangle' of the
    -- list.
    isVisible :: Rectangle -> [Rectangle] -> Bool
    isVisible :: Rectangle -> [Rectangle] -> Bool
    isVisible Rectangle
    r = [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and ([Bool] -> Bool) -> ([Rectangle] -> [Bool]) -> [Rectangle] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Rectangle -> [Bool] -> [Bool]) -> [Bool] -> [Rectangle] -> [Bool]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Rectangle -> [Bool] -> [Bool]
    f []
        where f :: Rectangle -> [Bool] -> [Bool]
    f Rectangle
    x [Bool]
    xs = if Rectangle
    r Rectangle -> Rectangle -> Bool
    `isWithin` Rectangle
    x then Bool
    False Bool -> [Bool] -> [Bool]
    forall a. a -> [a] -> [a]
    : [Bool]
    xs else Bool
    True Bool -> [Bool] -> [Bool]
    forall a. a -> [a] -> [a]
    : [Bool]
    xs

    -- | The contrary of 'isVisible'.
    isInvisible :: Rectangle -> [Rectangle] -> Bool
    isInvisible :: Rectangle -> [Rectangle] -> Bool
    isInvisible Rectangle
    r = Bool -> Bool
    not (Bool -> Bool) -> ([Rectangle] -> Bool) -> [Rectangle] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rectangle -> [Rectangle] -> Bool
    isVisible Rectangle
    r

    -- | True is the first 'Rectangle' is totally within the second
    -- 'Rectangle'.
    isWithin :: Rectangle -> Rectangle -> Bool
    isWithin :: Rectangle -> Rectangle -> Bool
    isWithin (Rectangle Position
    x Position
    y Dimension
    w Dimension
    h) (Rectangle Position
    rx Position
    ry Dimension
    rw Dimension
    rh)
        | Position
    x Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Position
    rx, Position
    x Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Position
    rx Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    rw
        , Position
    y Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Position
    ry, Position
    y Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Position
    ry Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    rh
        , Position
    x Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    w Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Position
    rx Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    rw
        , Position
    y Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    h Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Position
    ry Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    rh = Bool
    True
        | Bool
    otherwise              = Bool
    False

    shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String
    shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String
    shrinkWhile String -> [String]
    sh String -> X Bool
    p String
    x = [String] -> X String
    sw ([String] -> X String) -> [String] -> X String
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    sh String
    x
        where sw :: [String] -> X String
    sw [String
    n] = String -> X String
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    n
              sw [] = String -> X String
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""
              sw (String
    n:[String]
    ns) = do
                            Bool
    cond <- String -> X Bool
    p String
    n
                            if Bool
    cond
                              then [String] -> X String
    sw [String]
    ns
                              else String -> X String
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    n

    data CustomShrink = CustomShrink
    instance Show CustomShrink where show :: CustomShrink -> String
    show CustomShrink
    _ = String
    ""
    instance Read CustomShrink where readsPrec :: Int -> ReadS CustomShrink
    readsPrec Int
    _ String
    s = [(CustomShrink
    CustomShrink,String
    s)]

    class (Read s, Show s) => Shrinker s where
        shrinkIt :: s -> String -> [String]

    data DefaultShrinker = DefaultShrinker
    instance Show DefaultShrinker where show :: DefaultShrinker -> String
    show DefaultShrinker
    _ = String
    ""
    instance Read DefaultShrinker where readsPrec :: Int -> ReadS DefaultShrinker
    readsPrec Int
    _ String
    s = [(DefaultShrinker
    DefaultShrinker,String
    s)]
    instance Shrinker DefaultShrinker where
        shrinkIt :: DefaultShrinker -> String -> [String]
    shrinkIt DefaultShrinker
    _ String
    "" = [String
    ""]
        shrinkIt DefaultShrinker
    s String
    cs = String
    cs String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : DefaultShrinker -> String -> [String]
    forall s. Shrinker s => s -> String -> [String]
    shrinkIt DefaultShrinker
    s (ShowS
    forall a. HasCallStack => [a] -> [a]
    init String
    cs)

    shrinkText :: DefaultShrinker
    shrinkText :: DefaultShrinker
    shrinkText = DefaultShrinker
    DefaultShrinker