    {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-}
    ----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.WindowSwitcherDecoration
    -- Description :  Switch the position of windows by dragging them onto each other.
    -- Copyright   :  (c) Jan Vornberger 2009
    --                    Alejandro Serrano 2010
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
    -- Stability   :  unstable
    -- Portability :  not portable
    --
    -- A decoration that allows to switch the position of windows by dragging
    -- them onto each other.
    --
    -----------------------------------------------------------------------------

    module XMonad.Layout.WindowSwitcherDecoration
        ( -- * Usage:
          -- $usage
          windowSwitcherDecoration,
          windowSwitcherDecorationWithButtons,
          windowSwitcherDecorationWithImageButtons,
          WindowSwitcherDecoration, ImageWindowSwitcherDecoration,
        ) where

    import XMonad
    import XMonad.Layout.Decoration
    import XMonad.Layout.DecorationAddons
    import XMonad.Layout.ImageButtonDecoration
    import XMonad.Layout.DraggingVisualizer
    import qualified XMonad.StackSet as S
    import XMonad.Prelude
    import Foreign.C.Types(CInt)

    -- $usage
    -- You can use this module with the following in your
    -- @~\/.xmonad\/xmonad.hs@:
    --
    -- > import XMonad.Layout.WindowSwitcherDecoration
    -- > import XMonad.Layout.DraggingVisualizer
    --
    -- Then edit your @layoutHook@ by adding the WindowSwitcherDecoration to
    -- your layout:
    --
    -- > myL = windowSwitcherDecoration shrinkText def (draggingVisualizer $ layoutHook def)
    -- > main = xmonad def { layoutHook = myL }
    --
    -- There is also a version of the decoration that contains buttons like
    -- "XMonad.Layout.ButtonDecoration". To use that version, you will need to
    -- import "XMonad.Layout.DecorationAddons" as well and modify your @layoutHook@
    -- in the following way:
    --
    -- > import XMonad.Layout.DecorationAddons
    -- >
    -- > myL = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer $ layoutHook def)
    -- > main = xmonad def { layoutHook = myL }
    --
    -- Additionaly, there is a version of the decoration that contains image buttons like
    -- "XMonad.Layout.ImageButtonDecoration". To use that version, you will need to
    -- import "XMonad.Layout.ImageButtonDecoration" as well and modify your @layoutHook@
    -- in the following way:
    --
    -- > import XMonad.Layout.ImageButtonDecoration
    -- >
    -- > myL = windowSwitcherDecorationWithImageButtons shrinkText defaultThemeWithImageButtons (draggingVisualizer $ layoutHook def)
    -- > main = xmonad def { layoutHook = myL }
    --

    windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme
               -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
    windowSwitcherDecoration :: forall a s (l :: * -> *).
    (Eq a, Shrinker s) =>
    s
    -> Theme
    -> l a
    -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
    windowSwitcherDecoration s
    s Theme
    c = s
    -> Theme
    -> WindowSwitcherDecoration a
    -> l a
    -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
    forall (ds :: * -> *) a s (l :: * -> *).
    (DecorationStyle ds a, Shrinker s) =>
    s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
    decoration s
    s Theme
    c (WindowSwitcherDecoration a
     -> l a
     -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a)
    -> WindowSwitcherDecoration a
    -> l a
    -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
    forall a b. (a -> b) -> a -> b
    $ Bool -> WindowSwitcherDecoration a
    forall a. Bool -> WindowSwitcherDecoration a
    WSD Bool
    False

    windowSwitcherDecorationWithButtons :: (Eq a, Shrinker s) => s -> Theme
               -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
    windowSwitcherDecorationWithButtons :: forall a s (l :: * -> *).
    (Eq a, Shrinker s) =>
    s
    -> Theme
    -> l a
    -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
    windowSwitcherDecorationWithButtons s
    s Theme
    c = s
    -> Theme
    -> WindowSwitcherDecoration a
    -> l a
    -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
    forall (ds :: * -> *) a s (l :: * -> *).
    (DecorationStyle ds a, Shrinker s) =>
    s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
    decoration s
    s Theme
    c (WindowSwitcherDecoration a
     -> l a
     -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a)
    -> WindowSwitcherDecoration a
    -> l a
    -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
    forall a b. (a -> b) -> a -> b
    $ Bool -> WindowSwitcherDecoration a
    forall a. Bool -> WindowSwitcherDecoration a
    WSD Bool
    True

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

    instance Eq a => DecorationStyle WindowSwitcherDecoration a where
        describeDeco :: WindowSwitcherDecoration a -> String
    describeDeco WindowSwitcherDecoration a
    _ = String
    "WindowSwitcherDeco"

        decorationCatchClicksHook :: WindowSwitcherDecoration a -> Window -> Int -> Int -> X Bool
    decorationCatchClicksHook (WSD Bool
    withButtons) Window
    mainw Int
    dFL Int
    dFR = if Bool
    withButtons
                                                                        then Window -> Int -> Int -> X Bool
    titleBarButtonHandler Window
    mainw Int
    dFL Int
    dFR
                                                                        else Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        decorationWhileDraggingHook :: WindowSwitcherDecoration a
    -> CInt
    -> CInt
    -> (Window, Rectangle)
    -> Position
    -> Position
    -> X ()
    decorationWhileDraggingHook WindowSwitcherDecoration a
    _ = CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
    handleTiledDraggingInProgress
        decorationAfterDraggingHook :: WindowSwitcherDecoration a -> (Window, Rectangle) -> Window -> X ()
    decorationAfterDraggingHook WindowSwitcherDecoration a
    _ (Window
    mainw, Rectangle
    _) Window
    decoWin = do Window -> X ()
    focus Window
    mainw
                                                              Bool
    hasCrossed <- Window -> Window -> X Bool
    handleScreenCrossing Window
    mainw Window
    decoWin
                                                              Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    hasCrossed (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do DraggingVisualizerMsg -> X ()
    forall a. Message a => a -> X ()
    sendMessage DraggingVisualizerMsg
    DraggingStopped
                                                                                     Window -> X ()
    performWindowSwitching Window
    mainw

    -- Note: the image button code is duplicated from the above
    -- because the title bar handle is different

    windowSwitcherDecorationWithImageButtons :: (Eq a, Shrinker s) => s -> Theme
               -> l a -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a
    windowSwitcherDecorationWithImageButtons :: forall a s (l :: * -> *).
    (Eq a, Shrinker s) =>
    s
    -> Theme
    -> l a
    -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a
    windowSwitcherDecorationWithImageButtons s
    s Theme
    c = s
    -> Theme
    -> ImageWindowSwitcherDecoration a
    -> l a
    -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a
    forall (ds :: * -> *) a s (l :: * -> *).
    (DecorationStyle ds a, Shrinker s) =>
    s -> Theme -> ds a -> l a -> ModifiedLayout (Decoration ds s) l a
    decoration s
    s Theme
    c (ImageWindowSwitcherDecoration a
     -> l a
     -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a)
    -> ImageWindowSwitcherDecoration a
    -> l a
    -> ModifiedLayout (Decoration ImageWindowSwitcherDecoration s) l a
    forall a b. (a -> b) -> a -> b
    $ Bool -> ImageWindowSwitcherDecoration a
    forall a. Bool -> ImageWindowSwitcherDecoration a
    IWSD Bool
    True

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

    instance Eq a => DecorationStyle ImageWindowSwitcherDecoration a where
        describeDeco :: ImageWindowSwitcherDecoration a -> String
    describeDeco ImageWindowSwitcherDecoration a
    _ = String
    "ImageWindowSwitcherDeco"

        decorationCatchClicksHook :: ImageWindowSwitcherDecoration a -> Window -> Int -> Int -> X Bool
    decorationCatchClicksHook (IWSD Bool
    withButtons) Window
    mainw Int
    dFL Int
    dFR = if Bool
    withButtons
                                                                        then Window -> Int -> Int -> X Bool
    imageTitleBarButtonHandler Window
    mainw Int
    dFL Int
    dFR
                                                                        else Bool -> X Bool
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        decorationWhileDraggingHook :: ImageWindowSwitcherDecoration a
    -> CInt
    -> CInt
    -> (Window, Rectangle)
    -> Position
    -> Position
    -> X ()
    decorationWhileDraggingHook ImageWindowSwitcherDecoration a
    _ = CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
    handleTiledDraggingInProgress
        decorationAfterDraggingHook :: ImageWindowSwitcherDecoration a
    -> (Window, Rectangle) -> Window -> X ()
    decorationAfterDraggingHook ImageWindowSwitcherDecoration a
    _ (Window
    mainw, Rectangle
    _) Window
    decoWin = do Window -> X ()
    focus Window
    mainw
                                                              Bool
    hasCrossed <- Window -> Window -> X Bool
    handleScreenCrossing Window
    mainw Window
    decoWin
                                                              Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    hasCrossed (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do DraggingVisualizerMsg -> X ()
    forall a. Message a => a -> X ()
    sendMessage DraggingVisualizerMsg
    DraggingStopped
                                                                                     Window -> X ()
    performWindowSwitching Window
    mainw

    handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
    handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
    handleTiledDraggingInProgress CInt
    ex CInt
    ey (Window
    mainw, Rectangle
    r) Position
    x Position
    y = do
        let rect :: Rectangle
    rect = Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle (Position
    x Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    ex Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Rectangle -> Position
    rect_x Rectangle
    r))
                             (Position
    y Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi CInt
    ey Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - Rectangle -> Position
    rect_y Rectangle
    r))
                             (Rectangle -> Dimension
    rect_width  Rectangle
    r)
                             (Rectangle -> Dimension
    rect_height Rectangle
    r)
        DraggingVisualizerMsg -> X ()
    forall a. Message a => a -> X ()
    sendMessage (DraggingVisualizerMsg -> X ()) -> DraggingVisualizerMsg -> X ()
    forall a b. (a -> b) -> a -> b
    $ Window -> Rectangle -> DraggingVisualizerMsg
    DraggingWindow Window
    mainw Rectangle
    rect

    performWindowSwitching :: Window -> X ()
    performWindowSwitching :: Window -> X ()
    performWindowSwitching Window
    win =
        (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> do
           Window
    root <- (XConf -> Window) -> X Window
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Window
    theRoot
           (Bool
    _, Window
    _, Window
    selWin, CInt
    _, CInt
    _, CInt
    _, CInt
    _, Modifier
    _) <- IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
     -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier))
    -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    -> X (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    forall a b. (a -> b) -> a -> b
    $ Display
    -> Window
    -> IO (Bool, Window, Window, CInt, CInt, CInt, CInt, Modifier)
    queryPointer Display
    d Window
    root
           WindowSet
    ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
           let allWindows :: [Window]
    allWindows = WindowSet -> [Window]
    forall i l a s sd. StackSet i l a s sd -> [a]
    S.index WindowSet
    ws
           -- do a little double check to be sure
           Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((Window
    win Window -> [Window] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Window]
    allWindows) Bool -> Bool -> Bool
    && (Window
    selWin Window -> [Window] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Window]
    allWindows)) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
                    let allWindowsSwitched :: [Window]
    allWindowsSwitched = (Window -> Window) -> [Window] -> [Window]
    forall a b. (a -> b) -> [a] -> [b]
    map (Window -> Window -> Window -> Window
    forall {a}. Eq a => a -> a -> a -> a
    switchEntries Window
    win Window
    selWin) [Window]
    allWindows
                    let ([Window]
    ls, [Window] -> NonEmpty Window
    forall a. HasCallStack => [a] -> NonEmpty a
    notEmpty -> Window
    t :| [Window]
    rs) = (Window -> Bool) -> [Window] -> ([Window], [Window])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Window
    win Window -> Window -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) [Window]
    allWindowsSwitched
                    let newStack :: Stack Window
    newStack = Window -> [Window] -> [Window] -> Stack Window
    forall a. a -> [a] -> [a] -> Stack a
    S.Stack Window
    t ([Window] -> [Window]
    forall a. [a] -> [a]
    reverse [Window]
    ls) [Window]
    rs
                    (WindowSet -> WindowSet) -> X ()
    windows ((WindowSet -> WindowSet) -> X ())
    -> (WindowSet -> WindowSet) -> X ()
    forall a b. (a -> b) -> a -> b
    $ (Stack Window -> Stack Window) -> WindowSet -> WindowSet
    forall a i l s sd.
    (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
    S.modify' ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
    -> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
    forall a b. (a -> b) -> a -> b
    $ Stack Window -> Stack Window -> Stack Window
    forall a b. a -> b -> a
    const Stack Window
    newStack
        where
            switchEntries :: a -> a -> a -> a
    switchEntries a
    a a
    b a
    x
                | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    a    = a
    b
                | a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    b    = a
    a
                | Bool
    otherwise = a
    x