{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
module XMonad.Layout.Drawer
(
simpleDrawer
, drawer
, onLeft, onTop, onRight, onBottom
, module XMonad.Util.WindowProperties
, Drawer, Reflected
) where
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Util.WindowProperties
import XMonad.StackSet as S
import XMonad.Layout.Reflect
data Drawer l a = Drawer Rational Rational Property (l a)
deriving (ReadPrec [Drawer l a]
ReadPrec (Drawer l a)
ReadS [Drawer l a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l :: * -> *) a. Read (l a) => ReadPrec [Drawer l a]
forall (l :: * -> *) a. Read (l a) => ReadPrec (Drawer l a)
forall (l :: * -> *) a. Read (l a) => Int -> ReadS (Drawer l a)
forall (l :: * -> *) a. Read (l a) => ReadS [Drawer l a]
readListPrec :: ReadPrec [Drawer l a]
$creadListPrec :: forall (l :: * -> *) a. Read (l a) => ReadPrec [Drawer l a]
readPrec :: ReadPrec (Drawer l a)
$creadPrec :: forall (l :: * -> *) a. Read (l a) => ReadPrec (Drawer l a)
readList :: ReadS [Drawer l a]
$creadList :: forall (l :: * -> *) a. Read (l a) => ReadS [Drawer l a]
readsPrec :: Int -> ReadS (Drawer l a)
$creadsPrec :: forall (l :: * -> *) a. Read (l a) => Int -> ReadS (Drawer l a)
Read, Int -> Drawer l a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l :: * -> *) a. Show (l a) => Int -> Drawer l a -> ShowS
forall (l :: * -> *) a. Show (l a) => [Drawer l a] -> ShowS
forall (l :: * -> *) a. Show (l a) => Drawer l a -> String
showList :: [Drawer l a] -> ShowS
$cshowList :: forall (l :: * -> *) a. Show (l a) => [Drawer l a] -> ShowS
show :: Drawer l a -> String
$cshow :: forall (l :: * -> *) a. Show (l a) => Drawer l a -> String
showsPrec :: Int -> Drawer l a -> ShowS
$cshowsPrec :: forall (l :: * -> *) a. Show (l a) => Int -> Drawer l a -> ShowS
Show)
partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
partitionM a -> m Bool
f (a
x:[a]
xs) = do
Bool
b <- a -> m Bool
f a
x
([a]
ys, [a]
zs) <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
f [a]
xs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
b
then (a
xforall a. a -> [a] -> [a]
:[a]
ys, [a]
zs)
else ([a]
ys, a
xforall a. a -> [a] -> [a]
:[a]
zs)
instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Window where
modifyLayout :: forall (l :: * -> *).
LayoutClass l Window =>
Drawer l Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout (Drawer Rational
rs Rational
rb Property
p l Window
l) Workspace String (l Window) Window
ws Rectangle
rect =
case forall i l a. Workspace i l a -> Maybe (Stack a)
stack Workspace String (l Window) Window
ws of
Maybe (Stack Window)
Nothing -> forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (l Window) Window
ws Rectangle
rect
Just stk :: Stack Window
stk@Stack{ up :: forall a. Stack a -> [a]
up=[Window]
up_, down :: forall a. Stack a -> [a]
down=[Window]
down_, focus :: forall a. Stack a -> a
S.focus=Window
w } -> do
([Window]
upD, [Window]
upM) <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM (Property -> Window -> X Bool
hasProperty Property
p) [Window]
up_
([Window]
downD, [Window]
downM) <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM (Property -> Window -> X Bool
hasProperty Property
p) [Window]
down_
Bool
b <- Property -> Window -> X Bool
hasProperty Property
p Window
w
Maybe Window
focusedWindow <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Stack a -> a
S.focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
let rectD :: Rectangle
rectD = if Bool
b Bool -> Bool -> Bool
&& forall a. a -> Maybe a
Just Window
w forall a. Eq a => a -> a -> Bool
== Maybe Window
focusedWindow then Rectangle
rectB else Rectangle
rectS
let (Maybe (Stack Window)
stackD, Maybe (Stack Window)
stackM) = if Bool
b
then ( forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Stack Window
stk { up :: [Window]
up=[Window]
upD, down :: [Window]
down=[Window]
downD }
, forall {a}. [a] -> [a] -> Maybe (Stack a)
mkStack [Window]
upM [Window]
downM )
else ( forall {a}. [a] -> [a] -> Maybe (Stack a)
mkStack [Window]
upD [Window]
downD
, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Stack Window
stk { up :: [Window]
up=[Window]
upM, down :: [Window]
down=[Window]
downM } )
([(Window, Rectangle)]
winsD, Maybe (l Window)
_) <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (Workspace String (l Window) Window
ws { layout :: l Window
layout=l Window
l, stack :: Maybe (Stack Window)
stack=Maybe (Stack Window)
stackD }) Rectangle
rectD
([(Window, Rectangle)]
winsM, Maybe (l Window)
u') <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (Workspace String (l Window) Window
ws { stack :: Maybe (Stack Window)
stack=Maybe (Stack Window)
stackM }) Rectangle
rectM
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
winsD forall a. [a] -> [a] -> [a]
++ [(Window, Rectangle)]
winsM, Maybe (l Window)
u')
where
mkStack :: [a] -> [a] -> Maybe (Stack a)
mkStack [] [] = forall a. Maybe a
Nothing
mkStack [a]
xs (a
y:[a]
ys) = forall a. a -> Maybe a
Just (Stack { up :: [a]
up=[a]
xs, focus :: a
S.focus=a
y, down :: [a]
down=[a]
ys })
mkStack (a
x:[a]
xs) [a]
ys = forall a. a -> Maybe a
Just (Stack { up :: [a]
up=[a]
xs, focus :: a
S.focus=a
x, down :: [a]
down=[a]
ys })
rectB :: Rectangle
rectB = Rectangle
rect { rect_width :: Dimension
rect_width=forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_width Rectangle
rect) forall a. Num a => a -> a -> a
* Rational
rb }
rectS :: Rectangle
rectS = Rectangle
rectB { rect_x :: Position
rect_x=Rectangle -> Position
rect_x Rectangle
rectB forall a. Num a => a -> a -> a
- forall a b. (RealFrac a, Integral b) => a -> b
round ((Rational
rb forall a. Num a => a -> a -> a
- Rational
rs) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_width Rectangle
rect)) }
rectM :: Rectangle
rectM = Rectangle
rect { rect_x :: Position
rect_x=Rectangle -> Position
rect_x Rectangle
rect forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_width Rectangle
rect) forall a. Num a => a -> a -> a
* Rational
rs)
, rect_width :: Dimension
rect_width=Rectangle -> Dimension
rect_width Rectangle
rect forall a. Num a => a -> a -> a
- forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_width Rectangle
rect) forall a. Num a => a -> a -> a
* Rational
rs) }
type Reflected l = ModifiedLayout Reflect l
simpleDrawer :: Rational
-> Rational
-> Property
-> Drawer Tall a
simpleDrawer :: forall a. Rational -> Rational -> Property -> Drawer Tall a
simpleDrawer Rational
rs Rational
rb Property
p = forall (l :: * -> *) a.
Rational -> Rational -> Property -> l a -> Drawer l a
Drawer Rational
rs Rational
rb Property
p forall {a}. Tall a
vertical
where
vertical :: Tall a
vertical = forall a. Int -> Rational -> Rational -> Tall a
Tall Int
0 Rational
0 Rational
0
drawer :: Rational
-> Rational
-> Property
-> l a
-> Drawer l a
drawer :: forall (l :: * -> *) a.
Rational -> Rational -> Property -> l a -> Drawer l a
drawer = forall (l :: * -> *) a.
Rational -> Rational -> Property -> l a -> Drawer l a
Drawer
onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout
onRight :: Drawer l a -> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
onRight :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
onRight Drawer l a
d = forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectHoriz forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a (l' :: * -> *).
Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft Drawer l a
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectHoriz
onTop :: Drawer l a -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
onTop :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
onTop Drawer l a
d = forall (l :: * -> *) a. l a -> Mirror l a
Mirror forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a (l' :: * -> *).
Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft Drawer l a
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a. l a -> Mirror l a
Mirror
onBottom :: Drawer l a -> l' a -> Reflected (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
onBottom :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a
-> Reflected
(Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
onBottom Drawer l a
d = forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectVert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
onTop Drawer l a
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectVert