    {-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-}
    ----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.BorderResize
    -- Copyright   :  (c) Jan Vornberger 2009
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
    -- Stability   :  unstable
    -- Portability :  not portable
    --
    -- This layout modifier will allow to resize windows by dragging their
    -- borders with the mouse. However, it only works in layouts or modified
    -- layouts that react to the 'SetGeometry' message.
    -- "XMonad.Layout.WindowArranger" can be used to create such a setup,
    -- but it is probably must useful in a floating layout such as
    -- "XMonad.Layout.PositionStoreFloat" with which it has been mainly tested.
    -- See the documentation of PositionStoreFloat for a typical usage example.
    --
    -----------------------------------------------------------------------------

    module XMonad.Layout.BorderResize
        ( -- * Usage
          -- $usage
          borderResize
        , BorderResize (..)
        , RectWithBorders, BorderInfo,
        ) where

    import XMonad
    import XMonad.Layout.Decoration
    import XMonad.Layout.WindowArranger
    import XMonad.Util.XUtils
    import Control.Monad(when)
    import qualified Data.Map as M

    -- $usage
    -- You can use this module with the following in your
    -- @~\/.xmonad\/xmonad.hs@:
    --
    -- > import XMonad.Layout.BorderResize
    -- > myLayout = borderResize (... layout setup that reacts to SetGeometry ...)
    -- > main = xmonad def { layoutHook = myLayout }
    --

    type BorderBlueprint = (Rectangle, Glyph, BorderType)

    data BorderType = RightSideBorder
                        | LeftSideBorder
                        | TopSideBorder
                        | BottomSideBorder
                        deriving (Int -> BorderType -> ShowS
    [BorderType] -> ShowS
    BorderType -> String
    (Int -> BorderType -> ShowS)
    -> (BorderType -> String)
    -> ([BorderType] -> ShowS)
    -> Show BorderType
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [BorderType] -> ShowS
    $cshowList :: [BorderType] -> ShowS
    show :: BorderType -> String
    $cshow :: BorderType -> String
    showsPrec :: Int -> BorderType -> ShowS
    $cshowsPrec :: Int -> BorderType -> ShowS
    Show, ReadPrec [BorderType]
    ReadPrec BorderType
    Int -> ReadS BorderType
    ReadS [BorderType]
    (Int -> ReadS BorderType)
    -> ReadS [BorderType]
    -> ReadPrec BorderType
    -> ReadPrec [BorderType]
    -> Read BorderType
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [BorderType]
    $creadListPrec :: ReadPrec [BorderType]
    readPrec :: ReadPrec BorderType
    $creadPrec :: ReadPrec BorderType
    readList :: ReadS [BorderType]
    $creadList :: ReadS [BorderType]
    readsPrec :: Int -> ReadS BorderType
    $creadsPrec :: Int -> ReadS BorderType
    Read, BorderType -> BorderType -> Bool
    (BorderType -> BorderType -> Bool)
    -> (BorderType -> BorderType -> Bool) -> Eq BorderType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: BorderType -> BorderType -> Bool
    $c/= :: BorderType -> BorderType -> Bool
    == :: BorderType -> BorderType -> Bool
    $c== :: BorderType -> BorderType -> Bool
    Eq)
    data BorderInfo = BI { BorderInfo -> Window
    bWin :: Window,
                            BorderInfo -> Rectangle
    bRect :: Rectangle,
                            BorderInfo -> BorderType
    bType :: BorderType
                         } deriving (Int -> BorderInfo -> ShowS
    [BorderInfo] -> ShowS
    BorderInfo -> String
    (Int -> BorderInfo -> ShowS)
    -> (BorderInfo -> String)
    -> ([BorderInfo] -> ShowS)
    -> Show BorderInfo
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [BorderInfo] -> ShowS
    $cshowList :: [BorderInfo] -> ShowS
    show :: BorderInfo -> String
    $cshow :: BorderInfo -> String
    showsPrec :: Int -> BorderInfo -> ShowS
    $cshowsPrec :: Int -> BorderInfo -> ShowS
    Show, ReadPrec [BorderInfo]
    ReadPrec BorderInfo
    Int -> ReadS BorderInfo
    ReadS [BorderInfo]
    (Int -> ReadS BorderInfo)
    -> ReadS [BorderInfo]
    -> ReadPrec BorderInfo
    -> ReadPrec [BorderInfo]
    -> Read BorderInfo
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [BorderInfo]
    $creadListPrec :: ReadPrec [BorderInfo]
    readPrec :: ReadPrec BorderInfo
    $creadPrec :: ReadPrec BorderInfo
    readList :: ReadS [BorderInfo]
    $creadList :: ReadS [BorderInfo]
    readsPrec :: Int -> ReadS BorderInfo
    $creadsPrec :: Int -> ReadS BorderInfo
    Read)

    type RectWithBorders = (Rectangle, [BorderInfo])

    data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Int -> BorderResize a -> ShowS
    [BorderResize a] -> ShowS
    BorderResize a -> String
    (Int -> BorderResize a -> ShowS)
    -> (BorderResize a -> String)
    -> ([BorderResize a] -> ShowS)
    -> Show (BorderResize a)
    forall a. Int -> BorderResize a -> ShowS
    forall a. [BorderResize a] -> ShowS
    forall a. BorderResize a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [BorderResize a] -> ShowS
    $cshowList :: forall a. [BorderResize a] -> ShowS
    show :: BorderResize a -> String
    $cshow :: forall a. BorderResize a -> String
    showsPrec :: Int -> BorderResize a -> ShowS
    $cshowsPrec :: forall a. Int -> BorderResize a -> ShowS
    Show, ReadPrec [BorderResize a]
    ReadPrec (BorderResize a)
    Int -> ReadS (BorderResize a)
    ReadS [BorderResize a]
    (Int -> ReadS (BorderResize a))
    -> ReadS [BorderResize a]
    -> ReadPrec (BorderResize a)
    -> ReadPrec [BorderResize a]
    -> Read (BorderResize a)
    forall a. ReadPrec [BorderResize a]
    forall a. ReadPrec (BorderResize a)
    forall a. Int -> ReadS (BorderResize a)
    forall a. ReadS [BorderResize a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [BorderResize a]
    $creadListPrec :: forall a. ReadPrec [BorderResize a]
    readPrec :: ReadPrec (BorderResize a)
    $creadPrec :: forall a. ReadPrec (BorderResize a)
    readList :: ReadS [BorderResize a]
    $creadList :: forall a. ReadS [BorderResize a]
    readsPrec :: Int -> ReadS (BorderResize a)
    $creadsPrec :: forall a. Int -> ReadS (BorderResize a)
    Read)

    brBorderSize :: Dimension
    brBorderSize :: Dimension
    brBorderSize = 2

    borderResize :: l a -> ModifiedLayout BorderResize l a
    borderResize :: l a -> ModifiedLayout BorderResize l a
    borderResize = BorderResize a -> l a -> ModifiedLayout BorderResize l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout (Map Window RectWithBorders -> BorderResize a
    forall a. Map Window RectWithBorders -> BorderResize a
    BR Map Window RectWithBorders
    forall k a. Map k a
    M.empty)

    instance LayoutModifier BorderResize Window where
        redoLayout :: BorderResize Window
    -> Rectangle
    -> Maybe (Stack Window)
    -> [(Window, Rectangle)]
    -> X ([(Window, Rectangle)], Maybe (BorderResize Window))
    redoLayout _       _ Nothing  wrs :: [(Window, Rectangle)]
    wrs = ([(Window, Rectangle)], Maybe (BorderResize Window))
    -> X ([(Window, Rectangle)], Maybe (BorderResize Window))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Window, Rectangle)]
    wrs, Maybe (BorderResize Window)
    forall a. Maybe a
    Nothing)
        redoLayout (BR wrsLastTime :: Map Window RectWithBorders
    wrsLastTime) _ _ wrs :: [(Window, Rectangle)]
    wrs = do
                let correctOrder :: [Window]
    correctOrder = ((Window, Rectangle) -> Window)
    -> [(Window, Rectangle)] -> [Window]
    forall a b. (a -> b) -> [a] -> [b]
    map (Window, Rectangle) -> Window
    forall a b. (a, b) -> a
    fst [(Window, Rectangle)]
    wrs
                    wrsCurrent :: Map Window Rectangle
    wrsCurrent = [(Window, Rectangle)] -> Map Window Rectangle
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(Window, Rectangle)]
    wrs
                    wrsGone :: Map Window RectWithBorders
    wrsGone = Map Window RectWithBorders
    -> Map Window Rectangle -> Map Window RectWithBorders
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    M.difference Map Window RectWithBorders
    wrsLastTime Map Window Rectangle
    wrsCurrent
                    wrsAppeared :: Map Window Rectangle
    wrsAppeared = Map Window Rectangle
    -> Map Window RectWithBorders -> Map Window Rectangle
    forall k a b. Ord k => Map k a -> Map k b -> Map k a
    M.difference Map Window Rectangle
    wrsCurrent Map Window RectWithBorders
    wrsLastTime
                    wrsStillThere :: Map Window (Maybe Rectangle, RectWithBorders)
    wrsStillThere = (RectWithBorders
     -> Rectangle -> (Maybe Rectangle, RectWithBorders))
    -> Map Window RectWithBorders
    -> Map Window Rectangle
    -> Map Window (Maybe Rectangle, RectWithBorders)
    forall k a b c.
    Ord k =>
    (a -> b -> c) -> Map k a -> Map k b -> Map k c
    M.intersectionWith RectWithBorders -> Rectangle -> (Maybe Rectangle, RectWithBorders)
    forall a b. Eq a => (a, b) -> a -> (Maybe a, (a, b))
    testIfUnchanged Map Window RectWithBorders
    wrsLastTime Map Window Rectangle
    wrsCurrent
                Map Window RectWithBorders -> X ()
    handleGone Map Window RectWithBorders
    wrsGone
                Map Window RectWithBorders
    wrsCreated <- Map Window Rectangle -> X (Map Window RectWithBorders)
    handleAppeared Map Window Rectangle
    wrsAppeared
                let wrsChanged :: Map Window RectWithBorders
    wrsChanged = Map Window (Maybe Rectangle, RectWithBorders)
    -> Map Window RectWithBorders
    handleStillThere Map Window (Maybe Rectangle, RectWithBorders)
    wrsStillThere
                    wrsThisTime :: Map Window RectWithBorders
    wrsThisTime = Map Window RectWithBorders
    -> Map Window RectWithBorders -> Map Window RectWithBorders
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    M.union Map Window RectWithBorders
    wrsChanged Map Window RectWithBorders
    wrsCreated
                ([(Window, Rectangle)], Maybe (BorderResize Window))
    -> X ([(Window, Rectangle)], Maybe (BorderResize Window))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)]
    compileWrs Map Window RectWithBorders
    wrsThisTime [Window]
    correctOrder, BorderResize Window -> Maybe (BorderResize Window)
    forall a. a -> Maybe a
    Just (BorderResize Window -> Maybe (BorderResize Window))
    -> BorderResize Window -> Maybe (BorderResize Window)
    forall a b. (a -> b) -> a -> b
    $ Map Window RectWithBorders -> BorderResize Window
    forall a. Map Window RectWithBorders -> BorderResize a
    BR Map Window RectWithBorders
    wrsThisTime)
                -- What we return is the original wrs with the new border
                -- windows inserted at the correct positions - this way, the core
                -- will restack the borders correctly.
                -- We also return information about our borders, so that we
                -- can handle events that they receive and destroy them when
                -- they are no longer needed.
            where
                testIfUnchanged :: (a, b) -> a -> (Maybe a, (a, b))
    testIfUnchanged entry :: (a, b)
    entry@(rLastTime :: a
    rLastTime, _) rCurrent :: a
    rCurrent =
                    if a
    rLastTime a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    rCurrent
                        then (Maybe a
    forall a. Maybe a
    Nothing, (a, b)
    entry)
                        else (a -> Maybe a
    forall a. a -> Maybe a
    Just a
    rCurrent, (a, b)
    entry)

        handleMess :: BorderResize Window
    -> SomeMessage -> X (Maybe (BorderResize Window))
    handleMess (BR wrsLastTime :: Map Window RectWithBorders
    wrsLastTime) m :: SomeMessage
    m
            | Just e :: Event
    e <- SomeMessage -> Maybe Event
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m :: Maybe Event =
                [(Window, (BorderType, Window, Rectangle))] -> Event -> X ()
    handleResize (Map Window RectWithBorders
    -> [(Window, (BorderType, Window, Rectangle))]
    createBorderLookupTable Map Window RectWithBorders
    wrsLastTime) Event
    e X ()
    -> X (Maybe (BorderResize Window))
    -> X (Maybe (BorderResize Window))
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe (BorderResize Window) -> X (Maybe (BorderResize Window))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (BorderResize Window)
    forall a. Maybe a
    Nothing
            | Just _ <- SomeMessage -> Maybe LayoutMessages
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m :: Maybe LayoutMessages =
                Map Window RectWithBorders -> X ()
    handleGone Map Window RectWithBorders
    wrsLastTime X ()
    -> X (Maybe (BorderResize Window))
    -> X (Maybe (BorderResize Window))
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Maybe (BorderResize Window) -> X (Maybe (BorderResize Window))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BorderResize Window -> Maybe (BorderResize Window)
    forall a. a -> Maybe a
    Just (BorderResize Window -> Maybe (BorderResize Window))
    -> BorderResize Window -> Maybe (BorderResize Window)
    forall a b. (a -> b) -> a -> b
    $ Map Window RectWithBorders -> BorderResize Window
    forall a. Map Window RectWithBorders -> BorderResize a
    BR Map Window RectWithBorders
    forall k a. Map k a
    M.empty)
        handleMess _ _ = Maybe (BorderResize Window) -> X (Maybe (BorderResize Window))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (BorderResize Window)
    forall a. Maybe a
    Nothing

    compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)]
    compileWrs :: Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)]
    compileWrs wrsThisTime :: Map Window RectWithBorders
    wrsThisTime correctOrder :: [Window]
    correctOrder = let wrs :: [(Window, RectWithBorders)]
    wrs = [(Window, RectWithBorders)]
    -> [Window] -> [(Window, RectWithBorders)]
    forall a b. Eq a => [(a, b)] -> [a] -> [(a, b)]
    reorder (Map Window RectWithBorders -> [(Window, RectWithBorders)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Window RectWithBorders
    wrsThisTime) [Window]
    correctOrder
                                          in [[(Window, Rectangle)]] -> [(Window, Rectangle)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(Window, Rectangle)]] -> [(Window, Rectangle)])
    -> [[(Window, Rectangle)]] -> [(Window, Rectangle)]
    forall a b. (a -> b) -> a -> b
    $ ((Window, RectWithBorders) -> [(Window, Rectangle)])
    -> [(Window, RectWithBorders)] -> [[(Window, Rectangle)]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Window, RectWithBorders) -> [(Window, Rectangle)]
    compileWr [(Window, RectWithBorders)]
    wrs

    compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)]
    compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)]
    compileWr (w :: Window
    w, (r :: Rectangle
    r, borderInfos :: [BorderInfo]
    borderInfos)) =
        let borderWrs :: [(Window, Rectangle)]
    borderWrs = [BorderInfo]
    -> (BorderInfo -> (Window, Rectangle)) -> [(Window, Rectangle)]
    forall a b. [a] -> (a -> b) -> [b]
    for [BorderInfo]
    borderInfos ((BorderInfo -> (Window, Rectangle)) -> [(Window, Rectangle)])
    -> (BorderInfo -> (Window, Rectangle)) -> [(Window, Rectangle)]
    forall a b. (a -> b) -> a -> b
    $ \bi :: BorderInfo
    bi -> (BorderInfo -> Window
    bWin BorderInfo
    bi, BorderInfo -> Rectangle
    bRect BorderInfo
    bi)
        in [(Window, Rectangle)]
    borderWrs [(Window, Rectangle)]
    -> [(Window, Rectangle)] -> [(Window, Rectangle)]
    forall a. [a] -> [a] -> [a]
    ++ [(Window
    w, Rectangle
    r)]

    handleGone :: M.Map Window RectWithBorders -> X ()
    handleGone :: Map Window RectWithBorders -> X ()
    handleGone wrsGone :: Map Window RectWithBorders
    wrsGone = (Window -> X ()) -> [Window] -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Window -> X ()
    deleteWindow [Window]
    borderWins
        where
            borderWins :: [Window]
    borderWins = (BorderInfo -> Window) -> [BorderInfo] -> [Window]
    forall a b. (a -> b) -> [a] -> [b]
    map BorderInfo -> Window
    bWin ([BorderInfo] -> [Window])
    -> (Map Window RectWithBorders -> [BorderInfo])
    -> Map Window RectWithBorders
    -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[BorderInfo]] -> [BorderInfo]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[BorderInfo]] -> [BorderInfo])
    -> (Map Window RectWithBorders -> [[BorderInfo]])
    -> Map Window RectWithBorders
    -> [BorderInfo]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RectWithBorders -> [BorderInfo])
    -> [RectWithBorders] -> [[BorderInfo]]
    forall a b. (a -> b) -> [a] -> [b]
    map RectWithBorders -> [BorderInfo]
    forall a b. (a, b) -> b
    snd ([RectWithBorders] -> [[BorderInfo]])
    -> (Map Window RectWithBorders -> [RectWithBorders])
    -> Map Window RectWithBorders
    -> [[BorderInfo]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map Window RectWithBorders -> [RectWithBorders]
    forall k a. Map k a -> [a]
    M.elems (Map Window RectWithBorders -> [Window])
    -> Map Window RectWithBorders -> [Window]
    forall a b. (a -> b) -> a -> b
    $ Map Window RectWithBorders
    wrsGone

    handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders)
    handleAppeared :: Map Window Rectangle -> X (Map Window RectWithBorders)
    handleAppeared wrsAppeared :: Map Window Rectangle
    wrsAppeared = do
        let wrs :: [(Window, Rectangle)]
    wrs = Map Window Rectangle -> [(Window, Rectangle)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Window Rectangle
    wrsAppeared
        [(Window, RectWithBorders)]
    wrsCreated <- ((Window, Rectangle) -> X (Window, RectWithBorders))
    -> [(Window, Rectangle)] -> X [(Window, RectWithBorders)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Window, Rectangle) -> X (Window, RectWithBorders)
    handleSingleAppeared [(Window, Rectangle)]
    wrs
        Map Window RectWithBorders -> X (Map Window RectWithBorders)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map Window RectWithBorders -> X (Map Window RectWithBorders))
    -> Map Window RectWithBorders -> X (Map Window RectWithBorders)
    forall a b. (a -> b) -> a -> b
    $ [(Window, RectWithBorders)] -> Map Window RectWithBorders
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList [(Window, RectWithBorders)]
    wrsCreated

    handleSingleAppeared :: (Window, Rectangle) -> X (Window, RectWithBorders)
    handleSingleAppeared :: (Window, Rectangle) -> X (Window, RectWithBorders)
    handleSingleAppeared (w :: Window
    w, r :: Rectangle
    r) = do
        let borderBlueprints :: [BorderBlueprint]
    borderBlueprints = Rectangle -> [BorderBlueprint]
    prepareBorders Rectangle
    r
        [BorderInfo]
    borderInfos <- (BorderBlueprint -> X BorderInfo)
    -> [BorderBlueprint] -> X [BorderInfo]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM BorderBlueprint -> X BorderInfo
    createBorder [BorderBlueprint]
    borderBlueprints
        (Window, RectWithBorders) -> X (Window, RectWithBorders)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Window
    w, (Rectangle
    r, [BorderInfo]
    borderInfos))

    handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders
    handleStillThere :: Map Window (Maybe Rectangle, RectWithBorders)
    -> Map Window RectWithBorders
    handleStillThere wrsStillThere :: Map Window (Maybe Rectangle, RectWithBorders)
    wrsStillThere = ((Maybe Rectangle, RectWithBorders) -> RectWithBorders)
    -> Map Window (Maybe Rectangle, RectWithBorders)
    -> Map Window RectWithBorders
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map (Maybe Rectangle, RectWithBorders) -> RectWithBorders
    handleSingleStillThere Map Window (Maybe Rectangle, RectWithBorders)
    wrsStillThere

    handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders
    handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders
    handleSingleStillThere (Nothing, entry :: RectWithBorders
    entry) = RectWithBorders
    entry
    handleSingleStillThere (Just rCurrent :: Rectangle
    rCurrent, (_, borderInfos :: [BorderInfo]
    borderInfos)) = (Rectangle
    rCurrent, [BorderInfo]
    updatedBorderInfos)
        where
            changedBorderBlueprints :: [BorderBlueprint]
    changedBorderBlueprints = Rectangle -> [BorderBlueprint]
    prepareBorders Rectangle
    rCurrent
            updatedBorderInfos :: [BorderInfo]
    updatedBorderInfos = ((BorderInfo, BorderBlueprint) -> BorderInfo)
    -> [(BorderInfo, BorderBlueprint)] -> [BorderInfo]
    forall a b. (a -> b) -> [a] -> [b]
    map (BorderInfo, BorderBlueprint) -> BorderInfo
    updateBorderInfo ([(BorderInfo, BorderBlueprint)] -> [BorderInfo])
    -> ([BorderBlueprint] -> [(BorderInfo, BorderBlueprint)])
    -> [BorderBlueprint]
    -> [BorderInfo]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [BorderInfo]
    -> [BorderBlueprint] -> [(BorderInfo, BorderBlueprint)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [BorderInfo]
    borderInfos ([BorderBlueprint] -> [BorderInfo])
    -> [BorderBlueprint] -> [BorderInfo]
    forall a b. (a -> b) -> a -> b
    $ [BorderBlueprint]
    changedBorderBlueprints
              -- assuming that the four borders are always in the same order

    updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo
    updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo
    updateBorderInfo (borderInfo :: BorderInfo
    borderInfo, (r :: Rectangle
    r, _, _)) = BorderInfo
    borderInfo { bRect :: Rectangle
    bRect = Rectangle
    r }

    createBorderLookupTable :: M.Map Window RectWithBorders -> [(Window, (BorderType, Window, Rectangle))]
    createBorderLookupTable :: Map Window RectWithBorders
    -> [(Window, (BorderType, Window, Rectangle))]
    createBorderLookupTable wrsLastTime :: Map Window RectWithBorders
    wrsLastTime = [[(Window, (BorderType, Window, Rectangle))]]
    -> [(Window, (BorderType, Window, Rectangle))]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(Window, (BorderType, Window, Rectangle))]]
     -> [(Window, (BorderType, Window, Rectangle))])
    -> [[(Window, (BorderType, Window, Rectangle))]]
    -> [(Window, (BorderType, Window, Rectangle))]
    forall a b. (a -> b) -> a -> b
    $ ((Window, RectWithBorders)
     -> [(Window, (BorderType, Window, Rectangle))])
    -> [(Window, RectWithBorders)]
    -> [[(Window, (BorderType, Window, Rectangle))]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Window, RectWithBorders)
    -> [(Window, (BorderType, Window, Rectangle))]
    processSingleEntry ([(Window, RectWithBorders)]
     -> [[(Window, (BorderType, Window, Rectangle))]])
    -> [(Window, RectWithBorders)]
    -> [[(Window, (BorderType, Window, Rectangle))]]
    forall a b. (a -> b) -> a -> b
    $ Map Window RectWithBorders -> [(Window, RectWithBorders)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Window RectWithBorders
    wrsLastTime
        where
            processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))]
            processSingleEntry :: (Window, RectWithBorders)
    -> [(Window, (BorderType, Window, Rectangle))]
    processSingleEntry (w :: Window
    w, (r :: Rectangle
    r, borderInfos :: [BorderInfo]
    borderInfos)) = [BorderInfo]
    -> (BorderInfo -> (Window, (BorderType, Window, Rectangle)))
    -> [(Window, (BorderType, Window, Rectangle))]
    forall a b. [a] -> (a -> b) -> [b]
    for [BorderInfo]
    borderInfos ((BorderInfo -> (Window, (BorderType, Window, Rectangle)))
     -> [(Window, (BorderType, Window, Rectangle))])
    -> (BorderInfo -> (Window, (BorderType, Window, Rectangle)))
    -> [(Window, (BorderType, Window, Rectangle))]
    forall a b. (a -> b) -> a -> b
    $ \bi :: BorderInfo
    bi -> (BorderInfo -> Window
    bWin BorderInfo
    bi, (BorderInfo -> BorderType
    bType BorderInfo
    bi, Window
    w, Rectangle
    r))

    prepareBorders :: Rectangle -> [BorderBlueprint]
    prepareBorders :: Rectangle -> [BorderBlueprint]
    prepareBorders (Rectangle x :: Position
    x y :: Position
    y wh :: Dimension
    wh ht :: Dimension
    ht) =
        [((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
    wh Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    brBorderSize) Position
    y Dimension
    brBorderSize Dimension
    ht), Glyph
    xC_right_side , BorderType
    RightSideBorder),
         ((Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x Position
    y Dimension
    brBorderSize Dimension
    ht)                            , Glyph
    xC_left_side  , BorderType
    LeftSideBorder),
         ((Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x Position
    y Dimension
    wh Dimension
    brBorderSize)                            , Glyph
    xC_top_side   , BorderType
    TopSideBorder),
         ((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
    ht Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    brBorderSize) Dimension
    wh Dimension
    brBorderSize), Glyph
    xC_bottom_side, BorderType
    BottomSideBorder)
        ]

    handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X ()
    handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X ()
    handleResize borders :: [(Window, (BorderType, Window, Rectangle))]
    borders ButtonEvent { ev_window :: Event -> Window
    ev_window = Window
    ew, ev_event_type :: Event -> Dimension
    ev_event_type = Dimension
    et }
        | Dimension
    et Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    buttonPress, Just edge :: (BorderType, Window, Rectangle)
    edge <- Window
    -> [(Window, (BorderType, Window, Rectangle))]
    -> Maybe (BorderType, Window, Rectangle)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Window
    ew [(Window, (BorderType, Window, Rectangle))]
    borders =
        case (BorderType, Window, Rectangle)
    edge of
            (RightSideBorder, hostWin :: Window
    hostWin, (Rectangle hx :: Position
    hx hy :: Position
    hy _ hht :: Dimension
    hht)) ->
                (Position -> Position -> X ()) -> X () -> X ()
    mouseDrag (\x :: Position
    x _ -> do
                                let nwh :: Dimension
    nwh = Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    max 1 (Dimension -> Dimension) -> Dimension -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (Position
    x Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    hx)
                                    rect :: Rectangle
    rect = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    hx Position
    hy Dimension
    nwh Dimension
    hht
                                Window -> X ()
    focus Window
    hostWin
                                Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Position
    x Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    hx Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ WindowArrangerMsg -> X ()
    forall a. Message a => a -> X ()
    sendMessage (Rectangle -> WindowArrangerMsg
    SetGeometry Rectangle
    rect)) (Window -> X ()
    focus Window
    hostWin)
            (LeftSideBorder, hostWin :: Window
    hostWin, (Rectangle hx :: Position
    hx hy :: Position
    hy hwh :: Dimension
    hwh hht :: Dimension
    hht)) ->
                (Position -> Position -> X ()) -> X () -> X ()
    mouseDrag (\x :: Position
    x _ -> do
                                let nx :: Position
    nx = Position -> Position -> Position
    forall a. Ord a => a -> a -> a
    max 0 (Position -> Position) -> Position -> Position
    forall a b. (a -> b) -> a -> b
    $ Position -> Position -> Position
    forall a. Ord a => a -> a -> a
    min (Position
    hx Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    hwh) (Position -> Position) -> Position -> Position
    forall a b. (a -> b) -> a -> b
    $ Position
    x
                                    nwh :: Dimension
    nwh = Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    max 1 (Dimension -> Dimension) -> Dimension -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Dimension
    hwh Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    + Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (Position
    hx Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    x)
                                    rect :: Rectangle
    rect = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    nx Position
    hy Dimension
    nwh Dimension
    hht
                                Window -> X ()
    focus Window
    hostWin
                                Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Position
    x Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    < Position
    hx Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    hwh) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ WindowArrangerMsg -> X ()
    forall a. Message a => a -> X ()
    sendMessage (Rectangle -> WindowArrangerMsg
    SetGeometry Rectangle
    rect)) (Window -> X ()
    focus Window
    hostWin)
            (TopSideBorder, hostWin :: Window
    hostWin, (Rectangle hx :: Position
    hx hy :: Position
    hy hwh :: Dimension
    hwh hht :: Dimension
    hht)) ->
                (Position -> Position -> X ()) -> X () -> X ()
    mouseDrag (\_ y :: Position
    y -> do
                                let ny :: Position
    ny = Position -> Position -> Position
    forall a. Ord a => a -> a -> a
    max 0 (Position -> Position) -> Position -> Position
    forall a b. (a -> b) -> a -> b
    $ Position -> Position -> Position
    forall a. Ord a => a -> a -> a
    min (Position
    hy Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    hht) (Position -> Position) -> Position -> Position
    forall a b. (a -> b) -> a -> b
    $ Position
    y
                                    nht :: Dimension
    nht = Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    max 1 (Dimension -> Dimension) -> Dimension -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Dimension
    hht Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    + Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (Position
    hy Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    y)
                                    rect :: Rectangle
    rect = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    hx Position
    ny Dimension
    hwh Dimension
    nht
                                Window -> X ()
    focus Window
    hostWin
                                Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Position
    y Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    < Position
    hy Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    hht) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ WindowArrangerMsg -> X ()
    forall a. Message a => a -> X ()
    sendMessage (Rectangle -> WindowArrangerMsg
    SetGeometry Rectangle
    rect)) (Window -> X ()
    focus Window
    hostWin)
            (BottomSideBorder, hostWin :: Window
    hostWin, (Rectangle hx :: Position
    hx hy :: Position
    hy hwh :: Dimension
    hwh _)) ->
                (Position -> Position -> X ()) -> X () -> X ()
    mouseDrag (\_ y :: Position
    y -> do
                                let nht :: Dimension
    nht = Dimension -> Dimension -> Dimension
    forall a. Ord a => a -> a -> a
    max 1 (Dimension -> Dimension) -> Dimension -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (Position
    y Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    hy)
                                    rect :: Rectangle
    rect = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    hx Position
    hy Dimension
    hwh Dimension
    nht
                                Window -> X ()
    focus Window
    hostWin
                                Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Position
    y Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    hy Position -> Position -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ WindowArrangerMsg -> X ()
    forall a. Message a => a -> X ()
    sendMessage (Rectangle -> WindowArrangerMsg
    SetGeometry Rectangle
    rect)) (Window -> X ()
    focus Window
    hostWin)
    handleResize _ _ = () -> X ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    createBorder :: BorderBlueprint -> X (BorderInfo)
    createBorder :: BorderBlueprint -> X BorderInfo
    createBorder (borderRect :: Rectangle
    borderRect, borderCursor :: Glyph
    borderCursor, borderType :: BorderType
    borderType) = do
        Window
    borderWin <- Glyph -> Rectangle -> X Window
    createInputWindow Glyph
    borderCursor Rectangle
    borderRect
        BorderInfo -> X BorderInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return BI :: Window -> Rectangle -> BorderType -> BorderInfo
    BI { bWin :: Window
    bWin = Window
    borderWin, bRect :: Rectangle
    bRect = Rectangle
    borderRect, bType :: BorderType
    bType = BorderType
    borderType }

    createInputWindow :: Glyph -> Rectangle -> X Window
    createInputWindow :: Glyph -> Rectangle -> X Window
    createInputWindow cursorGlyph :: Glyph
    cursorGlyph r :: Rectangle
    r = (Display -> X Window) -> X Window
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X Window) -> X Window)
    -> (Display -> X Window) -> X Window
    forall a b. (a -> b) -> a -> b
    $ \d :: Display
    d -> do
        Window
    win <- Display -> Rectangle -> X Window
    mkInputWindow Display
    d Rectangle
    r
        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 -> Window -> IO ()
    selectInput Display
    d Window
    win (Window
    exposureMask Window -> Window -> Window
    forall a. Bits a => a -> a -> a
    .|. Window
    buttonPressMask)
        Window
    cursor <- IO Window -> X Window
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Window -> X Window) -> IO Window -> X Window
    forall a b. (a -> b) -> a -> b
    $ Display -> Glyph -> IO Window
    createFontCursor Display
    d Glyph
    cursorGlyph
        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 -> Window -> IO ()
    defineCursor Display
    d Window
    win Window
    cursor
        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 -> IO ()
    freeCursor Display
    d Window
    cursor
        Window -> X ()
    showWindow Window
    win
        Window -> X Window
    forall (m :: * -> *) a. Monad m => a -> m a
    return Window
    win

    mkInputWindow :: Display -> Rectangle -> X Window
    mkInputWindow :: Display -> Rectangle -> X Window
    mkInputWindow d :: Display
    d (Rectangle x :: Position
    x y :: Position
    y w :: Dimension
    w h :: Dimension
    h) = do
      Window
    rw <- (XConf -> Window) -> X Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Window
    theRoot
      let screen :: Screen
    screen   = Display -> Screen
    defaultScreenOfDisplay Display
    d
          visual :: Visual
    visual   = Screen -> Visual
    defaultVisualOfScreen Screen
    screen
          attrmask :: Window
    attrmask = Window
    cWOverrideRedirect
      IO Window -> X Window
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Window -> X Window) -> IO Window -> X Window
    forall a b. (a -> b) -> a -> b
    $ (Ptr SetWindowAttributes -> IO Window) -> IO Window
    forall a. (Ptr SetWindowAttributes -> IO a) -> IO a
    allocaSetWindowAttributes ((Ptr SetWindowAttributes -> IO Window) -> IO Window)
    -> (Ptr SetWindowAttributes -> IO Window) -> IO Window
    forall a b. (a -> b) -> a -> b
    $
             \attributes :: Ptr SetWindowAttributes
    attributes -> do
               Ptr SetWindowAttributes -> Bool -> IO ()
    set_override_redirect Ptr SetWindowAttributes
    attributes Bool
    True
               Display
    -> Window
    -> Position
    -> Position
    -> Dimension
    -> Dimension
    -> CInt
    -> CInt
    -> CInt
    -> Visual
    -> Window
    -> Ptr SetWindowAttributes
    -> IO Window
    createWindow Display
    d Window
    rw Position
    x Position
    y Dimension
    w Dimension
    h 0 0 CInt
    inputOnly Visual
    visual Window
    attrmask Ptr SetWindowAttributes
    attributes

    for :: [a] -> (a -> b) -> [b]
    for :: [a] -> (a -> b) -> [b]
    for = ((a -> b) -> [a] -> [b]) -> [a] -> (a -> b) -> [b]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (a -> b) -> [a] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map

    reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)]
    reorder :: [(a, b)] -> [a] -> [(a, b)]
    reorder wrs :: [(a, b)]
    wrs order :: [a]
    order =
        let ordered :: [(a, b)]
    ordered = [[(a, b)]] -> [(a, b)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[(a, b)]] -> [(a, b)]) -> [[(a, b)]] -> [(a, b)]
    forall a b. (a -> b) -> a -> b
    $ (a -> [(a, b)]) -> [a] -> [[(a, b)]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([(a, b)] -> a -> [(a, b)]
    forall a b. Eq a => [(a, b)] -> a -> [(a, b)]
    pickElem [(a, b)]
    wrs) [a]
    order
            rest :: [(a, b)]
    rest = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(w :: a
    w, _) -> Bool -> Bool
    not (a
    w a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [a]
    order)) [(a, b)]
    wrs
        in [(a, b)]
    ordered [(a, b)] -> [(a, b)] -> [(a, b)]
    forall a. [a] -> [a] -> [a]
    ++ [(a, b)]
    rest
        where
            pickElem :: [(a, b)] -> a -> [(a, b)]
    pickElem list :: [(a, b)]
    list e :: a
    e = case (a -> [(a, b)] -> Maybe b
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup a
    e [(a, b)]
    list) of
                                    Just result :: b
    result -> [(a
    e, b
    result)]
                                    Nothing -> []