    {-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module       : XMonad.Hooks.ManageDocks
    -- Copyright    : (c) Joachim Breitner <mail@joachim-breitner.de>
    -- License      : BSD
    --
    -- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>
    -- Stability    : unstable
    -- Portability  : unportable
    --
    -- This module provides tools to automatically manage 'dock' type programs,
    -- such as gnome-panel, kicker, dzen, and xmobar.

    module XMonad.Hooks.ManageDocks (
        -- * Usage
        -- $usage
        docks, manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
        docksEventHook, docksStartupHook,
        ToggleStruts(..),
        SetStruts(..),
        module XMonad.Util.Types,

    #ifdef TESTING
        r2c,
        c2r,
        RectC(..),
    #endif

        -- for XMonad.Actions.FloatSnap
        calcGap
        ) where

    -----------------------------------------------------------------------------
    import XMonad
    import Foreign.C.Types (CLong)
    import XMonad.Layout.LayoutModifier
    import XMonad.Util.Types
    import XMonad.Util.WindowProperties (getProp32s)
    import XMonad.Util.XUtils (fi)
    import qualified XMonad.Util.ExtensibleState as XS
    import Data.Monoid (All(..), mempty)
    import Data.Functor((<$>))

    import qualified Data.Set as S
    import qualified Data.Map as M
    import Control.Monad (when, forM_, filterM)

    -- $usage
    -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
    --
    -- > import XMonad.Hooks.ManageDocks
    --
    -- Wrap your xmonad config with a call to 'docks', like so:
    --
    -- > main = xmonad $ docks def
    --
    -- Then add 'avoidStruts' or 'avoidStrutsOn' layout modifier to your layout
    -- to prevent windows from overlapping these windows.
    --
    -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)
    -- >                   where  tall = Tall 1 (3/100) (1/2)
    --
    -- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding
    -- similar to:
    --
    -- > ,((modm, xK_b     ), sendMessage ToggleStruts)
    --
    -- If you have multiple docks, you can toggle their gaps individually.
    -- For example, to toggle only the top gap:
    --
    -- > ,((modm .|. controlMask, xK_t), sendMessage $ ToggleStrut U)
    --
    -- Similarly, you can use 'D', 'L', and 'R' to individually toggle
    -- gaps on the bottom, left, or right.
    --
    -- If you want certain docks to be avoided but others to be covered by
    -- default, you can manually specify the sides of the screen on which
    -- docks should be avoided, using 'avoidStrutsOn'.  For example:
    --
    -- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...)
    --
    -- For detailed instructions on editing your key bindings, see
    -- "XMonad.Doc.Extending#Editing_key_bindings".
    --

    -- | Add docks functionality to the given config.  See above for an example.
    docks :: XConfig a -> XConfig a
    docks :: XConfig a -> XConfig a
    docks c :: XConfig a
    c = XConfig a
    c { startupHook :: X ()
    startupHook     = X ()
    docksStartupHook X () -> X () -> X ()
    forall m. Monoid m => m -> m -> m
    <+> XConfig a -> X ()
    forall (l :: * -> *). XConfig l -> X ()
    startupHook XConfig a
    c
                , handleEventHook :: Event -> X All
    handleEventHook = Event -> X All
    docksEventHook (Event -> X All) -> (Event -> X All) -> Event -> X All
    forall m. Monoid m => m -> m -> m
    <+> XConfig a -> Event -> X All
    forall (l :: * -> *). XConfig l -> Event -> X All
    handleEventHook XConfig a
    c
                , manageHook :: ManageHook
    manageHook      = ManageHook
    manageDocks ManageHook -> ManageHook -> ManageHook
    forall m. Monoid m => m -> m -> m
    <+> XConfig a -> ManageHook
    forall (l :: * -> *). XConfig l -> ManageHook
    manageHook XConfig a
    c }

    newtype StrutCache = StrutCache { StrutCache -> Map Window [Strut]
    fromStrutCache :: M.Map Window [Strut] }
        deriving (StrutCache -> StrutCache -> Bool
    (StrutCache -> StrutCache -> Bool)
    -> (StrutCache -> StrutCache -> Bool) -> Eq StrutCache
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: StrutCache -> StrutCache -> Bool
    $c/= :: StrutCache -> StrutCache -> Bool
    == :: StrutCache -> StrutCache -> Bool
    $c== :: StrutCache -> StrutCache -> Bool
    Eq, Typeable)

    data UpdateDocks = UpdateDocks deriving Typeable
    instance Message UpdateDocks

    refreshDocks :: X ()
    refreshDocks :: X ()
    refreshDocks = UpdateDocks -> X ()
    forall a. Message a => a -> X ()
    sendMessage UpdateDocks
    UpdateDocks

    instance ExtensionClass StrutCache where
      initialValue :: StrutCache
    initialValue = Map Window [Strut] -> StrutCache
    StrutCache Map Window [Strut]
    forall k a. Map k a
    M.empty

    updateStrutCache :: Window -> [Strut] -> X Bool
    updateStrutCache :: Window -> [Strut] -> X Bool
    updateStrutCache w :: Window
    w strut :: [Strut]
    strut = do
      (StrutCache -> StrutCache) -> X Bool
    forall a (m :: * -> *).
    (ExtensionClass a, Eq a, XLike m) =>
    (a -> a) -> m Bool
    XS.modified ((StrutCache -> StrutCache) -> X Bool)
    -> (StrutCache -> StrutCache) -> X Bool
    forall a b. (a -> b) -> a -> b
    $ Map Window [Strut] -> StrutCache
    StrutCache (Map Window [Strut] -> StrutCache)
    -> (StrutCache -> Map Window [Strut]) -> StrutCache -> StrutCache
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Window -> [Strut] -> Map Window [Strut] -> Map Window [Strut]
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    M.insert Window
    w [Strut]
    strut (Map Window [Strut] -> Map Window [Strut])
    -> (StrutCache -> Map Window [Strut])
    -> StrutCache
    -> Map Window [Strut]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StrutCache -> Map Window [Strut]
    fromStrutCache

    deleteFromStructCache :: Window -> X Bool
    deleteFromStructCache :: Window -> X Bool
    deleteFromStructCache w :: Window
    w = do
      (StrutCache -> StrutCache) -> X Bool
    forall a (m :: * -> *).
    (ExtensionClass a, Eq a, XLike m) =>
    (a -> a) -> m Bool
    XS.modified ((StrutCache -> StrutCache) -> X Bool)
    -> (StrutCache -> StrutCache) -> X Bool
    forall a b. (a -> b) -> a -> b
    $ Map Window [Strut] -> StrutCache
    StrutCache (Map Window [Strut] -> StrutCache)
    -> (StrutCache -> Map Window [Strut]) -> StrutCache -> StrutCache
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Window -> Map Window [Strut] -> Map Window [Strut]
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete Window
    w (Map Window [Strut] -> Map Window [Strut])
    -> (StrutCache -> Map Window [Strut])
    -> StrutCache
    -> Map Window [Strut]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StrutCache -> Map Window [Strut]
    fromStrutCache

    -- | Detects if the given window is of type DOCK and if so, reveals
    --   it, but does not manage it.
    manageDocks :: ManageHook
    manageDocks :: ManageHook
    manageDocks = Query Bool
    checkDock Query Bool -> ManageHook -> ManageHook
    forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
    --> (ManageHook
    doIgnore ManageHook -> ManageHook -> ManageHook
    forall m. Monoid m => m -> m -> m
    <+> ManageHook
    setDocksMask)
        where setDocksMask :: ManageHook
    setDocksMask = do
                Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> Query ()) -> Query ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \win :: Window
    win -> X () -> Query ()
    forall a. X a -> Query a
    liftX (X () -> Query ()) -> X () -> Query ()
    forall a b. (a -> b) -> a -> b
    $ (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \dpy :: Display
    dpy -> do
                    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
    dpy Window
    win (Window
    propertyChangeMask Window -> Window -> Window
    forall a. Bits a => a -> a -> a
    .|. Window
    structureNotifyMask)
                ManageHook
    forall a. Monoid a => a
    mempty

    -- | Checks if a window is a DOCK or DESKTOP window
    checkDock :: Query Bool
    checkDock :: Query Bool
    checkDock = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> Query Bool) -> Query Bool
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \w :: Window
    w -> X Bool -> Query Bool
    forall a. X a -> Query a
    liftX (X Bool -> Query Bool) -> X Bool -> Query Bool
    forall a b. (a -> b) -> a -> b
    $ do
        Window
    dock <- String -> X Window
    getAtom "_NET_WM_WINDOW_TYPE_DOCK"
        Window
    desk <- String -> X Window
    getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
        Maybe [CLong]
    mbr <- String -> Window -> X (Maybe [CLong])
    getProp32s "_NET_WM_WINDOW_TYPE" Window
    w
        case Maybe [CLong]
    mbr of
            Just rs :: [CLong]
    rs -> Bool -> X Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> X Bool) -> Bool -> X Bool
    forall a b. (a -> b) -> a -> b
    $ (Window -> Bool) -> [Window] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Window -> [Window] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Window
    dock,Window
    desk]) ((CLong -> Window) -> [CLong] -> [Window]
    forall a b. (a -> b) -> [a] -> [b]
    map CLong -> Window
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral [CLong]
    rs)
            _       -> Bool -> X Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    -- | Whenever a new dock appears, refresh the layout immediately to avoid the
    -- new dock.
    docksEventHook :: Event -> X All
    docksEventHook :: Event -> X All
    docksEventHook (MapNotifyEvent { ev_window :: Event -> Window
    ev_window = Window
    w }) = do
        X Bool -> X () -> X ()
    whenX (Query Bool -> Window -> X Bool
    forall a. Query a -> Window -> X a
    runQuery Query Bool
    checkDock Window
    w X Bool -> X Bool -> X Bool
    forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
    <&&> (Bool -> Bool
    not (Bool -> Bool) -> X Bool -> X Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Window -> X Bool
    isClient Window
    w)) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
            [Strut]
    strut <- Window -> X [Strut]
    getStrut Window
    w
            X Bool -> X () -> X ()
    whenX (Window -> [Strut] -> X Bool
    updateStrutCache Window
    w [Strut]
    strut) X ()
    refreshDocks
        All -> X All
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)
    docksEventHook (PropertyEvent { ev_window :: Event -> Window
    ev_window = Window
    w
                                  , ev_atom :: Event -> Window
    ev_atom = Window
    a }) = do
        Window
    nws <- String -> X Window
    getAtom "_NET_WM_STRUT"
        Window
    nwsp <- String -> X Window
    getAtom "_NET_WM_STRUT_PARTIAL"
        Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    nws Bool -> Bool -> Bool
    || Window
    a Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == Window
    nwsp) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
            [Strut]
    strut <- Window -> X [Strut]
    getStrut Window
    w
            X Bool -> X () -> X ()
    whenX (Window -> [Strut] -> X Bool
    updateStrutCache Window
    w [Strut]
    strut) X ()
    refreshDocks
        All -> X All
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)
    docksEventHook (DestroyWindowEvent {ev_window :: Event -> Window
    ev_window = Window
    w}) = do
        X Bool -> X () -> X ()
    whenX (Window -> X Bool
    deleteFromStructCache Window
    w) X ()
    refreshDocks
        All -> X All
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)
    docksEventHook _ = All -> X All
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)

    docksStartupHook :: X ()
    docksStartupHook :: X ()
    docksStartupHook = (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \dpy :: Display
    dpy -> do
        Window
    rootw <- (XConf -> Window) -> X Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Window
    theRoot
        (_,_,wins :: [Window]
    wins) <- IO (Window, Window, [Window]) -> X (Window, Window, [Window])
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Window, Window, [Window]) -> X (Window, Window, [Window]))
    -> IO (Window, Window, [Window]) -> X (Window, Window, [Window])
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> IO (Window, Window, [Window])
    queryTree Display
    dpy Window
    rootw
        [Window]
    docks <- (Window -> X Bool) -> [Window] -> X [Window]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM (Query Bool -> Window -> X Bool
    forall a. Query a -> Window -> X a
    runQuery Query Bool
    checkDock) [Window]
    wins
        [Window] -> (Window -> X Bool) -> X ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [Window]
    docks ((Window -> X Bool) -> X ()) -> (Window -> X Bool) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \win :: Window
    win -> do
            [Strut]
    strut <- Window -> X [Strut]
    getStrut Window
    win
            Window -> [Strut] -> X Bool
    updateStrutCache Window
    win [Strut]
    strut
        X ()
    refreshDocks

    -- | Gets the STRUT config, if present, in xmonad gap order
    getStrut :: Window -> X [Strut]
    getStrut :: Window -> X [Strut]
    getStrut w :: Window
    w = do
        Maybe [CLong]
    msp <- String -> Window -> X (Maybe [CLong])
    getProp32s "_NET_WM_STRUT_PARTIAL" Window
    w
        case Maybe [CLong]
    msp of
            Just sp :: [CLong]
    sp -> [Strut] -> X [Strut]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Strut] -> X [Strut]) -> [Strut] -> X [Strut]
    forall a b. (a -> b) -> a -> b
    $ [CLong] -> [Strut]
    forall d. (Eq d, Num d) => [d] -> [(Direction2D, d, d, d)]
    parseStrutPartial [CLong]
    sp
            Nothing -> (Maybe [CLong] -> [Strut]) -> X (Maybe [CLong]) -> X [Strut]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Strut] -> ([CLong] -> [Strut]) -> Maybe [CLong] -> [Strut]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] [CLong] -> [Strut]
    forall d.
    (Eq d, Num d, Bounded d) =>
    [d] -> [(Direction2D, d, d, d)]
    parseStrut) (X (Maybe [CLong]) -> X [Strut]) -> X (Maybe [CLong]) -> X [Strut]
    forall a b. (a -> b) -> a -> b
    $ String -> Window -> X (Maybe [CLong])
    getProp32s "_NET_WM_STRUT" Window
    w
     where
        parseStrut :: [d] -> [(Direction2D, d, d, d)]
    parseStrut xs :: [d]
    xs@[_, _, _, _] = [d] -> [(Direction2D, d, d, d)]
    forall d. (Eq d, Num d) => [d] -> [(Direction2D, d, d, d)]
    parseStrutPartial ([d] -> [(Direction2D, d, d, d)])
    -> ([d] -> [d]) -> [d] -> [(Direction2D, d, d, d)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [d] -> [d]
    forall a. Int -> [a] -> [a]
    take 12 ([d] -> [(Direction2D, d, d, d)])
    -> [d] -> [(Direction2D, d, d, d)]
    forall a b. (a -> b) -> a -> b
    $ [d]
    xs [d] -> [d] -> [d]
    forall a. [a] -> [a] -> [a]
    ++ [d] -> [d]
    forall a. [a] -> [a]
    cycle [d
    forall a. Bounded a => a
    minBound, d
    forall a. Bounded a => a
    maxBound]
        parseStrut _ = []

        parseStrutPartial :: [d] -> [(Direction2D, d, d, d)]
    parseStrutPartial [l :: d
    l, r :: d
    r, t :: d
    t, b :: d
    b, ly1 :: d
    ly1, ly2 :: d
    ly2, ry1 :: d
    ry1, ry2 :: d
    ry2, tx1 :: d
    tx1, tx2 :: d
    tx2, bx1 :: d
    bx1, bx2 :: d
    bx2]
         = ((Direction2D, d, d, d) -> Bool)
    -> [(Direction2D, d, d, d)] -> [(Direction2D, d, d, d)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(_, n :: d
    n, _, _) -> d
    n d -> d -> Bool
    forall a. Eq a => a -> a -> Bool
    /= 0)
            [(Direction2D
    L, d
    l, d
    ly1, d
    ly2), (Direction2D
    R, d
    r, d
    ry1, d
    ry2), (Direction2D
    U, d
    t, d
    tx1, d
    tx2), (Direction2D
    D, d
    b, d
    bx1, d
    bx2)]
        parseStrutPartial _ = []

    -- | Goes through the list of windows and find the gap so that all
    --   STRUT settings are satisfied.
    calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
    calcGap :: Set Direction2D -> X (Rectangle -> Rectangle)
    calcGap ss :: Set Direction2D
    ss = (Display -> X (Rectangle -> Rectangle))
    -> X (Rectangle -> Rectangle)
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X (Rectangle -> Rectangle))
     -> X (Rectangle -> Rectangle))
    -> (Display -> X (Rectangle -> Rectangle))
    -> X (Rectangle -> Rectangle)
    forall a b. (a -> b) -> a -> b
    $ \dpy :: Display
    dpy -> do
        Window
    rootw <- (XConf -> Window) -> X Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Window
    theRoot
        [Strut]
    struts <- ((Strut -> Bool) -> [Strut] -> [Strut]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Strut -> Bool
    forall b c d. (Direction2D, b, c, d) -> Bool
    careAbout ([Strut] -> [Strut])
    -> ([[Strut]] -> [Strut]) -> [[Strut]] -> [Strut]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Strut]] -> [Strut]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat) ([[Strut]] -> [Strut]) -> X [[Strut]] -> X [Strut]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (StrutCache -> [[Strut]]) -> X [[Strut]]
    forall a (m :: * -> *) b.
    (ExtensionClass a, XLike m) =>
    (a -> b) -> m b
    XS.gets (Map Window [Strut] -> [[Strut]]
    forall k a. Map k a -> [a]
    M.elems (Map Window [Strut] -> [[Strut]])
    -> (StrutCache -> Map Window [Strut]) -> StrutCache -> [[Strut]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StrutCache -> Map Window [Strut]
    fromStrutCache)

        -- we grab the window attributes of the root window rather than checking
        -- the width of the screen because xlib caches this info and it tends to
        -- be incorrect after RAndR
        WindowAttributes
    wa <- IO WindowAttributes -> X WindowAttributes
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO WindowAttributes -> X WindowAttributes)
    -> IO WindowAttributes -> X WindowAttributes
    forall a b. (a -> b) -> a -> b
    $ Display -> Window -> IO WindowAttributes
    getWindowAttributes Display
    dpy Window
    rootw
        let screen :: RectC
    screen = Rectangle -> RectC
    r2c (Rectangle -> RectC) -> Rectangle -> RectC
    forall a b. (a -> b) -> a -> b
    $ Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (CInt -> Position) -> CInt -> Position
    forall a b. (a -> b) -> a -> b
    $ WindowAttributes -> CInt
    wa_x WindowAttributes
    wa) (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (CInt -> Position) -> CInt -> Position
    forall a b. (a -> b) -> a -> b
    $ WindowAttributes -> CInt
    wa_y WindowAttributes
    wa) (CInt -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (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
    fi (CInt -> Dimension) -> CInt -> Dimension
    forall a b. (a -> b) -> a -> b
    $ WindowAttributes -> CInt
    wa_height WindowAttributes
    wa)
        (Rectangle -> Rectangle) -> X (Rectangle -> Rectangle)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Rectangle -> Rectangle) -> X (Rectangle -> Rectangle))
    -> (Rectangle -> Rectangle) -> X (Rectangle -> Rectangle)
    forall a b. (a -> b) -> a -> b
    $ \r :: Rectangle
    r -> RectC -> Rectangle
    c2r (RectC -> Rectangle) -> RectC -> Rectangle
    forall a b. (a -> b) -> a -> b
    $ (Strut -> RectC -> RectC) -> RectC -> [Strut] -> RectC
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (RectC -> Strut -> RectC -> RectC
    reduce RectC
    screen) (Rectangle -> RectC
    r2c Rectangle
    r) [Strut]
    struts
      where careAbout :: (Direction2D, b, c, d) -> Bool
    careAbout (s :: Direction2D
    s,_,_,_) = Direction2D
    s Direction2D -> Set Direction2D -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set Direction2D
    ss

    -- | Adjust layout automagically: don't cover up any docks, status
    --   bars, etc.
    avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a
    avoidStruts :: l a -> ModifiedLayout AvoidStruts l a
    avoidStruts = [Direction2D] -> l a -> ModifiedLayout AvoidStruts l a
    forall (l :: * -> *) a.
    LayoutClass l a =>
    [Direction2D] -> l a -> ModifiedLayout AvoidStruts l a
    avoidStrutsOn [Direction2D
    U,Direction2D
    D,Direction2D
    L,Direction2D
    R]

    -- | Adjust layout automagically: don't cover up docks, status bars,
    --   etc. on the indicated sides of the screen.  Valid sides are U
    --   (top), D (bottom), R (right), or L (left).
    avoidStrutsOn :: LayoutClass l a =>
                     [Direction2D]
                  -> l a
                  -> ModifiedLayout AvoidStruts l a
    avoidStrutsOn :: [Direction2D] -> l a -> ModifiedLayout AvoidStruts l a
    avoidStrutsOn ss :: [Direction2D]
    ss = AvoidStruts a -> l a -> ModifiedLayout AvoidStruts l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout (AvoidStruts a -> l a -> ModifiedLayout AvoidStruts l a)
    -> AvoidStruts a -> l a -> ModifiedLayout AvoidStruts l a
    forall a b. (a -> b) -> a -> b
    $ Set Direction2D -> AvoidStruts a
    forall a. Set Direction2D -> AvoidStruts a
    AvoidStruts ([Direction2D] -> Set Direction2D
    forall a. Ord a => [a] -> Set a
    S.fromList [Direction2D]
    ss)

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

    -- | Message type which can be sent to an 'AvoidStruts' layout
    --   modifier to alter its behavior.
    data ToggleStruts = ToggleStruts
                      | ToggleStrut Direction2D
      deriving (ReadPrec [ToggleStruts]
    ReadPrec ToggleStruts
    Int -> ReadS ToggleStruts
    ReadS [ToggleStruts]
    (Int -> ReadS ToggleStruts)
    -> ReadS [ToggleStruts]
    -> ReadPrec ToggleStruts
    -> ReadPrec [ToggleStruts]
    -> Read ToggleStruts
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [ToggleStruts]
    $creadListPrec :: ReadPrec [ToggleStruts]
    readPrec :: ReadPrec ToggleStruts
    $creadPrec :: ReadPrec ToggleStruts
    readList :: ReadS [ToggleStruts]
    $creadList :: ReadS [ToggleStruts]
    readsPrec :: Int -> ReadS ToggleStruts
    $creadsPrec :: Int -> ReadS ToggleStruts
    Read,Int -> ToggleStruts -> ShowS
    [ToggleStruts] -> ShowS
    ToggleStruts -> String
    (Int -> ToggleStruts -> ShowS)
    -> (ToggleStruts -> String)
    -> ([ToggleStruts] -> ShowS)
    -> Show ToggleStruts
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [ToggleStruts] -> ShowS
    $cshowList :: [ToggleStruts] -> ShowS
    show :: ToggleStruts -> String
    $cshow :: ToggleStruts -> String
    showsPrec :: Int -> ToggleStruts -> ShowS
    $cshowsPrec :: Int -> ToggleStruts -> ShowS
    Show,Typeable)

    instance Message ToggleStruts

    -- | SetStruts is a message constructor used to set or unset specific struts,
    -- regardless of whether or not the struts were originally set. Here are some
    -- example bindings:
    --
    -- Show all gaps:
    --
    -- >   ,((modm .|. shiftMask  ,xK_b),sendMessage $ SetStruts [minBound .. maxBound] [])
    --
    -- Hide all gaps:
    --
    -- >   ,((modm .|. controlMask,xK_b),sendMessage $ SetStruts [] [minBound .. maxBound])
    --
    -- Show only upper and left gaps:
    --
    -- >   ,((modm .|. controlMask .|. shiftMask,xK_b),sendMessage $ SetStruts [U,L] [minBound .. maxBound])
    --
    -- Hide the bottom keeping whatever the other values were:
    --
    -- >   ,((modm .|. controlMask .|. shiftMask,xK_g),sendMessage $ SetStruts [] [D])
    data SetStruts = SetStruts { SetStruts -> [Direction2D]
    addedStruts   :: [Direction2D]
                               , SetStruts -> [Direction2D]
    removedStruts :: [Direction2D] -- ^ These are removed from the currently set struts before 'addedStruts' are added.
                               }
      deriving (ReadPrec [SetStruts]
    ReadPrec SetStruts
    Int -> ReadS SetStruts
    ReadS [SetStruts]
    (Int -> ReadS SetStruts)
    -> ReadS [SetStruts]
    -> ReadPrec SetStruts
    -> ReadPrec [SetStruts]
    -> Read SetStruts
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [SetStruts]
    $creadListPrec :: ReadPrec [SetStruts]
    readPrec :: ReadPrec SetStruts
    $creadPrec :: ReadPrec SetStruts
    readList :: ReadS [SetStruts]
    $creadList :: ReadS [SetStruts]
    readsPrec :: Int -> ReadS SetStruts
    $creadsPrec :: Int -> ReadS SetStruts
    Read,Int -> SetStruts -> ShowS
    [SetStruts] -> ShowS
    SetStruts -> String
    (Int -> SetStruts -> ShowS)
    -> (SetStruts -> String)
    -> ([SetStruts] -> ShowS)
    -> Show SetStruts
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [SetStruts] -> ShowS
    $cshowList :: [SetStruts] -> ShowS
    show :: SetStruts -> String
    $cshow :: SetStruts -> String
    showsPrec :: Int -> SetStruts -> ShowS
    $cshowsPrec :: Int -> SetStruts -> ShowS
    Show,Typeable)

    instance Message SetStruts

    instance LayoutModifier AvoidStruts a where
        modifyLayout :: AvoidStruts a
    -> Workspace String (l a) a
    -> Rectangle
    -> X ([(a, Rectangle)], Maybe (l a))
    modifyLayout (AvoidStruts ss :: Set Direction2D
    ss) w :: Workspace String (l a) a
    w r :: Rectangle
    r = do
            Rectangle
    srect <- ((Rectangle -> Rectangle) -> Rectangle)
    -> X (Rectangle -> Rectangle) -> X Rectangle
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Rectangle -> Rectangle) -> Rectangle -> Rectangle
    forall a b. (a -> b) -> a -> b
    $ Rectangle
    r) (Set Direction2D -> X (Rectangle -> Rectangle)
    calcGap Set Direction2D
    ss)
            -- Ensure _NET_WORKAREA is not set.
            -- See: https://github.com/xmonad/xmonad-contrib/pull/79
            X ()
    rmWorkarea
            Workspace String (l a) a
    -> Rectangle -> X ([(a, Rectangle)], Maybe (l a))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    Workspace String (layout a) a
    -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
    runLayout Workspace String (l a) a
    w Rectangle
    srect

        pureMess :: AvoidStruts a -> SomeMessage -> Maybe (AvoidStruts a)
    pureMess as :: AvoidStruts a
    as@(AvoidStruts ss :: Set Direction2D
    ss) m :: SomeMessage
    m
            | Just ToggleStruts    <- SomeMessage -> Maybe ToggleStruts
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m = AvoidStruts a -> Maybe (AvoidStruts a)
    forall a. a -> Maybe a
    Just (AvoidStruts a -> Maybe (AvoidStruts a))
    -> AvoidStruts a -> Maybe (AvoidStruts a)
    forall a b. (a -> b) -> a -> b
    $ Set Direction2D -> AvoidStruts a
    forall a. Set Direction2D -> AvoidStruts a
    AvoidStruts (Set Direction2D -> Set Direction2D
    forall a a. (Ord a, Bounded a, Enum a) => Set a -> Set a
    toggleAll Set Direction2D
    ss)
            | Just (ToggleStrut s :: Direction2D
    s) <- SomeMessage -> Maybe ToggleStruts
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m = AvoidStruts a -> Maybe (AvoidStruts a)
    forall a. a -> Maybe a
    Just (AvoidStruts a -> Maybe (AvoidStruts a))
    -> AvoidStruts a -> Maybe (AvoidStruts a)
    forall a b. (a -> b) -> a -> b
    $ Set Direction2D -> AvoidStruts a
    forall a. Set Direction2D -> AvoidStruts a
    AvoidStruts (Direction2D -> Set Direction2D -> Set Direction2D
    forall a. Ord a => a -> Set a -> Set a
    toggleOne Direction2D
    s Set Direction2D
    ss)
            | Just (SetStruts n :: [Direction2D]
    n k :: [Direction2D]
    k) <- SomeMessage -> Maybe SetStruts
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m
            , let newSS :: Set Direction2D
    newSS = [Direction2D] -> Set Direction2D
    forall a. Ord a => [a] -> Set a
    S.fromList [Direction2D]
    n Set Direction2D -> Set Direction2D -> Set Direction2D
    forall a. Ord a => Set a -> Set a -> Set a
    `S.union` (Set Direction2D
    ss Set Direction2D -> Set Direction2D -> Set Direction2D
    forall a. Ord a => Set a -> Set a -> Set a
    S.\\ [Direction2D] -> Set Direction2D
    forall a. Ord a => [a] -> Set a
    S.fromList [Direction2D]
    k)
            , Set Direction2D
    newSS Set Direction2D -> Set Direction2D -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Set Direction2D
    ss = AvoidStruts a -> Maybe (AvoidStruts a)
    forall a. a -> Maybe a
    Just (AvoidStruts a -> Maybe (AvoidStruts a))
    -> AvoidStruts a -> Maybe (AvoidStruts a)
    forall a b. (a -> b) -> a -> b
    $ Set Direction2D -> AvoidStruts a
    forall a. Set Direction2D -> AvoidStruts a
    AvoidStruts Set Direction2D
    newSS
            | Just UpdateDocks <- SomeMessage -> Maybe UpdateDocks
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m = AvoidStruts a -> Maybe (AvoidStruts a)
    forall a. a -> Maybe a
    Just AvoidStruts a
    as
            | Bool
    otherwise = Maybe (AvoidStruts a)
    forall a. Maybe a
    Nothing
          where toggleAll :: Set a -> Set a
    toggleAll x :: Set a
    x | Set a -> Bool
    forall a. Set a -> Bool
    S.null Set a
    x = [a] -> Set a
    forall a. Ord a => [a] -> Set a
    S.fromList [a
    forall a. Bounded a => a
    minBound .. a
    forall a. Bounded a => a
    maxBound]
                            | Bool
    otherwise = Set a
    forall a. Set a
    S.empty
                toggleOne :: a -> Set a -> Set a
    toggleOne x :: a
    x xs :: Set a
    xs | a
    x a -> Set a -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `S.member` Set a
    xs = a -> Set a -> Set a
    forall a. Ord a => a -> Set a -> Set a
    S.delete a
    x Set a
    xs
                               | Bool
    otherwise   = a
    x a -> Set a -> Set a
    forall a. Ord a => a -> Set a -> Set a
    `S.insert` Set a
    xs

    rmWorkarea :: X ()
    rmWorkarea :: X ()
    rmWorkarea = (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \dpy :: Display
    dpy -> do
        Window
    a <- String -> X Window
    getAtom "_NET_WORKAREA"
        Window
    r <- (XConf -> Window) -> X Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Window
    theRoot
        IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (Display -> Window -> Window -> IO ()
    deleteProperty Display
    dpy Window
    r Window
    a)

    -- | (Direction, height\/width, initial pixel, final pixel).

    type Strut = (Direction2D, CLong, CLong, CLong)

    -- | (Initial x pixel, initial y pixel,
    --    final x pixel, final y pixel).

    newtype RectC = RectC (CLong, CLong, CLong, CLong) deriving (RectC -> RectC -> Bool
    (RectC -> RectC -> Bool) -> (RectC -> RectC -> Bool) -> Eq RectC
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: RectC -> RectC -> Bool
    $c/= :: RectC -> RectC -> Bool
    == :: RectC -> RectC -> Bool
    $c== :: RectC -> RectC -> Bool
    Eq,Int -> RectC -> ShowS
    [RectC] -> ShowS
    RectC -> String
    (Int -> RectC -> ShowS)
    -> (RectC -> String) -> ([RectC] -> ShowS) -> Show RectC
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [RectC] -> ShowS
    $cshowList :: [RectC] -> ShowS
    show :: RectC -> String
    $cshow :: RectC -> String
    showsPrec :: Int -> RectC -> ShowS
    $cshowsPrec :: Int -> RectC -> ShowS
    Show)

    -- | Invertible conversion.

    r2c :: Rectangle -> RectC
    r2c :: Rectangle -> RectC
    r2c (Rectangle x :: Position
    x y :: Position
    y w :: Dimension
    w h :: Dimension
    h) = (CLong, CLong, CLong, CLong) -> RectC
    RectC (Position -> CLong
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    x, Position -> CLong
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    y, Position -> CLong
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    x CLong -> CLong -> CLong
    forall a. Num a => a -> a -> a
    + Dimension -> CLong
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    w CLong -> CLong -> CLong
    forall a. Num a => a -> a -> a
    - 1, Position -> CLong
    forall a b. (Integral a, Num b) => a -> b
    fi Position
    y CLong -> CLong -> CLong
    forall a. Num a => a -> a -> a
    + Dimension -> CLong
    forall a b. (Integral a, Num b) => a -> b
    fi Dimension
    h CLong -> CLong -> CLong
    forall a. Num a => a -> a -> a
    - 1)

    -- | Invertible conversion.

    c2r :: RectC -> Rectangle
    c2r :: RectC -> Rectangle
    c2r (RectC (x1 :: CLong
    x1, y1 :: CLong
    y1, x2 :: CLong
    x2, y2 :: CLong
    y2)) = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (CLong -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi CLong
    x1) (CLong -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi CLong
    y1) (CLong -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (CLong -> Dimension) -> CLong -> Dimension
    forall a b. (a -> b) -> a -> b
    $ CLong
    x2 CLong -> CLong -> CLong
    forall a. Num a => a -> a -> a
    - CLong
    x1 CLong -> CLong -> CLong
    forall a. Num a => a -> a -> a
    + 1) (CLong -> Dimension
    forall a b. (Integral a, Num b) => a -> b
    fi (CLong -> Dimension) -> CLong -> Dimension
    forall a b. (a -> b) -> a -> b
    $ CLong
    y2 CLong -> CLong -> CLong
    forall a. Num a => a -> a -> a
    - CLong
    y1 CLong -> CLong -> CLong
    forall a. Num a => a -> a -> a
    + 1)

    reduce :: RectC -> Strut -> RectC -> RectC
    reduce :: RectC -> Strut -> RectC -> RectC
    reduce (RectC (sx0 :: CLong
    sx0, sy0 :: CLong
    sy0, sx1 :: CLong
    sx1, sy1 :: CLong
    sy1)) (s :: Direction2D
    s, n :: CLong
    n, l :: CLong
    l, h :: CLong
    h) (RectC (x0 :: CLong
    x0, y0 :: CLong
    y0, x1 :: CLong
    x1, y1 :: CLong
    y1)) =
     (CLong, CLong, CLong, CLong) -> RectC
    RectC ((CLong, CLong, CLong, CLong) -> RectC)
    -> (CLong, CLong, CLong, CLong) -> RectC
    forall a b. (a -> b) -> a -> b
    $ case Direction2D
    s of
        L | (CLong, CLong) -> Bool
    p (CLong
    y0, CLong
    y1) Bool -> Bool -> Bool
    && CLong -> Bool
    qh CLong
    x1     -> (CLong -> CLong -> CLong
    mx CLong
    x0 CLong
    sx0, CLong
    y0       , CLong
    x1       , CLong
    y1       )
        R | (CLong, CLong) -> Bool
    p (CLong
    y0, CLong
    y1) Bool -> Bool -> Bool
    && CLong -> CLong -> Bool
    qv CLong
    sx1 CLong
    x0 -> (CLong
    x0       , CLong
    y0       , CLong -> CLong -> CLong
    mn CLong
    x1 CLong
    sx1, CLong
    y1       )
        U | (CLong, CLong) -> Bool
    p (CLong
    x0, CLong
    x1) Bool -> Bool -> Bool
    && CLong -> Bool
    qh CLong
    y1     -> (CLong
    x0       , CLong -> CLong -> CLong
    mx CLong
    y0 CLong
    sy0, CLong
    x1       , CLong
    y1       )
        D | (CLong, CLong) -> Bool
    p (CLong
    x0, CLong
    x1) Bool -> Bool -> Bool
    && CLong -> CLong -> Bool
    qv CLong
    sy1 CLong
    y0 -> (CLong
    x0       , CLong
    y0       , CLong
    x1       , CLong -> CLong -> CLong
    mn CLong
    y1 CLong
    sy1)
        _                           -> (CLong
    x0       , CLong
    y0       , CLong
    x1       , CLong
    y1       )
     where
        mx :: CLong -> CLong -> CLong
    mx a :: CLong
    a b :: CLong
    b = CLong -> CLong -> CLong
    forall a. Ord a => a -> a -> a
    max CLong
    a (CLong
    b CLong -> CLong -> CLong
    forall a. Num a => a -> a -> a
    + CLong
    n)
        mn :: CLong -> CLong -> CLong
    mn a :: CLong
    a b :: CLong
    b = CLong -> CLong -> CLong
    forall a. Ord a => a -> a -> a
    min CLong
    a (CLong
    b CLong -> CLong -> CLong
    forall a. Num a => a -> a -> a
    - CLong
    n)
        p :: (CLong, CLong) -> Bool
    p r :: (CLong, CLong)
    r = (CLong, CLong)
    r (CLong, CLong) -> (CLong, CLong) -> Bool
    forall a. Ord a => (a, a) -> (a, a) -> Bool
    `overlaps` (CLong
    l, CLong
    h)
        -- Filter out struts that cover the entire rectangle:
        qh :: CLong -> Bool
    qh d1 :: CLong
    d1 = CLong
    n CLong -> CLong -> Bool
    forall a. Ord a => a -> a -> Bool
    <= CLong
    d1
        qv :: CLong -> CLong -> Bool
    qv sd1 :: CLong
    sd1 d0 :: CLong
    d0 = CLong
    sd1 CLong -> CLong -> CLong
    forall a. Num a => a -> a -> a
    - CLong
    n CLong -> CLong -> Bool
    forall a. Ord a => a -> a -> Bool
    >= CLong
    d0

    -- | Do the two ranges overlap?
    --
    -- Precondition for every input range @(x, y)@: @x '<=' y@.
    --
    -- A range @(x, y)@ is assumed to include every pixel from @x@ to @y@.

    overlaps :: Ord a => (a, a) -> (a, a) -> Bool
    (a :: a
    a, b :: a
    b) overlaps :: (a, a) -> (a, a) -> Bool
    `overlaps` (x :: a
    x, y :: a
    y) =
      (a, a) -> a -> Bool
    forall a. Ord a => (a, a) -> a -> Bool
    inRange (a
    a, a
    b) a
    x Bool -> Bool -> Bool
    || (a, a) -> a -> Bool
    forall a. Ord a => (a, a) -> a -> Bool
    inRange (a
    a, a
    b) a
    y Bool -> Bool -> Bool
    || (a, a) -> a -> Bool
    forall a. Ord a => (a, a) -> a -> Bool
    inRange (a
    x, a
    y) a
    a
      where
      inRange :: (a, a) -> a -> Bool
    inRange (i :: a
    i, j :: a
    j) k :: a
    k = a
    i a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    k Bool -> Bool -> Bool
    && a
    k a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    <= a
    j