    {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
    {-# LANGUAGE ParallelListComp, PatternGuards #-}
    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE LambdaCase #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module       : XMonad.Layout.LayoutHints
    -- Description :  Make layouts respect size hints.
    -- Copyright    : (c) David Roundy <droundy@darcs.net>
    -- License      : BSD
    --
    -- Maintainer   : none
    -- Stability    : unstable
    -- Portability  : unportable
    --
    -- Make layouts respect size hints.
    -----------------------------------------------------------------------------

    module XMonad.Layout.LayoutHints
        ( -- * usage
          -- $usage
          layoutHints
        , layoutHintsWithPlacement
        , layoutHintsToCenter
        , LayoutHints
        , LayoutHintsToCenter
        , hintsEventHook
        -- * For developers
        , placeRectangle
        )  where

    import XMonad(LayoutClass(runLayout), mkAdjust, Window,
                  Dimension, Position, Rectangle(Rectangle), D,
                  X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS,
                  (<&&>), io, applySizeHints, whenX, isClient, withDisplay,
                  getWMNormalHints, WindowAttributes(..))
    import XMonad.Prelude
    import qualified XMonad.StackSet as W

    import XMonad.Layout.Decoration(isInStack)
    import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
                                        LayoutModifier(modifyLayout, redoLayout, modifierDescription))
    import XMonad.Util.Types(Direction2D(..))
    import Control.Arrow(Arrow((***), first, second))

    import Data.Set (Set)
    import qualified Data.Set as Set

    -- $usage
    -- You can use this module with the following in your @xmonad.hs@:
    --
    -- > import XMonad.Layout.LayoutHints
    --
    -- Then edit your @layoutHook@ by adding the 'layoutHints' layout modifier
    -- to some layout:
    --
    -- > myLayout = layoutHints (Tall 1 (3/100) (1/2))  ||| Full ||| etc..
    -- > main = xmonad def { layoutHook = myLayout }
    --
    -- Or, to center the adapted window in its available area:
    --
    -- > myLayout = layoutHintsWithPlacement (0.5, 0.5) (Tall 1 (3/100) (1/2))
    -- >                   ||| Full ||| etc..
    --
    -- Or, to make a reasonable attempt to eliminate gaps between windows:
    --
    -- > myLayout = layoutHintsToCenter (Tall 1 (3/100) (1/2))
    --
    -- For more detailed instructions on editing the layoutHook see
    -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
    -- "XMonad.Doc.Extending#Editing_the_layout_hook".
    --
    -- To make XMonad reflect changes in window hints immediately, add
    -- 'hintsEventHook' to your 'handleEventHook'.
    --
    -- > myHandleEventHook = hintsEventHook <> ...
    -- >
    -- > main = xmonad def { handleEventHook = myHandleEventHook
    -- >                   , ... }

    layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a
    layoutHints :: forall (l :: * -> *) a.
    LayoutClass l a =>
    l a -> ModifiedLayout LayoutHints l a
    layoutHints = LayoutHints a -> l a -> ModifiedLayout LayoutHints l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout ((Double, Double) -> LayoutHints a
    forall a. (Double, Double) -> LayoutHints a
    LayoutHints (Double
    0, Double
    0))

    -- | @layoutHintsWithPlacement (rx, ry) layout@ will adapt the sizes of a layout's
    -- windows according to their size hints, and position them inside their
    -- originally assigned area according to the @rx@ and @ry@ parameters.
    -- (0, 0) places the window at the top left, (1, 0) at the top right, (0.5, 0.5)
    -- at the center, etc.
    layoutHintsWithPlacement :: (LayoutClass l a) => (Double, Double)
                             -> l a -> ModifiedLayout LayoutHints l a
    layoutHintsWithPlacement :: forall (l :: * -> *) a.
    LayoutClass l a =>
    (Double, Double) -> l a -> ModifiedLayout LayoutHints l a
    layoutHintsWithPlacement (Double, Double)
    rs = LayoutHints a -> l a -> ModifiedLayout LayoutHints l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout ((Double, Double) -> LayoutHints a
    forall a. (Double, Double) -> LayoutHints a
    LayoutHints (Double, Double)
    rs)

    -- | @layoutHintsToCenter layout@ applies hints, sliding the window to the
    -- center of the screen and expanding its neighbors to fill the gaps. Windows
    -- are never expanded in a way that increases overlap.
    --
    -- @layoutHintsToCenter@ only makes one pass at resizing the neighbors of
    -- hinted windows, so with some layouts (ex. the arrangement with two 'Mirror'
    -- 'Tall' stacked vertically), @layoutHintsToCenter@ may leave some gaps.
    -- Simple layouts like 'Tall' are unaffected.
    layoutHintsToCenter :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHintsToCenter l a
    layoutHintsToCenter :: forall (l :: * -> *) a.
    LayoutClass l a =>
    l a -> ModifiedLayout LayoutHintsToCenter l a
    layoutHintsToCenter = LayoutHintsToCenter a
    -> l a -> ModifiedLayout LayoutHintsToCenter l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout LayoutHintsToCenter a
    forall a. LayoutHintsToCenter a
    LayoutHintsToCenter

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

    instance LayoutModifier LayoutHints Window where
        modifierDescription :: LayoutHints Atom -> String
    modifierDescription LayoutHints Atom
    _ = String
    "Hinted"
        redoLayout :: LayoutHints Atom
    -> Rectangle
    -> Maybe (Stack Atom)
    -> [(Atom, Rectangle)]
    -> X ([(Atom, Rectangle)], Maybe (LayoutHints Atom))
    redoLayout LayoutHints Atom
    _ Rectangle
    _ Maybe (Stack Atom)
    Nothing  [(Atom, Rectangle)]
    xs = ([(Atom, Rectangle)], Maybe (LayoutHints Atom))
    -> X ([(Atom, Rectangle)], Maybe (LayoutHints Atom))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Atom, Rectangle)]
    xs, Maybe (LayoutHints Atom)
    forall a. Maybe a
    Nothing)
        redoLayout (LayoutHints (Double, Double)
    al) Rectangle
    _ (Just Stack Atom
    s) [(Atom, Rectangle)]
    xs
            = do [(Atom, Rectangle)]
    xs' <- ((Atom, Rectangle) -> X (Atom, Rectangle))
    -> [(Atom, Rectangle)] -> X [(Atom, Rectangle)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\x :: (Atom, Rectangle)
    x@(Atom
    _, Rectangle
    r) -> (Rectangle -> Rectangle) -> (Atom, Rectangle) -> (Atom, Rectangle)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second ((Double, Double) -> Rectangle -> Rectangle -> Rectangle
    forall r.
    RealFrac r =>
    (r, r) -> Rectangle -> Rectangle -> Rectangle
    placeRectangle (Double, Double)
    al Rectangle
    r) ((Atom, Rectangle) -> (Atom, Rectangle))
    -> X (Atom, Rectangle) -> X (Atom, Rectangle)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Atom, Rectangle) -> X (Atom, Rectangle)
    applyHint (Atom, Rectangle)
    x) [(Atom, Rectangle)]
    xs
                 ([(Atom, Rectangle)], Maybe (LayoutHints Atom))
    -> X ([(Atom, Rectangle)], Maybe (LayoutHints Atom))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Atom, Rectangle)]
    xs', Maybe (LayoutHints Atom)
    forall a. Maybe a
    Nothing)
         where
            applyHint :: (Atom, Rectangle) -> X (Atom, Rectangle)
    applyHint (Atom
    w,r :: Rectangle
    r@(Rectangle Position
    a Position
    b Dimension
    c Dimension
    d)) = do
                (Dimension, Dimension) -> (Dimension, Dimension)
    adj <- Atom -> X ((Dimension, Dimension) -> (Dimension, Dimension))
    mkAdjust Atom
    w
                let (Dimension
    c',Dimension
    d') = (Dimension, Dimension) -> (Dimension, Dimension)
    adj (Dimension
    c,Dimension
    d)
                (Atom, Rectangle) -> X (Atom, Rectangle)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Atom
    w, if Stack Atom -> Atom -> Bool
    forall a. Eq a => Stack a -> a -> Bool
    isInStack Stack Atom
    s Atom
    w then Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    a Position
    b Dimension
    c' Dimension
    d' else Rectangle
    r)

    -- | @placeRectangle (rx, ry) r0 r@ will return a new rectangle with the same dimensions
    -- as @r@, but positioned inside of @r0@ as specified by the (rx, ry) parameters (see
    -- 'layoutHintsWithPlacement').
    placeRectangle :: RealFrac r => (r, r) -> Rectangle -> Rectangle -> Rectangle
    placeRectangle :: forall r.
    RealFrac r =>
    (r, r) -> Rectangle -> Rectangle -> Rectangle
    placeRectangle (r
    rx, r
    ry) (Rectangle Position
    x0 Position
    y0 Dimension
    w Dimension
    h) (Rectangle Position
    _ Position
    _ Dimension
    dx Dimension
    dy)
        = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (Position -> Dimension -> Dimension -> r -> Position
    forall r.
    RealFrac r =>
    Position -> Dimension -> Dimension -> r -> Position
    align Position
    x0 Dimension
    dx Dimension
    w r
    rx) (Position -> Dimension -> Dimension -> r -> Position
    forall r.
    RealFrac r =>
    Position -> Dimension -> Dimension -> r -> Position
    align Position
    y0 Dimension
    dy Dimension
    h r
    ry) Dimension
    dx Dimension
    dy
        where align :: RealFrac r => Position -> Dimension -> Dimension -> r -> Position
              align :: forall r.
    RealFrac r =>
    Position -> Dimension -> Dimension -> r -> Position
    align Position
    z0 Dimension
    dz Dimension
    d r
    r = Position
    z0 Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + r -> Position
    forall b. Integral b => r -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    truncate (Dimension -> r
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Dimension
    d Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Dimension
    dz) r -> r -> r
    forall a. Num a => a -> a -> a
    * r
    r)

    fitting :: [Rectangle] -> Int
    fitting :: [Rectangle] -> Int
    fitting [Rectangle]
    rects = [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ do
        Rectangle
    r <- [Rectangle]
    rects
        Int -> [Int]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> [Int]) -> Int -> [Int]
    forall a b. (a -> b) -> a -> b
    $ [Rectangle] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Rectangle] -> Int) -> [Rectangle] -> Int
    forall a b. (a -> b) -> a -> b
    $ (Rectangle -> Bool) -> [Rectangle] -> [Rectangle]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Rectangle -> Rectangle -> Bool
    touching Rectangle
    r) [Rectangle]
    rects

    applyOrder :: Rectangle -> [((Window, Rectangle),t)] -> [[((Window, Rectangle),t)]]
    applyOrder :: forall t.
    Rectangle -> [((Atom, Rectangle), t)] -> [[((Atom, Rectangle), t)]]
    applyOrder Rectangle
    root [((Atom, Rectangle), t)]
    wrs = do
        -- perhaps it would just be better to take all permutations, or apply the
        -- resizing multiple times
        [Position] -> Position
    f <- [[Position] -> Position
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum, [Position] -> Position
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum, [Position] -> Position
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum, [Position] -> Position
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Position] -> Position)
    -> ([Position] -> [Position]) -> [Position] -> Position
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Position -> Position) -> [Position] -> [Position]
    forall a b. (a -> b) -> [a] -> [b]
    map Position -> Position
    sq]
        [((Atom, Rectangle), t)] -> [[((Atom, Rectangle), t)]]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([((Atom, Rectangle), t)] -> [[((Atom, Rectangle), t)]])
    -> [((Atom, Rectangle), t)] -> [[((Atom, Rectangle), t)]]
    forall a b. (a -> b) -> a -> b
    $ (((Atom, Rectangle), t) -> ((Atom, Rectangle), t) -> Ordering)
    -> [((Atom, Rectangle), t)] -> [((Atom, Rectangle), t)]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Position -> Position -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Position -> Position -> Ordering)
    -> (((Atom, Rectangle), t) -> Position)
    -> ((Atom, Rectangle), t)
    -> ((Atom, Rectangle), t)
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` ([Position] -> Position
    f ([Position] -> Position)
    -> (((Atom, Rectangle), t) -> [Position])
    -> ((Atom, Rectangle), t)
    -> Position
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Atom, Rectangle), t) -> [Position]
    forall {a} {b}. ((a, Rectangle), b) -> [Position]
    distance)) [((Atom, Rectangle), t)]
    wrs
        where distFC :: (Position, Position) -> Position
    distFC = (Position -> Position -> Position)
    -> (Position, Position) -> Position
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry (Position -> Position -> Position
    forall a. Num a => a -> a -> a
    (+) (Position -> Position -> Position)
    -> (Position -> Position) -> Position -> Position -> Position
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Position -> Position
    sq) ((Position, Position) -> Position)
    -> ((Position, Position) -> (Position, Position))
    -> (Position, Position)
    -> Position
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Position -> Position -> Position)
    -> (Position, Position)
    -> (Position, Position)
    -> (Position, Position)
    forall {t} {t} {b}. (t -> t -> b) -> (t, t) -> (t, t) -> (b, b)
    pairWise (-) (Rectangle -> (Position, Position)
    center Rectangle
    root)
              distance :: ((a, Rectangle), b) -> [Position]
    distance = ((Position, Position) -> Position)
    -> [(Position, Position)] -> [Position]
    forall a b. (a -> b) -> [a] -> [b]
    map (Position, Position) -> Position
    distFC ([(Position, Position)] -> [Position])
    -> (((a, Rectangle), b) -> [(Position, Position)])
    -> ((a, Rectangle), b)
    -> [Position]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rectangle -> [(Position, Position)]
    corners (Rectangle -> [(Position, Position)])
    -> (((a, Rectangle), b) -> Rectangle)
    -> ((a, Rectangle), b)
    -> [(Position, Position)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, Rectangle) -> Rectangle
    forall a b. (a, b) -> b
    snd ((a, Rectangle) -> Rectangle)
    -> (((a, Rectangle), b) -> (a, Rectangle))
    -> ((a, Rectangle), b)
    -> Rectangle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a, Rectangle), b) -> (a, Rectangle)
    forall a b. (a, b) -> a
    fst
              pairWise :: (t -> t -> b) -> (t, t) -> (t, t) -> (b, b)
    pairWise t -> t -> b
    f (t
    a,t
    b) (t
    c,t
    d) = (t -> t -> b
    f t
    a t
    c, t -> t -> b
    f t
    b t
    d)
              sq :: Position -> Position
    sq = (Position -> Position -> Position) -> Position -> Position
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join Position -> Position -> Position
    forall a. Num a => a -> a -> a
    (*)

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

    instance LayoutModifier LayoutHintsToCenter Window where
        modifyLayout :: forall (l :: * -> *).
    LayoutClass l Atom =>
    LayoutHintsToCenter Atom
    -> Workspace String (l Atom) Atom
    -> Rectangle
    -> X ([(Atom, Rectangle)], Maybe (l Atom))
    modifyLayout LayoutHintsToCenter Atom
    _ ws :: Workspace String (l Atom) Atom
    ws@(W.Workspace String
    _ l Atom
    _ Maybe (Stack Atom)
    Nothing) Rectangle
    r = Workspace String (l Atom) Atom
    -> Rectangle -> X ([(Atom, Rectangle)], Maybe (l Atom))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    Workspace String (layout a) a
    -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
    runLayout Workspace String (l Atom) Atom
    ws Rectangle
    r
        modifyLayout LayoutHintsToCenter Atom
    _ ws :: Workspace String (l Atom) Atom
    ws@(W.Workspace String
    _ l Atom
    _ (Just Stack Atom
    st)) Rectangle
    r = do
            ([(Atom, Rectangle)]
    arrs,Maybe (l Atom)
    ol) <- Workspace String (l Atom) Atom
    -> Rectangle -> X ([(Atom, Rectangle)], Maybe (l Atom))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    Workspace String (layout a) a
    -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
    runLayout Workspace String (l Atom) Atom
    ws Rectangle
    r
            (, Maybe (l Atom)
    ol) ([(Atom, Rectangle)] -> ([(Atom, Rectangle)], Maybe (l Atom)))
    -> ([((Atom, Rectangle),
          (Dimension, Dimension) -> (Dimension, Dimension))]
        -> [(Atom, Rectangle)])
    -> [((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension))]
    -> ([(Atom, Rectangle)], Maybe (l Atom))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Atom] -> [(Atom, Rectangle)] -> [(Atom, Rectangle)]
    changeOrder (Stack Atom -> Atom
    forall a. Stack a -> a
    W.focus Stack Atom
    st Atom -> [Atom] -> [Atom]
    forall a. a -> [a] -> [a]
    : (Atom -> Bool) -> [Atom] -> [Atom]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Atom -> Atom -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Stack Atom -> Atom
    forall a. Stack a -> a
    W.focus Stack Atom
    st) (((Atom, Rectangle) -> Atom) -> [(Atom, Rectangle)] -> [Atom]
    forall a b. (a -> b) -> [a] -> [b]
    map (Atom, Rectangle) -> Atom
    forall a b. (a, b) -> a
    fst [(Atom, Rectangle)]
    arrs))
                   ([(Atom, Rectangle)] -> [(Atom, Rectangle)])
    -> ([((Atom, Rectangle),
          (Dimension, Dimension) -> (Dimension, Dimension))]
        -> [(Atom, Rectangle)])
    -> [((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension))]
    -> [(Atom, Rectangle)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(Atom, Rectangle)] -> [(Atom, Rectangle)] -> Ordering)
    -> [[(Atom, Rectangle)]] -> [(Atom, Rectangle)]
    forall (t :: * -> *) a.
    Foldable t =>
    (a -> a -> Ordering) -> t a -> a
    maximumBy (Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Int -> Int -> Ordering)
    -> ([(Atom, Rectangle)] -> Int)
    -> [(Atom, Rectangle)]
    -> [(Atom, Rectangle)]
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` ([Rectangle] -> Int
    fitting ([Rectangle] -> Int)
    -> ([(Atom, Rectangle)] -> [Rectangle])
    -> [(Atom, Rectangle)]
    -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Atom, Rectangle) -> Rectangle)
    -> [(Atom, Rectangle)] -> [Rectangle]
    forall a b. (a -> b) -> [a] -> [b]
    map (Atom, Rectangle) -> Rectangle
    forall a b. (a, b) -> b
    snd))
                   ([[(Atom, Rectangle)]] -> [(Atom, Rectangle)])
    -> ([((Atom, Rectangle),
          (Dimension, Dimension) -> (Dimension, Dimension))]
        -> [[(Atom, Rectangle)]])
    -> [((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension))]
    -> [(Atom, Rectangle)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([((Atom, Rectangle),
       (Dimension, Dimension) -> (Dimension, Dimension))]
     -> [(Atom, Rectangle)])
    -> [[((Atom, Rectangle),
          (Dimension, Dimension) -> (Dimension, Dimension))]]
    -> [[(Atom, Rectangle)]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Stack Atom
    -> Rectangle
    -> [((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension))]
    -> [(Atom, Rectangle)]
    applyHints Stack Atom
    st Rectangle
    r) ([[((Atom, Rectangle),
        (Dimension, Dimension) -> (Dimension, Dimension))]]
     -> [[(Atom, Rectangle)]])
    -> ([((Atom, Rectangle),
          (Dimension, Dimension) -> (Dimension, Dimension))]
        -> [[((Atom, Rectangle),
              (Dimension, Dimension) -> (Dimension, Dimension))]])
    -> [((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension))]
    -> [[(Atom, Rectangle)]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rectangle
    -> [((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension))]
    -> [[((Atom, Rectangle),
          (Dimension, Dimension) -> (Dimension, Dimension))]]
    forall t.
    Rectangle -> [((Atom, Rectangle), t)] -> [[((Atom, Rectangle), t)]]
    applyOrder Rectangle
    r
                 ([((Atom, Rectangle),
       (Dimension, Dimension) -> (Dimension, Dimension))]
     -> ([(Atom, Rectangle)], Maybe (l Atom)))
    -> X [((Atom, Rectangle),
           (Dimension, Dimension) -> (Dimension, Dimension))]
    -> X ([(Atom, Rectangle)], Maybe (l Atom))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Atom, Rectangle)
     -> X ((Atom, Rectangle),
           (Dimension, Dimension) -> (Dimension, Dimension)))
    -> [(Atom, Rectangle)]
    -> X [((Atom, Rectangle),
           (Dimension, Dimension) -> (Dimension, Dimension))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\(Atom, Rectangle)
    x -> ((Atom, Rectangle)
    x,) (((Dimension, Dimension) -> (Dimension, Dimension))
     -> ((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension)))
    -> X ((Dimension, Dimension) -> (Dimension, Dimension))
    -> X ((Atom, Rectangle),
          (Dimension, Dimension) -> (Dimension, Dimension))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Atom -> X ((Dimension, Dimension) -> (Dimension, Dimension))
    mkAdjust ((Atom, Rectangle) -> Atom
    forall a b. (a, b) -> a
    fst (Atom, Rectangle)
    x)) [(Atom, Rectangle)]
    arrs

    changeOrder :: [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)]
    changeOrder :: [Atom] -> [(Atom, Rectangle)] -> [(Atom, Rectangle)]
    changeOrder [Atom]
    w [(Atom, Rectangle)]
    wr = [Atom] -> [Rectangle] -> [(Atom, Rectangle)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Atom]
    w' ([Rectangle] -> [(Atom, Rectangle)])
    -> [Rectangle] -> [(Atom, Rectangle)]
    forall a b. (a -> b) -> a -> b
    $ (Atom -> Rectangle) -> [Atom] -> [Rectangle]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe Rectangle -> Rectangle
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Rectangle -> Rectangle)
    -> (Atom -> Maybe Rectangle) -> Atom -> Rectangle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Atom -> [(Atom, Rectangle)] -> Maybe Rectangle)
    -> [(Atom, Rectangle)] -> Atom -> Maybe Rectangle
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Atom -> [(Atom, Rectangle)] -> Maybe Rectangle
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup [(Atom, Rectangle)]
    wr) [Atom]
    w'
        where w' :: [Atom]
    w' = (Atom -> Bool) -> [Atom] -> [Atom]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Atom -> [Atom] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ((Atom, Rectangle) -> Atom) -> [(Atom, Rectangle)] -> [Atom]
    forall a b. (a -> b) -> [a] -> [b]
    map (Atom, Rectangle) -> Atom
    forall a b. (a, b) -> a
    fst [(Atom, Rectangle)]
    wr) [Atom]
    w

    -- apply hints to first, grow adjacent windows
    applyHints :: W.Stack Window -> Rectangle -> [((Window, Rectangle),D -> D)] -> [(Window, Rectangle)]
    applyHints :: Stack Atom
    -> Rectangle
    -> [((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension))]
    -> [(Atom, Rectangle)]
    applyHints Stack Atom
    _ Rectangle
    _ [] = []
    applyHints Stack Atom
    s Rectangle
    root (((Atom
    w,lrect :: Rectangle
    lrect@(Rectangle Position
    a Position
    b Dimension
    c Dimension
    d)),(Dimension, Dimension) -> (Dimension, Dimension)
    adj):[((Atom, Rectangle),
      (Dimension, Dimension) -> (Dimension, Dimension))]
    xs) =
            let (Dimension
    c',Dimension
    d') = (Dimension, Dimension) -> (Dimension, Dimension)
    adj (Dimension
    c,Dimension
    d)
                redr :: Rectangle
    redr = (Double, Double) -> Rectangle -> Rectangle -> Rectangle
    forall r.
    RealFrac r =>
    (r, r) -> Rectangle -> Rectangle -> Rectangle
    placeRectangle (Rectangle -> Rectangle -> (Double, Double)
    forall r. RealFrac r => Rectangle -> Rectangle -> (r, r)
    centerPlacement Rectangle
    root Rectangle
    lrect :: (Double,Double)) Rectangle
    lrect
                        (Rectangle -> Rectangle) -> Rectangle -> Rectangle
    forall a b. (a -> b) -> a -> b
    $ if Stack Atom -> Atom -> Bool
    forall a. Eq a => Stack a -> a -> Bool
    isInStack Stack Atom
    s Atom
    w then Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    a Position
    b Dimension
    c' Dimension
    d' else Rectangle
    lrect

                ds :: (Position, Position)
    ds = (Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Dimension
    c Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Dimension
    c',Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Dimension
    d Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Dimension
    d')
                growOther' :: Rectangle -> Rectangle
    growOther' = (Position, Position)
    -> Rectangle -> Set Direction2D -> Rectangle -> Rectangle
    growOther (Position, Position)
    ds Rectangle
    lrect (Rectangle -> Rectangle -> Set Direction2D
    freeDirs Rectangle
    root Rectangle
    lrect)
                mapSnd :: (b -> c) -> [((d, b), d)] -> [((d, c), d)]
    mapSnd b -> c
    f = (((d, b), d) -> ((d, c), d)) -> [((d, b), d)] -> [((d, c), d)]
    forall a b. (a -> b) -> [a] -> [b]
    map (((d, b) -> (d, c)) -> ((d, b), d) -> ((d, c), d)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (((d, b) -> (d, c)) -> ((d, b), d) -> ((d, c), d))
    -> ((d, b) -> (d, c)) -> ((d, b), d) -> ((d, c), d)
    forall a b. (a -> b) -> a -> b
    $ (b -> c) -> (d, b) -> (d, c)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second b -> c
    f)
                next :: [(Atom, Rectangle)]
    next = Stack Atom
    -> Rectangle
    -> [((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension))]
    -> [(Atom, Rectangle)]
    applyHints Stack Atom
    s Rectangle
    root ([((Atom, Rectangle),
       (Dimension, Dimension) -> (Dimension, Dimension))]
     -> [(Atom, Rectangle)])
    -> [((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension))]
    -> [(Atom, Rectangle)]
    forall a b. (a -> b) -> a -> b
    $ (Rectangle -> Rectangle)
    -> [((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension))]
    -> [((Atom, Rectangle),
         (Dimension, Dimension) -> (Dimension, Dimension))]
    forall {b} {c} {d} {d}. (b -> c) -> [((d, b), d)] -> [((d, c), d)]
    mapSnd Rectangle -> Rectangle
    growOther' [((Atom, Rectangle),
      (Dimension, Dimension) -> (Dimension, Dimension))]
    xs
            in (Atom
    w,Rectangle
    redr)(Atom, Rectangle) -> [(Atom, Rectangle)] -> [(Atom, Rectangle)]
    forall a. a -> [a] -> [a]
    :[(Atom, Rectangle)]
    next

    growOther :: (Position, Position) -> Rectangle -> Set Direction2D -> Rectangle -> Rectangle
    growOther :: (Position, Position)
    -> Rectangle -> Set Direction2D -> Rectangle -> Rectangle
    growOther (Position, Position)
    ds Rectangle
    lrect Set Direction2D
    fds Rectangle
    r
        | [Direction2D]
    dirs <- Direction2D -> Direction2D
    flipDir (Direction2D -> Direction2D) -> [Direction2D] -> [Direction2D]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Set Direction2D -> [Direction2D]
    forall a. Set a -> [a]
    Set.toList (Set Direction2D -> Set Direction2D -> Set Direction2D
    forall a. Ord a => Set a -> Set a -> Set a
    Set.intersection Set Direction2D
    adj Set Direction2D
    fds)
        , Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ ((Direction2D, Direction2D) -> Bool)
    -> [(Direction2D, Direction2D)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ((Direction2D -> Direction2D -> Bool)
    -> (Direction2D, Direction2D) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Direction2D -> Direction2D -> Bool
    opposite) ([(Direction2D, Direction2D)] -> Bool)
    -> [(Direction2D, Direction2D)] -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Direction2D] -> [(Direction2D, Direction2D)]
    forall {b}. [b] -> [(b, b)]
    cross [Direction2D]
    dirs =
            (Direction2D -> Rectangle -> Rectangle)
    -> Rectangle -> [Direction2D] -> Rectangle
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Direction2D -> (Position, Position) -> Rectangle -> Rectangle
    `grow` (Position, Position)
    ds) Rectangle
    r [Direction2D]
    dirs
        | Bool
    otherwise = Rectangle
    r
        where
            adj :: Set Direction2D
    adj = Rectangle -> Rectangle -> Set Direction2D
    adjacent Rectangle
    lrect  Rectangle
    r
            cross :: [b] -> [(b, b)]
    cross [b]
    xs = [ (b
    a,b
    b) | b
    a <- [b]
    xs, b
    b <- [b]
    xs ]

            flipDir :: Direction2D -> Direction2D
            flipDir :: Direction2D -> Direction2D
    flipDir Direction2D
    d = case Direction2D
    d of { Direction2D
    L -> Direction2D
    R; Direction2D
    U -> Direction2D
    D; Direction2D
    R -> Direction2D
    L; Direction2D
    D -> Direction2D
    U }

            opposite :: Direction2D -> Direction2D -> Bool
            opposite :: Direction2D -> Direction2D -> Bool
    opposite Direction2D
    x Direction2D
    y = Direction2D -> Direction2D
    flipDir Direction2D
    x Direction2D -> Direction2D -> Bool
    forall a. Eq a => a -> a -> Bool
    == Direction2D
    y

    -- | Leave the opposite edges where they were
    grow :: Direction2D -> (Position,Position) -> Rectangle -> Rectangle
    grow :: Direction2D -> (Position, Position) -> Rectangle -> Rectangle
    grow Direction2D
    L (Position
    px,Position
    _ ) (Rectangle Position
    x Position
    y Dimension
    w Dimension
    h) = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (Position
    xPosition -> Position -> Position
    forall a. Num a => a -> a -> a
    -Position
    px) Position
    y (Dimension
    wDimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    +Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Position
    px) Dimension
    h
    grow Direction2D
    U (Position
    _ ,Position
    py) (Rectangle Position
    x Position
    y Dimension
    w Dimension
    h) = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x (Position
    yPosition -> Position -> Position
    forall a. Num a => a -> a -> a
    -Position
    py) Dimension
    w (Dimension
    hDimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    +Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Position
    py)
    grow Direction2D
    R (Position
    px,Position
    _ ) (Rectangle Position
    x Position
    y Dimension
    w Dimension
    h) = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x Position
    y (Dimension
    wDimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    +Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Position
    px) Dimension
    h
    grow Direction2D
    D (Position
    _ ,Position
    py) (Rectangle Position
    x Position
    y Dimension
    w Dimension
    h) = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    x Position
    y Dimension
    w (Dimension
    hDimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    +Position -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Position
    py)

    comparingEdges :: ([Position] -> [Position] -> Bool) -> Rectangle -> Rectangle -> Set Direction2D
    comparingEdges :: ([Position] -> [Position] -> Bool)
    -> Rectangle -> Rectangle -> Set Direction2D
    comparingEdges [Position] -> [Position] -> Bool
    surrounds Rectangle
    r1 Rectangle
    r2 = [Direction2D] -> Set Direction2D
    forall a. Ord a => [a] -> Set a
    Set.fromList ([Direction2D] -> Set Direction2D)
    -> [Direction2D] -> Set Direction2D
    forall a b. (a -> b) -> a -> b
    $ ((Direction2D, Bool) -> Direction2D)
    -> [(Direction2D, Bool)] -> [Direction2D]
    forall a b. (a -> b) -> [a] -> [b]
    map (Direction2D, Bool) -> Direction2D
    forall a b. (a, b) -> a
    fst ([(Direction2D, Bool)] -> [Direction2D])
    -> [(Direction2D, Bool)] -> [Direction2D]
    forall a b. (a -> b) -> a -> b
    $ ((Direction2D, Bool) -> Bool)
    -> [(Direction2D, Bool)] -> [(Direction2D, Bool)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Direction2D, Bool) -> Bool
    forall a b. (a, b) -> b
    snd [ (Direction2D
    dir,) (Bool -> (Direction2D, Bool)) -> Bool -> (Direction2D, Bool)
    forall a b. (a -> b) -> a -> b
    $
                ([Bool] -> Bool) -> [[Bool]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [[Direction2D
    dir Direction2D -> [Direction2D] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Direction2D
    R,Direction2D
    L], [Position] -> Bool
    allEq [Position
    a,Position
    c,Position
    w,Position
    y], [Position
    b,Position
    d] [Position] -> [Position] -> Bool
    `surrounds` [Position
    x,Position
    z]]
                        ,[Direction2D
    dir 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], [Position] -> Bool
    allEq [Position
    b,Position
    d,Position
    x,Position
    z], [Position
    a,Position
    c] [Position] -> [Position] -> Bool
    `surrounds` [Position
    w,Position
    y]]]
        | ((Position
    a,Position
    b),(Position
    c,Position
    d)) <- [(Position, Position)]
    -> [((Position, Position), (Position, Position))]
    forall {b}. [b] -> [(b, b)]
    edge ([(Position, Position)]
     -> [((Position, Position), (Position, Position))])
    -> [(Position, Position)]
    -> [((Position, Position), (Position, Position))]
    forall a b. (a -> b) -> a -> b
    $ Rectangle -> [(Position, Position)]
    corners Rectangle
    r1
        | ((Position
    w,Position
    x),(Position
    y,Position
    z)) <- [(Position, Position)]
    -> [((Position, Position), (Position, Position))]
    forall {b}. [b] -> [(b, b)]
    edge ([(Position, Position)]
     -> [((Position, Position), (Position, Position))])
    -> [(Position, Position)]
    -> [((Position, Position), (Position, Position))]
    forall a b. (a -> b) -> a -> b
    $ Int -> [(Position, Position)] -> [(Position, Position)]
    forall {a}. Int -> [a] -> [a]
    delay Int
    2 ([(Position, Position)] -> [(Position, Position)])
    -> [(Position, Position)] -> [(Position, Position)]
    forall a b. (a -> b) -> a -> b
    $ Rectangle -> [(Position, Position)]
    corners Rectangle
    r2
        | Direction2D
    dir <- [Direction2D
    U,Direction2D
    R,Direction2D
    D,Direction2D
    L]]
            where edge :: [b] -> [(b, b)]
    edge (b
    x:[b]
    xs) = [b] -> [b] -> [(b, b)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (b
    xb -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    xs) ([b]
    xs [b] -> [b] -> [b]
    forall a. [a] -> [a] -> [a]
    ++ [b
    x])
                  edge [] = []
                  delay :: Int -> [a] -> [a]
    delay Int
    n [a]
    xs = Int -> [a] -> [a]
    forall {a}. Int -> [a] -> [a]
    drop Int
    n [a]
    xs [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [a] -> [a]
    forall {a}. Int -> [a] -> [a]
    take Int
    n [a]
    xs
                  allEq :: [Position] -> Bool
    allEq = ((Position, Position) -> Bool) -> [(Position, Position)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ((Position -> Position -> Bool) -> (Position, Position) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Position -> Position -> Bool
    forall a. Eq a => a -> a -> Bool
    (==)) ([(Position, Position)] -> Bool)
    -> ([Position] -> [(Position, Position)]) -> [Position] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Position] -> [(Position, Position)]
    forall {b}. [b] -> [(b, b)]
    edge

    -- | in what direction is the second window from the first that can expand if the
    -- first is shrunk, assuming that the root window is fully covered:
    --  one direction for a common edge
    --  two directions for a common corner
    adjacent :: Rectangle -> Rectangle -> Set Direction2D
    adjacent :: Rectangle -> Rectangle -> Set Direction2D
    adjacent = ([Position] -> [Position] -> Bool)
    -> Rectangle -> Rectangle -> Set Direction2D
    comparingEdges ((Position -> Bool) -> [Position] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all ((Position -> Bool) -> [Position] -> Bool)
    -> ([Position] -> Position -> Bool)
    -> [Position]
    -> [Position]
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Position] -> Position -> Bool
    forall a. Ord a => [a] -> a -> Bool
    onClosedInterval)

    -- | True whenever two edges touch. not (Set.null $ adjacent x y) ==> touching x y
    touching :: Rectangle -> Rectangle -> Bool
    touching :: Rectangle -> Rectangle -> Bool
    touching Rectangle
    a Rectangle
    b = Bool -> Bool
    not (Bool -> Bool)
    -> (Set Direction2D -> Bool) -> Set Direction2D -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Set Direction2D -> Bool
    forall a. Set a -> Bool
    Set.null (Set Direction2D -> Bool) -> Set Direction2D -> Bool
    forall a b. (a -> b) -> a -> b
    $ ([Position] -> [Position] -> Bool)
    -> Rectangle -> Rectangle -> Set Direction2D
    comparingEdges [Position] -> [Position] -> Bool
    forall {a}. Ord a => [a] -> [a] -> Bool
    c Rectangle
    a Rectangle
    b
        where c :: [a] -> [a] -> Bool
    c [a]
    x [a]
    y = (a -> Bool) -> [a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ([a] -> a -> Bool
    forall a. Ord a => [a] -> a -> Bool
    onClosedInterval [a]
    x) [a]
    y Bool -> Bool -> Bool
    || (a -> Bool) -> [a] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ([a] -> a -> Bool
    forall a. Ord a => [a] -> a -> Bool
    onClosedInterval [a]
    y) [a]
    x

    onClosedInterval :: Ord a => [a] -> a -> Bool
    onClosedInterval :: forall a. Ord a => [a] -> a -> Bool
    onClosedInterval [a]
    bds a
    x = [a] -> a
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum [a]
    bds a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    x Bool -> Bool -> Bool
    && [a] -> a
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [a]
    bds a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    x

    -- | starting top left going clockwise
    corners :: Rectangle -> [(Position, Position)]
    corners :: Rectangle -> [(Position, Position)]
    corners (Rectangle Position
    x Position
    y Dimension
    w Dimension
    h) = [(Position
    x,Position
    y)
                                  ,(Position
    xPosition -> Position -> Position
    forall a. Num a => a -> a -> a
    +Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Dimension
    w, Position
    y)
                                  ,(Position
    xPosition -> Position -> Position
    forall a. Num a => a -> a -> a
    +Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Dimension
    w, Position
    yPosition -> Position -> Position
    forall a. Num a => a -> a -> a
    +Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Dimension
    h)
                                  ,(Position
    x, Position
    yPosition -> Position -> Position
    forall a. Num a => a -> a -> a
    +Dimension -> Position
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Dimension
    h)]

    center :: Rectangle -> (Position, Position)
    center :: Rectangle -> (Position, Position)
    center (Rectangle Position
    x Position
    y Dimension
    w Dimension
    h) = (Position -> Dimension -> Position
    forall {a} {a}. (Integral a, Integral a) => a -> a -> a
    avg Position
    x Dimension
    w, Position -> Dimension -> Position
    forall {a} {a}. (Integral a, Integral a) => a -> a -> a
    avg Position
    y Dimension
    h)
        where avg :: a -> a -> a
    avg a
    a a
    b = a
    a a -> a -> a
    forall a. Num a => a -> a -> a
    + a -> a
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    b a -> a -> a
    forall a. Integral a => a -> a -> a
    `div` a
    2

    centerPlacement :: RealFrac r => Rectangle -> Rectangle -> (r, r)
    centerPlacement :: forall r. RealFrac r => Rectangle -> Rectangle -> (r, r)
    centerPlacement = (Position -> r) -> Rectangle -> Rectangle -> (r, r)
    forall r. (Position -> r) -> Rectangle -> Rectangle -> (r, r)
    centerPlacement' Position -> r
    forall {a} {a}. (Eq a, Fractional a, Num a) => a -> a
    clamp
        where clamp :: a -> a
    clamp a
    n = case a -> a
    forall a. Num a => a -> a
    signum a
    n of
                                a
    0 -> a
    0.5
                                a
    1 -> a
    1
                                a
    _ -> a
    0

    freeDirs :: Rectangle -> Rectangle -> Set Direction2D
    freeDirs :: Rectangle -> Rectangle -> Set Direction2D
    freeDirs Rectangle
    root = [Direction2D] -> Set Direction2D
    forall a. Ord a => [a] -> Set a
    Set.fromList ([Direction2D] -> Set Direction2D)
    -> (Rectangle -> [Direction2D]) -> Rectangle -> Set Direction2D
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Direction2D] -> [Direction2D] -> [Direction2D])
    -> ([Direction2D], [Direction2D]) -> [Direction2D]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry [Direction2D] -> [Direction2D] -> [Direction2D]
    forall a. [a] -> [a] -> [a]
    (++) (([Direction2D], [Direction2D]) -> [Direction2D])
    -> (Rectangle -> ([Direction2D], [Direction2D]))
    -> Rectangle
    -> [Direction2D]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Position -> [Direction2D]
    forall {a}. (Eq a, Num a) => a -> [Direction2D]
    lr (Position -> [Direction2D])
    -> (Position -> [Direction2D])
    -> (Position, Position)
    -> ([Direction2D], [Direction2D])
    forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** Position -> [Direction2D]
    forall {a}. (Eq a, Num a) => a -> [Direction2D]
    ud)
                  ((Position, Position) -> ([Direction2D], [Direction2D]))
    -> (Rectangle -> (Position, Position))
    -> Rectangle
    -> ([Direction2D], [Direction2D])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Position -> Position)
    -> Rectangle -> Rectangle -> (Position, Position)
    forall r. (Position -> r) -> Rectangle -> Rectangle -> (r, r)
    centerPlacement' Position -> Position
    forall a. Num a => a -> a
    signum Rectangle
    root
        where
            lr :: a -> [Direction2D]
    lr a
    1 = [Direction2D
    L]
            lr (-1) = [Direction2D
    R]
            lr a
    _ = [Direction2D
    L,Direction2D
    R]
            ud :: a -> [Direction2D]
    ud a
    1 = [Direction2D
    U]
            ud (-1) = [Direction2D
    D]
            ud a
    _ = [Direction2D
    U,Direction2D
    D]

    centerPlacement' :: (Position -> r) -> Rectangle -> Rectangle -> (r, r)
    centerPlacement' :: forall r. (Position -> r) -> Rectangle -> Rectangle -> (r, r)
    centerPlacement' Position -> r
    cf Rectangle
    root Rectangle
    assigned
        = (Position -> r
    cf (Position -> r) -> Position -> r
    forall a b. (a -> b) -> a -> b
    $ Position
    cx Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    cwx, Position -> r
    cf (Position -> r) -> Position -> r
    forall a b. (a -> b) -> a -> b
    $ Position
    cy Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Position
    cwy)
        where (Position
    cx,Position
    cy) = Rectangle -> (Position, Position)
    center Rectangle
    root
              (Position
    cwx,Position
    cwy) = Rectangle -> (Position, Position)
    center Rectangle
    assigned

    -- | Event hook that refreshes the layout whenever a window changes its hints.
    hintsEventHook :: Event -> X All
    hintsEventHook :: Event -> X All
    hintsEventHook PropertyEvent{ ev_event_type :: Event -> Dimension
    ev_event_type = Dimension
    t, ev_atom :: Event -> Atom
    ev_atom = Atom
    a, ev_window :: Event -> Atom
    ev_window = Atom
    w }
        | Dimension
    t Dimension -> Dimension -> Bool
    forall a. Eq a => a -> a -> Bool
    == Dimension
    propertyNotify Bool -> Bool -> Bool
    && Atom
    a Atom -> Atom -> Bool
    forall a. Eq a => a -> a -> Bool
    == Atom
    wM_NORMAL_HINTS = do
            X Bool -> X () -> X ()
    whenX (Atom -> X Bool
    isClient Atom
    w X Bool -> X Bool -> X Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    <&&> Atom -> X Bool
    hintsMismatch Atom
    w) X ()
    refresh
            All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)
    hintsEventHook Event
    _ = All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)

    -- | True if the window's current size does not satisfy its size hints.
    hintsMismatch :: Window -> X Bool
    hintsMismatch :: Atom -> X Bool
    hintsMismatch Atom
    w = Atom -> X (Maybe WindowAttributes)
    safeGetWindowAttributes Atom
    w X (Maybe WindowAttributes)
    -> (Maybe WindowAttributes -> X Bool) -> X Bool
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Maybe WindowAttributes
    Nothing -> Bool -> X Bool
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
        Just WindowAttributes
    wa -> do
            SizeHints
    sh <- (Display -> X SizeHints) -> X SizeHints
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X SizeHints) -> X SizeHints)
    -> (Display -> X SizeHints) -> X SizeHints
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> IO SizeHints -> X SizeHints
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (Display -> Atom -> IO SizeHints
    getWMNormalHints Display
    d Atom
    w)
            let dim :: (Dimension, Dimension)
    dim = (CInt -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CInt -> Dimension) -> CInt -> Dimension
    forall a b. (a -> b) -> a -> b
    $ WindowAttributes -> CInt
    wa_width WindowAttributes
    wa, CInt -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (CInt -> Dimension) -> CInt -> Dimension
    forall a b. (a -> b) -> a -> b
    $ WindowAttributes -> CInt
    wa_height WindowAttributes
    wa)
            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
    $ (Dimension, Dimension)
    dim (Dimension, Dimension) -> (Dimension, Dimension) -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Dimension
    -> SizeHints -> (Dimension, Dimension) -> (Dimension, Dimension)
    forall a.
    Integral a =>
    Dimension -> SizeHints -> (a, a) -> (Dimension, Dimension)
    applySizeHints Dimension
    0 SizeHints
    sh (Dimension, Dimension)
    dim