    {-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-}
    ----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.DraggingVisualizer
    -- Copyright   :  (c) Jan Vornberger 2009
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
    -- Stability   :  unstable
    -- Portability :  not portable
    --
    -- A helper module to visualize the process of dragging a window by
    -- making it follow the mouse cursor. See "XMonad.Layout.WindowSwitcherDecoration"
    -- for a module that makes use of this.
    --
    -----------------------------------------------------------------------------

    module XMonad.Layout.DraggingVisualizer
        ( draggingVisualizer,
          DraggingVisualizerMsg (..),
          DraggingVisualizer,
        ) where

    import XMonad
    import XMonad.Layout.LayoutModifier

    data DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show )
    draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window
    draggingVisualizer = ModifiedLayout $ DraggingVisualizer Nothing

    data DraggingVisualizerMsg = DraggingWindow Window Rectangle
                                    | DraggingStopped
                                    deriving ( Typeable, Eq )
    instance Message DraggingVisualizerMsg

    instance LayoutModifier DraggingVisualizer Window where
        modifierDescription (DraggingVisualizer _) = "DraggingVisualizer"
        pureModifier (DraggingVisualizer (Just dragged@(draggedWin, _))) _ _ wrs =
                if draggedWin `elem` (map fst wrs)
                    then (dragged : rest, Nothing)
                    else (wrs, Just $ DraggingVisualizer Nothing)
            where
                rest = filter (\(w, _) -> w /= draggedWin) wrs
        pureModifier _ _ _ wrs = (wrs, Nothing)

        pureMess (DraggingVisualizer _) m = case fromMessage m of
            Just (DraggingWindow w rect) -> Just $ DraggingVisualizer $ Just (w, rect)
            Just (DraggingStopped) -> Just $ DraggingVisualizer Nothing
            _ -> Nothing