{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-}
module XMonad.Layout.DraggingVisualizer
( draggingVisualizer,
DraggingVisualizerMsg (..),
DraggingVisualizer,
) where
import XMonad
import XMonad.Layout.LayoutModifier
newtype DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( ReadPrec [DraggingVisualizer a]
ReadPrec (DraggingVisualizer a)
ReadS [DraggingVisualizer a]
forall a. ReadPrec [DraggingVisualizer a]
forall a. ReadPrec (DraggingVisualizer a)
forall a. Int -> ReadS (DraggingVisualizer a)
forall a. ReadS [DraggingVisualizer a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DraggingVisualizer a]
$creadListPrec :: forall a. ReadPrec [DraggingVisualizer a]
readPrec :: ReadPrec (DraggingVisualizer a)
$creadPrec :: forall a. ReadPrec (DraggingVisualizer a)
readList :: ReadS [DraggingVisualizer a]
$creadList :: forall a. ReadS [DraggingVisualizer a]
readsPrec :: Int -> ReadS (DraggingVisualizer a)
$creadsPrec :: forall a. Int -> ReadS (DraggingVisualizer a)
Read, Int -> DraggingVisualizer a -> ShowS
forall a. Int -> DraggingVisualizer a -> ShowS
forall a. [DraggingVisualizer a] -> ShowS
forall a. DraggingVisualizer a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DraggingVisualizer a] -> ShowS
$cshowList :: forall a. [DraggingVisualizer a] -> ShowS
show :: DraggingVisualizer a -> String
$cshow :: forall a. DraggingVisualizer a -> String
showsPrec :: Int -> DraggingVisualizer a -> ShowS
$cshowsPrec :: forall a. Int -> DraggingVisualizer a -> ShowS
Show )
draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window
draggingVisualizer :: forall (l :: * -> *).
LayoutClass l Window =>
l Window -> ModifiedLayout DraggingVisualizer l Window
draggingVisualizer = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Window, Rectangle) -> DraggingVisualizer a
DraggingVisualizer forall a. Maybe a
Nothing
data DraggingVisualizerMsg = DraggingWindow Window Rectangle
| DraggingStopped
deriving DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool
$c/= :: DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool
== :: DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool
$c== :: DraggingVisualizerMsg -> DraggingVisualizerMsg -> Bool
Eq
instance Message DraggingVisualizerMsg
instance LayoutModifier DraggingVisualizer Window where
modifierDescription :: DraggingVisualizer Window -> String
modifierDescription (DraggingVisualizer Maybe (Window, Rectangle)
_) = String
"DraggingVisualizer"
pureModifier :: DraggingVisualizer Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> ([(Window, Rectangle)], Maybe (DraggingVisualizer Window))
pureModifier (DraggingVisualizer (Just dragged :: (Window, Rectangle)
dragged@(Window
draggedWin, Rectangle
_))) Rectangle
_ Maybe (Stack Window)
_ [(Window, Rectangle)]
wrs =
if Window
draggedWin forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Window, Rectangle)]
wrs
then ((Window, Rectangle)
dragged forall a. a -> [a] -> [a]
: [(Window, Rectangle)]
rest, forall a. Maybe a
Nothing)
else ([(Window, Rectangle)]
wrs, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Window, Rectangle) -> DraggingVisualizer a
DraggingVisualizer forall a. Maybe a
Nothing)
where
rest :: [(Window, Rectangle)]
rest = forall a. (a -> Bool) -> [a] -> [a]
filter (\(Window
w, Rectangle
_) -> Window
w forall a. Eq a => a -> a -> Bool
/= Window
draggedWin) [(Window, Rectangle)]
wrs
pureModifier DraggingVisualizer Window
_ Rectangle
_ Maybe (Stack Window)
_ [(Window, Rectangle)]
wrs = ([(Window, Rectangle)]
wrs, forall a. Maybe a
Nothing)
pureMess :: DraggingVisualizer Window
-> SomeMessage -> Maybe (DraggingVisualizer Window)
pureMess (DraggingVisualizer Maybe (Window, Rectangle)
_) SomeMessage
m = case forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m of
Just (DraggingWindow Window
w Rectangle
rect) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Window, Rectangle) -> DraggingVisualizer a
DraggingVisualizer forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Window
w, Rectangle
rect)
Just DraggingVisualizerMsg
DraggingStopped -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Window, Rectangle) -> DraggingVisualizer a
DraggingVisualizer forall a. Maybe a
Nothing
Maybe DraggingVisualizerMsg
_ -> forall a. Maybe a
Nothing