    {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.DecorationEx.Widgets
    -- Description :  Definitions for decoration widgets (window buttons etc)
    -- Copyright   :  2023 Ilya Portnov
    -- License     :  BSD-style (see xmonad/LICENSE)
    --
    -- Maintainer  :  portnov84@rambler.ru
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- This module contains data types and utilities to deal with decoration
    -- widgets. A widget is anything that is displayed on window decoration,
    -- and, optionally, can react on clicks. Examples of widgets are usual
    -- window buttons (minimize, maximize, close), window icon and window title.
    -----------------------------------------------------------------------------

    module XMonad.Layout.DecorationEx.Widgets (
        -- * Data types
        StandardCommand (..),
        TextWidget (..),
        GenericWidget (..),
        StandardWidget,
        -- * Utility functions
        isWidgetChecked,
        -- * Presets for standard widgets
        titleW, toggleStickyW, minimizeW,
        maximizeW, closeW, dwmpromoteW,
        moveToNextGroupW,moveToPrevGroupW
      ) where

    import XMonad
    import qualified XMonad.StackSet as W
    import XMonad.Actions.DwmPromote
    import qualified XMonad.Actions.CopyWindow as CW
    import qualified XMonad.Layout.Groups.Examples as Ex
    import XMonad.Layout.Maximize
    import XMonad.Actions.Minimize
    import XMonad.Actions.WindowMenu

    import XMonad.Layout.DecorationEx.Common
    import XMonad.Layout.DecorationEx.Engine

    -- | Standard window commands.
    --
    -- One can extend this list by simply doing
    --
    -- > data MyWindowCommand =
    -- >     Std StandardCommand
    -- >   | SomeFancyCommand
    --
    -- > instance WindowCommand MyWindowCommand where ...
    --
    -- > type MyWidget = GenericWidget MyWindowCommand
    --
    data StandardCommand =
          FocusWindow      -- ^ Focus the window
        | FocusUp          -- ^ Move focus to previous window
        | FocusDown        -- ^ Move focus to following window
        | MoveToNextGroup  -- ^ Move the window to the next group (see "XMonad.Layout.Groups")
        | MoveToPrevGroup  -- ^ Move the window to the previous group
        | DwmPromote       -- ^ Execute @dwmpromote@ (see "XMonad.Actions.DwmPromote")
        | ToggleSticky     -- ^ Make window sticky or unstick it (see "XMonad.Actions.CopyWindow")
        | ToggleMaximize   -- ^ Maximize or restore window (see "XMonad.Layout.Maximize")
        | Minimize         -- ^ Minimize window (see "XMonad.Actions.Minimize")
        | CloseWindow      -- ^ Close the window
        | GridWindowMenu   -- ^ Show window menu via "XMonad.Actions.GridSelect" (see "XMonad.Actions.WindowMenu")
      deriving (StandardCommand -> StandardCommand -> Bool
    (StandardCommand -> StandardCommand -> Bool)
    -> (StandardCommand -> StandardCommand -> Bool)
    -> Eq StandardCommand
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: StandardCommand -> StandardCommand -> Bool
    == :: StandardCommand -> StandardCommand -> Bool
    $c/= :: StandardCommand -> StandardCommand -> Bool
    /= :: StandardCommand -> StandardCommand -> Bool
    Eq, Int -> StandardCommand -> ShowS
    [StandardCommand] -> ShowS
    StandardCommand -> String
    (Int -> StandardCommand -> ShowS)
    -> (StandardCommand -> String)
    -> ([StandardCommand] -> ShowS)
    -> Show StandardCommand
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> StandardCommand -> ShowS
    showsPrec :: Int -> StandardCommand -> ShowS
    $cshow :: StandardCommand -> String
    show :: StandardCommand -> String
    $cshowList :: [StandardCommand] -> ShowS
    showList :: [StandardCommand] -> ShowS
    Show, ReadPrec [StandardCommand]
    ReadPrec StandardCommand
    Int -> ReadS StandardCommand
    ReadS [StandardCommand]
    (Int -> ReadS StandardCommand)
    -> ReadS [StandardCommand]
    -> ReadPrec StandardCommand
    -> ReadPrec [StandardCommand]
    -> Read StandardCommand
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS StandardCommand
    readsPrec :: Int -> ReadS StandardCommand
    $creadList :: ReadS [StandardCommand]
    readList :: ReadS [StandardCommand]
    $creadPrec :: ReadPrec StandardCommand
    readPrec :: ReadPrec StandardCommand
    $creadListPrec :: ReadPrec [StandardCommand]
    readListPrec :: ReadPrec [StandardCommand]
    Read)

    instance Default StandardCommand where
      def :: StandardCommand
    def = StandardCommand
    FocusWindow

    instance WindowCommand StandardCommand where
      executeWindowCommand :: StandardCommand -> Window -> X Bool
    executeWindowCommand StandardCommand
    FocusWindow Window
    w = do
        Window -> X ()
    focus Window
    w
        Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      executeWindowCommand StandardCommand
    FocusUp Window
    _ = do
        (WindowSet -> WindowSet) -> X ()
    windows WindowSet -> WindowSet
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.focusUp
        (Window -> X ()) -> X ()
    withFocused Window -> X ()
    maximizeWindowAndFocus
        Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      executeWindowCommand StandardCommand
    FocusDown Window
    _ = do
        (WindowSet -> WindowSet) -> X ()
    windows WindowSet -> WindowSet
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.focusDown
        (Window -> X ()) -> X ()
    withFocused Window -> X ()
    maximizeWindowAndFocus
        Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      executeWindowCommand StandardCommand
    MoveToNextGroup Window
    w = do
        Window -> X ()
    focus Window
    w
        Bool -> X ()
    Ex.moveToGroupDown Bool
    False
        Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      executeWindowCommand StandardCommand
    MoveToPrevGroup Window
    w = do
        Window -> X ()
    focus Window
    w
        Bool -> X ()
    Ex.moveToGroupUp Bool
    False
        Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      executeWindowCommand StandardCommand
    CloseWindow Window
    w = do
        Window -> X ()
    killWindow Window
    w
        Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      executeWindowCommand StandardCommand
    DwmPromote Window
    w = do
        Window -> X ()
    focus Window
    w
        X ()
    dwmpromote
        Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      executeWindowCommand StandardCommand
    ToggleSticky Window
    w = do
        Window -> X ()
    focus Window
    w
        [String]
    copies <- X [String]
    CW.wsContainingCopies
        if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    copies
          then (WindowSet -> WindowSet) -> X ()
    windows WindowSet -> WindowSet
    forall s i a l sd.
    (Eq s, Eq i, Eq a) =>
    StackSet i l a s sd -> StackSet i l a s sd
    CW.copyToAll
          else X ()
    CW.killAllOtherCopies
        Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      executeWindowCommand StandardCommand
    ToggleMaximize Window
    w = do
        MaximizeRestore -> X ()
    forall a. Message a => a -> X ()
    sendMessage (MaximizeRestore -> X ()) -> MaximizeRestore -> X ()
    forall a b. (a -> b) -> a -> b
    $ Window -> MaximizeRestore
    maximizeRestore Window
    w
        Window -> X ()
    focus Window
    w
        Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      executeWindowCommand StandardCommand
    Minimize Window
    w = do
        Window -> X ()
    minimizeWindow Window
    w
        Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
      executeWindowCommand StandardCommand
    GridWindowMenu Window
    w = do
        Window -> X ()
    focus Window
    w
        X ()
    windowMenu
        Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

      isCommandChecked :: StandardCommand -> Window -> X Bool
    isCommandChecked StandardCommand
    FocusWindow Window
    _ = Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      isCommandChecked StandardCommand
    DwmPromote Window
    w = do
          (WindowSet -> X Bool) -> X Bool
    forall a. (WindowSet -> X a) -> X a
    withWindowSet ((WindowSet -> X Bool) -> X Bool)
    -> (WindowSet -> X Bool) -> X Bool
    forall a b. (a -> b) -> a -> b
    $ \WindowSet
    ws -> 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
    $ Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    w Maybe Window -> Maybe Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == WindowSet -> Maybe Window
    forall {i} {l} {a} {sid} {sd}. StackSet i l a sid sd -> Maybe a
    master WindowSet
    ws
        where
          master :: StackSet i l a sid sd -> Maybe a
    master StackSet i l a sid sd
    ws =
            case Maybe (Stack a) -> [a]
    forall a. Maybe (Stack a) -> [a]
    W.integrate' (Maybe (Stack a) -> [a]) -> Maybe (Stack a) -> [a]
    forall a b. (a -> b) -> a -> b
    $ Workspace i l a -> Maybe (Stack a)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack (Workspace i l a -> Maybe (Stack a))
    -> Workspace i l a -> Maybe (Stack a)
    forall a b. (a -> b) -> a -> b
    $ Screen i l a sid sd -> Workspace i l a
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen i l a sid sd -> Workspace i l a)
    -> Screen i l a sid sd -> Workspace i l a
    forall a b. (a -> b) -> a -> b
    $ StackSet i l a sid sd -> Screen i l a sid sd
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current StackSet i l a sid sd
    ws of
              [] -> Maybe a
    forall a. Maybe a
    Nothing
              (a
    x:[a]
    _) -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x
      isCommandChecked StandardCommand
    ToggleSticky Window
    w = do
        WindowSet
    ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
        let copies :: [String]
    copies = Maybe Window -> [(String, [Window])] -> [String]
    forall a i. Eq a => Maybe a -> [(i, [a])] -> [i]
    CW.copiesOfOn (Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    w) ([Workspace String (Layout Window) Window] -> [(String, [Window])]
    forall i l a. [Workspace i l a] -> [(i, [a])]
    CW.taggedWindows ([Workspace String (Layout Window) Window] -> [(String, [Window])])
    -> [Workspace String (Layout Window) Window]
    -> [(String, [Window])]
    forall a b. (a -> b) -> a -> b
    $ WindowSet -> [Workspace String (Layout Window) Window]
    forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
    W.hidden WindowSet
    ws)
        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
    $ Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    copies
      isCommandChecked StandardCommand
    _ Window
    _ = Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    -- | Generic data type for decoration widgets.
    data GenericWidget cmd =
          TitleWidget                      -- ^ Window title (just text label)
        | WindowIcon { forall cmd. GenericWidget cmd -> cmd
    swCommand :: !cmd } -- ^ Window icon with some associated command
        -- | Other widgets
        | GenericWidget {
            forall cmd. GenericWidget cmd -> String
    swCheckedText :: !String       -- ^ Text for checked widget state
          , forall cmd. GenericWidget cmd -> String
    swUncheckedText :: !String     -- ^ Text for unchecked widget state
          , swCommand :: !cmd              -- ^ Window command
        }
        deriving (Int -> GenericWidget cmd -> ShowS
    [GenericWidget cmd] -> ShowS
    GenericWidget cmd -> String
    (Int -> GenericWidget cmd -> ShowS)
    -> (GenericWidget cmd -> String)
    -> ([GenericWidget cmd] -> ShowS)
    -> Show (GenericWidget cmd)
    forall cmd. Show cmd => Int -> GenericWidget cmd -> ShowS
    forall cmd. Show cmd => [GenericWidget cmd] -> ShowS
    forall cmd. Show cmd => GenericWidget cmd -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall cmd. Show cmd => Int -> GenericWidget cmd -> ShowS
    showsPrec :: Int -> GenericWidget cmd -> ShowS
    $cshow :: forall cmd. Show cmd => GenericWidget cmd -> String
    show :: GenericWidget cmd -> String
    $cshowList :: forall cmd. Show cmd => [GenericWidget cmd] -> ShowS
    showList :: [GenericWidget cmd] -> ShowS
    Show, ReadPrec [GenericWidget cmd]
    ReadPrec (GenericWidget cmd)
    Int -> ReadS (GenericWidget cmd)
    ReadS [GenericWidget cmd]
    (Int -> ReadS (GenericWidget cmd))
    -> ReadS [GenericWidget cmd]
    -> ReadPrec (GenericWidget cmd)
    -> ReadPrec [GenericWidget cmd]
    -> Read (GenericWidget cmd)
    forall cmd. Read cmd => ReadPrec [GenericWidget cmd]
    forall cmd. Read cmd => ReadPrec (GenericWidget cmd)
    forall cmd. Read cmd => Int -> ReadS (GenericWidget cmd)
    forall cmd. Read cmd => ReadS [GenericWidget cmd]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall cmd. Read cmd => Int -> ReadS (GenericWidget cmd)
    readsPrec :: Int -> ReadS (GenericWidget cmd)
    $creadList :: forall cmd. Read cmd => ReadS [GenericWidget cmd]
    readList :: ReadS [GenericWidget cmd]
    $creadPrec :: forall cmd. Read cmd => ReadPrec (GenericWidget cmd)
    readPrec :: ReadPrec (GenericWidget cmd)
    $creadListPrec :: forall cmd. Read cmd => ReadPrec [GenericWidget cmd]
    readListPrec :: ReadPrec [GenericWidget cmd]
    Read)

    -- | Generic widget type specialized for 'StandardCommand'
    type StandardWidget = GenericWidget StandardCommand

    instance (Default cmd, Read cmd, Show cmd, WindowCommand cmd) => DecorationWidget (GenericWidget cmd) where

      type WidgetCommand (GenericWidget cmd) = cmd

      widgetCommand :: GenericWidget cmd -> Int -> WidgetCommand (GenericWidget cmd)
    widgetCommand GenericWidget cmd
    TitleWidget Int
    _ = cmd
    WidgetCommand (GenericWidget cmd)
    forall a. Default a => a
    def
      widgetCommand GenericWidget cmd
    w Int
    1 = GenericWidget cmd -> cmd
    forall cmd. GenericWidget cmd -> cmd
    swCommand GenericWidget cmd
    w
      widgetCommand GenericWidget cmd
    _ Int
    _ = cmd
    WidgetCommand (GenericWidget cmd)
    forall a. Default a => a
    def

      isShrinkable :: GenericWidget cmd -> Bool
    isShrinkable GenericWidget cmd
    TitleWidget = Bool
    True
      isShrinkable GenericWidget cmd
    _ = Bool
    False

    -- | Check if the widget should be displayed in `checked' state.
    isWidgetChecked :: DecorationWidget widget => widget -> Window -> X Bool
    isWidgetChecked :: forall widget.
    DecorationWidget widget =>
    widget -> Window -> X Bool
    isWidgetChecked widget
    wdt = WidgetCommand widget -> Window -> X Bool
    forall cmd. WindowCommand cmd => cmd -> Window -> X Bool
    isCommandChecked (widget -> Int -> WidgetCommand widget
    forall widget.
    DecorationWidget widget =>
    widget -> Int -> WidgetCommand widget
    widgetCommand widget
    wdt Int
    1)

    -- | Type class for widgets that can be displayed as
    -- text fragments by 'TextDecoration' engine.
    class DecorationWidget widget => TextWidget widget where
      widgetString :: DrawData engine widget -> widget -> X String

    instance TextWidget StandardWidget where
        widgetString :: forall (engine :: * -> * -> *).
    DrawData engine StandardWidget -> StandardWidget -> X String
    widgetString DrawData engine StandardWidget
    dd StandardWidget
    TitleWidget = String -> X String
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> X String) -> String -> X String
    forall a b. (a -> b) -> a -> b
    $ DrawData engine StandardWidget -> String
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> String
    ddWindowTitle DrawData engine StandardWidget
    dd
        widgetString DrawData engine StandardWidget
    _ (WindowIcon {}) = String -> X String
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "[*]"
        widgetString DrawData engine StandardWidget
    dd StandardWidget
    w = do
          Bool
    checked <- StandardWidget -> Window -> X Bool
    forall widget.
    DecorationWidget widget =>
    widget -> Window -> X Bool
    isWidgetChecked StandardWidget
    w (DrawData engine StandardWidget -> Window
    forall (engine :: * -> * -> *) widget.
    DrawData engine widget -> Window
    ddOrigWindow DrawData engine StandardWidget
    dd)
          if Bool
    checked
            then String -> X String
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> X String) -> String -> X String
    forall a b. (a -> b) -> a -> b
    $ StandardWidget -> String
    forall cmd. GenericWidget cmd -> String
    swCheckedText StandardWidget
    w
            else String -> X String
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> X String) -> String -> X String
    forall a b. (a -> b) -> a -> b
    $ StandardWidget -> String
    forall cmd. GenericWidget cmd -> String
    swUncheckedText StandardWidget
    w

    -- | Widget for window title
    titleW :: StandardWidget
    titleW :: StandardWidget
    titleW = StandardWidget
    forall cmd. GenericWidget cmd
    TitleWidget

    -- | Widget for ToggleSticky command.
    toggleStickyW :: StandardWidget
    toggleStickyW :: StandardWidget
    toggleStickyW = String -> String -> StandardCommand -> StandardWidget
    forall cmd. String -> String -> cmd -> GenericWidget cmd
    GenericWidget String
    "[S]" String
    "[s]" StandardCommand
    ToggleSticky

    -- | Widget for Minimize command
    minimizeW :: StandardWidget
    minimizeW :: StandardWidget
    minimizeW = String -> String -> StandardCommand -> StandardWidget
    forall cmd. String -> String -> cmd -> GenericWidget cmd
    GenericWidget String
    "" String
    "[_]" StandardCommand
    Minimize

    -- | Widget for ToggleMaximize command
    maximizeW :: StandardWidget
    maximizeW :: StandardWidget
    maximizeW = String -> String -> StandardCommand -> StandardWidget
    forall cmd. String -> String -> cmd -> GenericWidget cmd
    GenericWidget String
    "" String
    "[O]" StandardCommand
    ToggleMaximize

    -- | Widget for CloseWindow command
    closeW :: StandardWidget
    closeW :: StandardWidget
    closeW = String -> String -> StandardCommand -> StandardWidget
    forall cmd. String -> String -> cmd -> GenericWidget cmd
    GenericWidget String
    "" String
    "[X]" StandardCommand
    CloseWindow

    dwmpromoteW :: StandardWidget
    dwmpromoteW :: StandardWidget
    dwmpromoteW = String -> String -> StandardCommand -> StandardWidget
    forall cmd. String -> String -> cmd -> GenericWidget cmd
    GenericWidget String
    "[M]" String
    "[m]" StandardCommand
    DwmPromote

    moveToNextGroupW :: StandardWidget
    moveToNextGroupW :: StandardWidget
    moveToNextGroupW = String -> String -> StandardCommand -> StandardWidget
    forall cmd. String -> String -> cmd -> GenericWidget cmd
    GenericWidget String
    "" String
    "[>]" StandardCommand
    MoveToNextGroup

    moveToPrevGroupW :: StandardWidget
    moveToPrevGroupW :: StandardWidget
    moveToPrevGroupW = String -> String -> StandardCommand -> StandardWidget
    forall cmd. String -> String -> cmd -> GenericWidget cmd
    GenericWidget String
    "" String
    "[<]" StandardCommand
    MoveToPrevGroup