    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE InstanceSigs          #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE NamedFieldPuns        #-}
    --------------------------------------------------------------------
    -- |
    -- Module      : XMonad.Layout.SideBorderDecoration
    -- Description : Configure the border position around windows.
    -- Copyright   : (c) 2018  L. S. Leary
    --                   2022  Tony Zorman
    -- License     : BSD3
    -- Maintainer  : Tony Zorman <soliditsallgood@mailbox.org>
    --
    -- This module allows for having a configurable border position around
    -- windows; i.e., it can move the border to any cardinal direction.
    --
    --------------------------------------------------------------------
    module XMonad.Layout.SideBorderDecoration (
      -- * Usage
      -- $usage
      sideBorder,

      -- * Border configuration
      SideBorderConfig (..),
      def,

      -- * Re-exports
      Direction2D (..),

      -- * Lower-level hooks
      sideBorderLayout,
    ) where

    import qualified XMonad.StackSet as W

    import XMonad
    import XMonad.Layout.Decoration
    import XMonad.StackSet (Stack)
    import XMonad.Util.Types

    {- $usage

    To use this module, first import it into your configuration file:

    > import XMonad.Layout.SideBorderDecoration

    You can now add the 'sideBorder' combinator to your configuration:

    > main :: IO ()
    > main = xmonad
    >      $ …
    >      $ sideBorder mySideBorderConfig
    >      $ def { … }
    >  where
    >   mySideBorderConfig :: SideBorderConfig
    >   mySideBorderConfig = def
    >     { sbSide          = D
    >     , sbActiveColor   = "#ff0000"
    >     , sbInactiveColor = "#ffaaaa"
    >     , sbSize          = 5
    >     }

    or, alternatively,

    > main :: IO ()
    > main = xmonad
    >      $ …
    >      $ sideBorder def{ sbSide = D, sbActiveColor = "#ff000", … }
    >      $ def { … }

    See 'SideBorderConfig' for the different size and colour options.

    The following is a fully-functional, minimal configuration example:

    > import XMonad
    > import XMonad.Layout.SideBorderDecoration
    >
    > main :: IO ()
    > main = xmonad $ sideBorder def $ def

    This would result in the following border being displayed:

    <<https://user-images.githubusercontent.com/50166980/184537672-136f85a3-dfe7-42e2-b4c8-356d934d1bff.png>>

    -}

    -----------------------------------------------------------------------
    -- Configuration

    -- | Configuring how the border looks like.
    data SideBorderConfig = SideBorderConfig
      { SideBorderConfig -> Direction2D
    sbSide          :: !Direction2D  -- ^ Which side to have the border on.
      , SideBorderConfig -> String
    sbActiveColor   :: !String       -- ^ Active border colour.
      , SideBorderConfig -> String
    sbInactiveColor :: !String       -- ^ Inactive border colour.
      , SideBorderConfig -> Dimension
    sbSize          :: !Dimension
        -- ^ Size of the border.  This will be the height if 'sbSide' is 'U'
        --   or 'D' and the width if it is 'L' or 'R'.
      }

    instance Default SideBorderConfig where
      def :: SideBorderConfig
      def :: SideBorderConfig
    def = SideBorderConfig
        { sbSide :: Direction2D
    sbSide          = Direction2D
    D
        , sbActiveColor :: String
    sbActiveColor   = String
    "#ff0000"
        , sbInactiveColor :: String
    sbInactiveColor = String
    "#ffaaaa"
        , sbSize :: Dimension
    sbSize          = Dimension
    5
        }

    -----------------------------------------------------------------------
    -- User-facing

    -- | Move the default XMonad border to any of the four cardinal
    -- directions.
    --
    -- Note that this function should only be applied once to your
    -- configuration and should /not/ be combined with 'sideBorderLayout'.
    sideBorder :: SideBorderConfig -> XConfig l -> XConfig (SideBorder l)
    sideBorder :: forall (l :: * -> *).
    SideBorderConfig -> XConfig l -> XConfig (SideBorder l)
    sideBorder SideBorderConfig
    sbc XConfig l
    cfg =
      XConfig l
    cfg{ layoutHook  = sideBorderLayout sbc (layoutHook cfg)
         , borderWidth = 0
         }

    -- | Layout hook to only enable the side border for some layouts.  For
    -- example:
    --
    -- > myLayout = Full ||| sideBorderLayout def tall ||| somethingElse
    --
    -- Note that, unlike 'sideBorder', this does /not/ disable the normal
    -- border in XMonad, you will have to do this yourself.  Remove this
    -- function from your layout hook and use 'sideBorder' if you want a
    -- side border in every layout (do not use the two functions together).
    sideBorderLayout :: Eq a => SideBorderConfig -> l a -> SideBorder l a
    sideBorderLayout :: forall a (l :: * -> *).
    Eq a =>
    SideBorderConfig -> l a -> SideBorder l a
    sideBorderLayout SideBorderConfig{ Direction2D
    sbSide :: SideBorderConfig -> Direction2D
    sbSide :: Direction2D
    sbSide, String
    sbActiveColor :: SideBorderConfig -> String
    sbActiveColor :: String
    sbActiveColor, String
    sbInactiveColor :: SideBorderConfig -> String
    sbInactiveColor :: String
    sbInactiveColor, Dimension
    sbSize :: SideBorderConfig -> Dimension
    sbSize :: Dimension
    sbSize } =
      BorderShrinker
    -> Theme
    -> SideBorderDecoration a
    -> l a
    -> ModifiedLayout
         (Decoration SideBorderDecoration BorderShrinker) l a
    forall (ds :: * -> *) a s (l :: * -> *).
    (DecorationStyle ds a, Shrinker s) =>
    s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
    decoration BorderShrinker
    BorderShrinker Theme
    theme (Direction2D -> SideBorderDecoration a
    forall a. Direction2D -> SideBorderDecoration a
    SideBorderDecoration Direction2D
    sbSide)
     where
      theme :: Theme
      theme :: Theme
    theme = Theme
    deco
        { activeColor   = sbActiveColor
        , inactiveColor = sbInactiveColor
        }
       where
        deco :: Theme
    deco | Direction2D
    sbSide Direction2D -> [Direction2D] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Direction2D
    U, Direction2D
    D] = Theme
    forall a. Default a => a
    def{ decoHeight = sbSize }
             | Bool
    otherwise            = Theme
    forall a. Default a => a
    def{ decoWidth  = sbSize }

    -----------------------------------------------------------------------
    -- Decoration

    newtype SideBorderDecoration a = SideBorderDecoration Direction2D
      deriving (Int -> SideBorderDecoration a -> ShowS
    [SideBorderDecoration a] -> ShowS
    SideBorderDecoration a -> String
    (Int -> SideBorderDecoration a -> ShowS)
    -> (SideBorderDecoration a -> String)
    -> ([SideBorderDecoration a] -> ShowS)
    -> Show (SideBorderDecoration a)
    forall a. Int -> SideBorderDecoration a -> ShowS
    forall a. [SideBorderDecoration a] -> ShowS
    forall a. SideBorderDecoration a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Int -> SideBorderDecoration a -> ShowS
    showsPrec :: Int -> SideBorderDecoration a -> ShowS
    $cshow :: forall a. SideBorderDecoration a -> String
    show :: SideBorderDecoration a -> String
    $cshowList :: forall a. [SideBorderDecoration a] -> ShowS
    showList :: [SideBorderDecoration a] -> ShowS
    Show, ReadPrec [SideBorderDecoration a]
    ReadPrec (SideBorderDecoration a)
    Int -> ReadS (SideBorderDecoration a)
    ReadS [SideBorderDecoration a]
    (Int -> ReadS (SideBorderDecoration a))
    -> ReadS [SideBorderDecoration a]
    -> ReadPrec (SideBorderDecoration a)
    -> ReadPrec [SideBorderDecoration a]
    -> Read (SideBorderDecoration a)
    forall a. ReadPrec [SideBorderDecoration a]
    forall a. ReadPrec (SideBorderDecoration a)
    forall a. Int -> ReadS (SideBorderDecoration a)
    forall a. ReadS [SideBorderDecoration a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Int -> ReadS (SideBorderDecoration a)
    readsPrec :: Int -> ReadS (SideBorderDecoration a)
    $creadList :: forall a. ReadS [SideBorderDecoration a]
    readList :: ReadS [SideBorderDecoration a]
    $creadPrec :: forall a. ReadPrec (SideBorderDecoration a)
    readPrec :: ReadPrec (SideBorderDecoration a)
    $creadListPrec :: forall a. ReadPrec [SideBorderDecoration a]
    readListPrec :: ReadPrec [SideBorderDecoration a]
    Read)

    type SideBorder = ModifiedLayout (Decoration SideBorderDecoration BorderShrinker)

    instance Eq a => DecorationStyle SideBorderDecoration a where
      shrink :: SideBorderDecoration a -> Rectangle -> Rectangle -> Rectangle
      shrink :: SideBorderDecoration a -> Rectangle -> Rectangle -> Rectangle
    shrink SideBorderDecoration a
    dec (Rectangle Position
    _ Position
    _ Dimension
    dw Dimension
    dh) (Rectangle Position
    x Position
    y Dimension
    w Dimension
    h) = case SideBorderDecoration a
    dec of
        SideBorderDecoration Direction2D
    U -> 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)
        SideBorderDecoration Direction2D
    R -> Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x           Position
    y           (Dimension
    w Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    dw) Dimension
    h
        SideBorderDecoration Direction2D
    D -> Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x           Position
    y           Dimension
    w        (Dimension
    h Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    dh)
        SideBorderDecoration Direction2D
    L -> Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (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
    dw) Position
    y           (Dimension
    w Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    dw) Dimension
    h

      pureDecoration
        :: SideBorderDecoration a
        -> Dimension -> Dimension
        -> Rectangle
        -> Stack a
        -> [(a, Rectangle)]
        -> (a, Rectangle)
        -> Maybe Rectangle
      pureDecoration :: SideBorderDecoration a
    -> Dimension
    -> Dimension
    -> Rectangle
    -> Stack a
    -> [(a, Rectangle)]
    -> (a, Rectangle)
    -> Maybe Rectangle
    pureDecoration SideBorderDecoration a
    dec Dimension
    dw Dimension
    dh Rectangle
    _ Stack a
    st [(a, Rectangle)]
    _ (a
    win, Rectangle Position
    x Position
    y Dimension
    w Dimension
    h)
        | a
    win 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
    st Bool -> Bool -> Bool
    && Dimension
    dw Dimension -> Dimension -> Bool
    forall a. Ord a => a -> a -> Bool
    < Dimension
    w Bool -> Bool -> Bool
    && Dimension
    dh Dimension -> Dimension -> Bool
    forall a. Ord a => a -> a -> Bool
    < Dimension
    h = Rectangle -> Maybe Rectangle
    forall a. a -> Maybe a
    Just (Rectangle -> Maybe Rectangle) -> Rectangle -> Maybe Rectangle
    forall a b. (a -> b) -> a -> b
    $ case SideBorderDecoration a
    dec of
          SideBorderDecoration Direction2D
    U -> Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x                 Position
    y                 Dimension
    w  Dimension
    dh
          SideBorderDecoration Direction2D
    R -> Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (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 Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    dw)) Position
    y                 Dimension
    dw Dimension
    h
          SideBorderDecoration Direction2D
    D -> 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
    h Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    dh)) Dimension
    w  Dimension
    dh
          SideBorderDecoration Direction2D
    L -> Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x                 Position
    y                 Dimension
    dw Dimension
    h
        | Bool
    otherwise = Maybe Rectangle
    forall a. Maybe a
    Nothing

    -----------------------------------------------------------------------
    -- Shrinker

    -- | Kill all text.
    data BorderShrinker = BorderShrinker

    instance Show BorderShrinker where
      show :: BorderShrinker -> String
      show :: BorderShrinker -> String
    show BorderShrinker
    _ = String
    ""

    instance Read BorderShrinker where
      readsPrec :: Int -> ReadS BorderShrinker
      readsPrec :: Int -> ReadS BorderShrinker
    readsPrec Int
    _ String
    s = [(BorderShrinker
    BorderShrinker, String
    s)]

    instance Shrinker BorderShrinker where
      shrinkIt :: BorderShrinker -> String -> [String]
      shrinkIt :: BorderShrinker -> String -> [String]
    shrinkIt BorderShrinker
    _ String
    _ = [String
    ""]