{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-}
module XMonad.Layout.PositionStoreFloat
(
positionStoreFloat, PositionStoreFloat
) where
import XMonad
import XMonad.Util.PositionStore
import qualified XMonad.StackSet as S
import XMonad.Layout.WindowArranger
import XMonad.Prelude (fromMaybe, isJust, nub, when)
positionStoreFloat :: PositionStoreFloat a
positionStoreFloat :: forall a. PositionStoreFloat a
positionStoreFloat = forall a. (Maybe Rectangle, [a]) -> PositionStoreFloat a
PSF (forall a. Maybe a
Nothing, [])
newtype PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Int -> PositionStoreFloat a -> ShowS
forall a. Show a => Int -> PositionStoreFloat a -> ShowS
forall a. Show a => [PositionStoreFloat a] -> ShowS
forall a. Show a => PositionStoreFloat a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PositionStoreFloat a] -> ShowS
$cshowList :: forall a. Show a => [PositionStoreFloat a] -> ShowS
show :: PositionStoreFloat a -> String
$cshow :: forall a. Show a => PositionStoreFloat a -> String
showsPrec :: Int -> PositionStoreFloat a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PositionStoreFloat a -> ShowS
Show, ReadPrec [PositionStoreFloat a]
ReadPrec (PositionStoreFloat a)
ReadS [PositionStoreFloat a]
forall a. Read a => ReadPrec [PositionStoreFloat a]
forall a. Read a => ReadPrec (PositionStoreFloat a)
forall a. Read a => Int -> ReadS (PositionStoreFloat a)
forall a. Read a => ReadS [PositionStoreFloat a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PositionStoreFloat a]
$creadListPrec :: forall a. Read a => ReadPrec [PositionStoreFloat a]
readPrec :: ReadPrec (PositionStoreFloat a)
$creadPrec :: forall a. Read a => ReadPrec (PositionStoreFloat a)
readList :: ReadS [PositionStoreFloat a]
$creadList :: forall a. Read a => ReadS [PositionStoreFloat a]
readsPrec :: Int -> ReadS (PositionStoreFloat a)
$creadsPrec :: forall a. Read a => Int -> ReadS (PositionStoreFloat a)
Read)
instance LayoutClass PositionStoreFloat Window where
description :: PositionStoreFloat Window -> String
description PositionStoreFloat Window
_ = String
"PSF"
doLayout :: PositionStoreFloat Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (PositionStoreFloat Window))
doLayout (PSF (Maybe Rectangle
maybeChange, [Window]
paintOrder)) Rectangle
sr (S.Stack Window
w [Window]
l [Window]
r) = do
PositionStore
posStore <- X PositionStore
getPosStore
let wrs :: [(Window, Rectangle)]
wrs = forall a b. (a -> b) -> [a] -> [b]
map (\Window
w' -> (Window
w', PositionStore -> Window -> Rectangle -> Rectangle
pSQ PositionStore
posStore Window
w' Rectangle
sr)) (forall a. [a] -> [a]
reverse [Window]
l forall a. [a] -> [a] -> [a]
++ [Window]
r)
let focused :: (Window, Rectangle)
focused = case Maybe Rectangle
maybeChange of
Maybe Rectangle
Nothing -> (Window
w, PositionStore -> Window -> Rectangle -> Rectangle
pSQ PositionStore
posStore Window
w Rectangle
sr)
Just Rectangle
changedRect -> (Window
w, Rectangle
changedRect)
let wrs' :: [(Window, Rectangle)]
wrs' = (Window, Rectangle)
focused forall a. a -> [a] -> [a]
: [(Window, Rectangle)]
wrs
let paintOrder' :: [Window]
paintOrder' = forall a. Eq a => [a] -> [a]
nub (Window
w forall a. a -> [a] -> [a]
: [Window]
paintOrder)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe Rectangle
maybeChange) forall a b. (a -> b) -> a -> b
$
(Window, Rectangle) -> Rectangle -> X ()
updatePositionStore (Window, Rectangle)
focused Rectangle
sr
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. Eq a => [(a, b)] -> [a] -> [(a, b)]
reorder [(Window, Rectangle)]
wrs' [Window]
paintOrder', forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. (Maybe Rectangle, [a]) -> PositionStoreFloat a
PSF (forall a. Maybe a
Nothing, [Window]
paintOrder'))
where
pSQ :: PositionStore -> Window -> Rectangle -> Rectangle
pSQ PositionStore
posStore Window
w' Rectangle
sr' = forall a. a -> Maybe a -> a
fromMaybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
50 Position
50 Dimension
200 Dimension
200)
(PositionStore -> Window -> Rectangle -> Maybe Rectangle
posStoreQuery PositionStore
posStore Window
w' Rectangle
sr')
pureMessage :: PositionStoreFloat Window
-> SomeMessage -> Maybe (PositionStoreFloat Window)
pureMessage (PSF (Maybe Rectangle
_, [Window]
paintOrder)) SomeMessage
m
| Just (SetGeometry Rectangle
rect) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. (Maybe Rectangle, [a]) -> PositionStoreFloat a
PSF (forall a. a -> Maybe a
Just Rectangle
rect, [Window]
paintOrder)
| Bool
otherwise = forall a. Maybe a
Nothing
updatePositionStore :: (Window, Rectangle) -> Rectangle -> X ()
updatePositionStore :: (Window, Rectangle) -> Rectangle -> X ()
updatePositionStore (Window
w, Rectangle
rect) Rectangle
sr = (PositionStore -> PositionStore) -> X ()
modifyPosStore (\PositionStore
ps ->
PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore
posStoreInsert PositionStore
ps Window
w Rectangle
rect Rectangle
sr)
reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)]
reorder :: forall a b. Eq a => [(a, b)] -> [a] -> [(a, b)]
reorder [(a, b)]
wrs [a]
order =
let ordered :: [(a, b)]
ordered = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {a} {b}. Eq a => [(a, b)] -> a -> [(a, b)]
pickElem [(a, b)]
wrs) [a]
order
rest :: [(a, b)]
rest = forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
w, b
_) -> a
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
order) [(a, b)]
wrs
in [(a, b)]
ordered forall a. [a] -> [a] -> [a]
++ [(a, b)]
rest
where
pickElem :: [(a, b)] -> a -> [(a, b)]
pickElem [(a, b)]
list a
e = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
e [(a, b)]
list of
Just b
result -> [(a
e, b
result)]
Maybe b
Nothing -> []