    {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE UndecidableInstances #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.DecorationEx.Geometry
    -- Description :  Type class which is responsible for defining the placement
    --                of window decorations
    -- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger, 2023 Ilya Portnov
    -- License     :  BSD-style (see xmonad/LICENSE)
    --
    -- Maintainer  :  portnov84@rambler.ru
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- This module defines @DecorationGeometry@ type class, and default implementation for it.
    -----------------------------------------------------------------------------

    module XMonad.Layout.DecorationEx.Geometry (
        DecorationGeometry (..),
        DefaultGeometry (..)
      ) where

    import XMonad
    import XMonad.Prelude
    import qualified XMonad.StackSet as W
    import qualified XMonad.Layout.Decoration as D

    -- | Decoration geometry class.
    -- Decoration geometry is responsible for placement of window decorations: whether
    -- they should be on the top of the window or on the bottom, should they go for
    -- full window width or only be of certain width, etc.
    -- This does not know what will be drawn inside decorations.
    class (Read (geom a), Show (geom a),
           Eq a)
        => DecorationGeometry geom a where

        -- | Give a name to decoration geometry implementation.
        describeGeometry :: geom a -> String

        -- | Reduce original window size to make space for decoration, if necessary.
        shrinkWindow :: geom a -> Rectangle -> Rectangle -> Rectangle
        shrinkWindow geom 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 pure version of the main method, 'decorate'.
        -- The method should return a rectangle where to place window decoration,
        -- or 'Nothing' if this window is not to be decorated.
        pureDecoration :: geom a          -- ^ Decoration geometry instance
                       -> Rectangle       -- ^ Screen rectangle
                       -> W.Stack a       -- ^ Current stack of windows being displayed
                       -> [(a,Rectangle)] -- ^ Set of all windows with their corresponding rectangle
                       -> (a,Rectangle)   -- ^ Window being decorated and its rectangle
                       -> Maybe Rectangle

        -- | The method should return a rectangle where to place window decoration,
        -- or 'Nothing' if this window is not to be decorated.
        decorateWindow :: geom a           -- ^ Decoration geometry instance
                       -> Rectangle        -- ^ Screen rectangle
                       -> W.Stack a        -- ^ Current stack of windows being displayed
                       -> [(a, Rectangle)] -- ^ Set of all windows with their corresponding rectangle
                       -> (a, Rectangle)   -- ^ Window being decorated and its rectangle
                       -> X (Maybe Rectangle)
        decorateWindow geom a
    geom 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
    $ geom a
    -> Rectangle
    -> Stack a
    -> [(a, Rectangle)]
    -> (a, Rectangle)
    -> Maybe Rectangle
    forall (geom :: * -> *) a.
    DecorationGeometry geom a =>
    geom a
    -> Rectangle
    -> Stack a
    -> [(a, Rectangle)]
    -> (a, Rectangle)
    -> Maybe Rectangle
    pureDecoration geom a
    geom Rectangle
    r Stack a
    s [(a, Rectangle)]
    wrs (a, Rectangle)
    wr

    -- | Data type for default implementation of 'DecorationGeometry'.
    -- This defines simple decorations: a horizontal bar at the top of each window,
    -- running for full width of the window.
    newtype DefaultGeometry a = DefaultGeometry {
        forall a. DefaultGeometry a -> Dimension
    gDecorationHeight :: Dimension
      }
      deriving (ReadPrec [DefaultGeometry a]
    ReadPrec (DefaultGeometry a)
    Int -> ReadS (DefaultGeometry a)
    ReadS [DefaultGeometry a]
    (Int -> ReadS (DefaultGeometry a))
    -> ReadS [DefaultGeometry a]
    -> ReadPrec (DefaultGeometry a)
    -> ReadPrec [DefaultGeometry a]
    -> Read (DefaultGeometry a)
    forall a. ReadPrec [DefaultGeometry a]
    forall a. ReadPrec (DefaultGeometry a)
    forall a. Int -> ReadS (DefaultGeometry a)
    forall a. ReadS [DefaultGeometry a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Int -> ReadS (DefaultGeometry a)
    readsPrec :: Int -> ReadS (DefaultGeometry a)
    $creadList :: forall a. ReadS [DefaultGeometry a]
    readList :: ReadS [DefaultGeometry a]
    $creadPrec :: forall a. ReadPrec (DefaultGeometry a)
    readPrec :: ReadPrec (DefaultGeometry a)
    $creadListPrec :: forall a. ReadPrec [DefaultGeometry a]
    readListPrec :: ReadPrec [DefaultGeometry a]
    Read, Int -> DefaultGeometry a -> ShowS
    [DefaultGeometry a] -> ShowS
    DefaultGeometry a -> String
    (Int -> DefaultGeometry a -> ShowS)
    -> (DefaultGeometry a -> String)
    -> ([DefaultGeometry a] -> ShowS)
    -> Show (DefaultGeometry a)
    forall a. Int -> DefaultGeometry a -> ShowS
    forall a. [DefaultGeometry a] -> ShowS
    forall a. DefaultGeometry a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Int -> DefaultGeometry a -> ShowS
    showsPrec :: Int -> DefaultGeometry a -> ShowS
    $cshow :: forall a. DefaultGeometry a -> String
    show :: DefaultGeometry a -> String
    $cshowList :: forall a. [DefaultGeometry a] -> ShowS
    showList :: [DefaultGeometry a] -> ShowS
    Show)

    instance Eq a => DecorationGeometry DefaultGeometry a where
      describeGeometry :: DefaultGeometry a -> String
    describeGeometry DefaultGeometry a
    _ = String
    "Default"

      pureDecoration :: DefaultGeometry a
    -> Rectangle
    -> Stack a
    -> [(a, Rectangle)]
    -> (a, Rectangle)
    -> Maybe Rectangle
    pureDecoration (DefaultGeometry {Dimension
    gDecorationHeight :: forall a. DefaultGeometry a -> Dimension
    gDecorationHeight :: Dimension
    ..}) Rectangle
    _ Stack a
    s [(a, Rectangle)]
    _ (a
    w, Rectangle Position
    x Position
    y Dimension
    windowWidth Dimension
    windowHeight) =
          if Stack a -> a -> Bool
    forall a. Eq a => Stack a -> a -> Bool
    D.isInStack Stack a
    s a
    w Bool -> Bool -> Bool
    && (Dimension
    gDecorationHeight Dimension -> Dimension -> Bool
    forall a. Ord a => a -> a -> Bool
    < Dimension
    windowHeight)
            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
    windowWidth Dimension
    gDecorationHeight
            else Maybe Rectangle
    forall a. Maybe a
    Nothing

    instance Default (DefaultGeometry a) where
      def :: DefaultGeometry a
    def = Dimension -> DefaultGeometry a
    forall a. Dimension -> DefaultGeometry a
    DefaultGeometry Dimension
    20