{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
module XMonad.Layout.Gaps (
Direction2D(..), Gaps,
GapSpec, gaps, gaps', GapMessage(..),
weakModifyGaps, modifyGap, setGaps, setGap
) where
import XMonad.Prelude (delete, fi)
import XMonad.Core
import Graphics.X11 (Rectangle(..))
import XMonad.Layout.LayoutModifier
import XMonad.Util.Types (Direction2D(..))
type GapSpec = [(Direction2D,Int)]
data Gaps a = Gaps GapSpec [Direction2D]
deriving (Int -> Gaps a -> ShowS
[Gaps a] -> ShowS
Gaps a -> String
(Int -> Gaps a -> ShowS)
-> (Gaps a -> String) -> ([Gaps a] -> ShowS) -> Show (Gaps a)
forall a. Int -> Gaps a -> ShowS
forall a. [Gaps a] -> ShowS
forall a. Gaps a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Gaps a] -> ShowS
$cshowList :: forall a. [Gaps a] -> ShowS
show :: Gaps a -> String
$cshow :: forall a. Gaps a -> String
showsPrec :: Int -> Gaps a -> ShowS
$cshowsPrec :: forall a. Int -> Gaps a -> ShowS
Show, ReadPrec [Gaps a]
ReadPrec (Gaps a)
Int -> ReadS (Gaps a)
ReadS [Gaps a]
(Int -> ReadS (Gaps a))
-> ReadS [Gaps a]
-> ReadPrec (Gaps a)
-> ReadPrec [Gaps a]
-> Read (Gaps a)
forall a. ReadPrec [Gaps a]
forall a. ReadPrec (Gaps a)
forall a. Int -> ReadS (Gaps a)
forall a. ReadS [Gaps a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Gaps a]
$creadListPrec :: forall a. ReadPrec [Gaps a]
readPrec :: ReadPrec (Gaps a)
$creadPrec :: forall a. ReadPrec (Gaps a)
readList :: ReadS [Gaps a]
$creadList :: forall a. ReadS [Gaps a]
readsPrec :: Int -> ReadS (Gaps a)
$creadsPrec :: forall a. Int -> ReadS (Gaps a)
Read)
data GapMessage = ToggleGaps
| ToggleGap !Direction2D
| IncGap !Int !Direction2D
| DecGap !Int !Direction2D
| ModifyGaps (GapSpec -> GapSpec)
instance Message GapMessage
instance LayoutModifier Gaps a where
modifyLayout :: Gaps a
-> Workspace String (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
modifyLayout Gaps a
g Workspace String (l a) a
w Rectangle
r = Workspace String (l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (l a) a
w (Gaps a -> Rectangle -> Rectangle
forall a. Gaps a -> Rectangle -> Rectangle
applyGaps Gaps a
g Rectangle
r)
pureMess :: Gaps a -> SomeMessage -> Maybe (Gaps a)
pureMess (Gaps GapSpec
conf [Direction2D]
cur) SomeMessage
m
| Just GapMessage
ToggleGaps <- SomeMessage -> Maybe GapMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
= Gaps a -> Maybe (Gaps a)
forall a. a -> Maybe a
Just (Gaps a -> Maybe (Gaps a)) -> Gaps a -> Maybe (Gaps a)
forall a b. (a -> b) -> a -> b
$ GapSpec -> [Direction2D] -> Gaps a
forall a. GapSpec -> [Direction2D] -> Gaps a
Gaps GapSpec
conf (GapSpec -> [Direction2D] -> [Direction2D]
toggleGaps GapSpec
conf [Direction2D]
cur)
| Just (ToggleGap Direction2D
d) <- SomeMessage -> Maybe GapMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
= Gaps a -> Maybe (Gaps a)
forall a. a -> Maybe a
Just (Gaps a -> Maybe (Gaps a)) -> Gaps a -> Maybe (Gaps a)
forall a b. (a -> b) -> a -> b
$ GapSpec -> [Direction2D] -> Gaps a
forall a. GapSpec -> [Direction2D] -> Gaps a
Gaps GapSpec
conf (GapSpec -> [Direction2D] -> Direction2D -> [Direction2D]
toggleGap GapSpec
conf [Direction2D]
cur Direction2D
d)
| Just (IncGap Int
i Direction2D
d) <- SomeMessage -> Maybe GapMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
= Gaps a -> Maybe (Gaps a)
forall a. a -> Maybe a
Just (Gaps a -> Maybe (Gaps a)) -> Gaps a -> Maybe (Gaps a)
forall a b. (a -> b) -> a -> b
$ GapSpec -> [Direction2D] -> Gaps a
forall a. GapSpec -> [Direction2D] -> Gaps a
Gaps (GapSpec -> GapSpec
limit (GapSpec -> GapSpec) -> (GapSpec -> GapSpec) -> GapSpec -> GapSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Direction2D -> GapSpec -> GapSpec
continuation (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i ) Direction2D
d (GapSpec -> GapSpec) -> GapSpec -> GapSpec
forall a b. (a -> b) -> a -> b
$ GapSpec
conf) [Direction2D]
cur
| Just (DecGap Int
i Direction2D
d) <- SomeMessage -> Maybe GapMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
= Gaps a -> Maybe (Gaps a)
forall a. a -> Maybe a
Just (Gaps a -> Maybe (Gaps a)) -> Gaps a -> Maybe (Gaps a)
forall a b. (a -> b) -> a -> b
$ GapSpec -> [Direction2D] -> Gaps a
forall a. GapSpec -> [Direction2D] -> Gaps a
Gaps (GapSpec -> GapSpec
limit (GapSpec -> GapSpec) -> (GapSpec -> GapSpec) -> GapSpec -> GapSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Direction2D -> GapSpec -> GapSpec
continuation (Int -> Int -> Int
forall a. Num a => a -> a -> a
+(-Int
i)) Direction2D
d (GapSpec -> GapSpec) -> GapSpec -> GapSpec
forall a b. (a -> b) -> a -> b
$ GapSpec
conf) [Direction2D]
cur
| Just (ModifyGaps GapSpec -> GapSpec
f) <- SomeMessage -> Maybe GapMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m
= Gaps a -> Maybe (Gaps a)
forall a. a -> Maybe a
Just (Gaps a -> Maybe (Gaps a)) -> Gaps a -> Maybe (Gaps a)
forall a b. (a -> b) -> a -> b
$ GapSpec -> [Direction2D] -> Gaps a
forall a. GapSpec -> [Direction2D] -> Gaps a
Gaps (GapSpec -> GapSpec
limit (GapSpec -> GapSpec) -> (GapSpec -> GapSpec) -> GapSpec -> GapSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GapSpec -> GapSpec
f (GapSpec -> GapSpec) -> GapSpec -> GapSpec
forall a b. (a -> b) -> a -> b
$ GapSpec
conf) [Direction2D]
cur
| Bool
otherwise = Maybe (Gaps a)
forall a. Maybe a
Nothing
weakModifyGaps :: (Direction2D -> Int -> Int) -> GapMessage
weakModifyGaps :: (Direction2D -> Int -> Int) -> GapMessage
weakModifyGaps = (GapSpec -> GapSpec) -> GapMessage
ModifyGaps ((GapSpec -> GapSpec) -> GapMessage)
-> ((Direction2D -> Int -> Int) -> GapSpec -> GapSpec)
-> (Direction2D -> Int -> Int)
-> GapMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Direction2D -> Int -> Int) -> GapSpec -> GapSpec
weakToStrong
modifyGap :: (Int -> Int) -> Direction2D -> GapMessage
modifyGap :: (Int -> Int) -> Direction2D -> GapMessage
modifyGap Int -> Int
f Direction2D
d = (GapSpec -> GapSpec) -> GapMessage
ModifyGaps ((GapSpec -> GapSpec) -> GapMessage)
-> (GapSpec -> GapSpec) -> GapMessage
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Direction2D -> GapSpec -> GapSpec
continuation Int -> Int
f Direction2D
d
setGaps :: GapSpec -> GapMessage
setGaps :: GapSpec -> GapMessage
setGaps = (GapSpec -> GapSpec) -> GapMessage
ModifyGaps ((GapSpec -> GapSpec) -> GapMessage)
-> (GapSpec -> GapSpec -> GapSpec) -> GapSpec -> GapMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GapSpec -> GapSpec -> GapSpec
forall a b. a -> b -> a
const
setGap :: Int -> Direction2D -> GapMessage
setGap :: Int -> Direction2D -> GapMessage
setGap = (Int -> Int) -> Direction2D -> GapMessage
modifyGap ((Int -> Int) -> Direction2D -> GapMessage)
-> (Int -> Int -> Int) -> Int -> Direction2D -> GapMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a b. a -> b -> a
const
limit :: GapSpec -> GapSpec
limit :: GapSpec -> GapSpec
limit = (Direction2D -> Int -> Int) -> GapSpec -> GapSpec
weakToStrong ((Direction2D -> Int -> Int) -> GapSpec -> GapSpec)
-> (Direction2D -> Int -> Int) -> GapSpec -> GapSpec
forall a b. (a -> b) -> a -> b
$ \Direction2D
_ -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0
weakToStrong :: (Direction2D -> Int -> Int) -> GapSpec -> GapSpec
weakToStrong :: (Direction2D -> Int -> Int) -> GapSpec -> GapSpec
weakToStrong Direction2D -> Int -> Int
f GapSpec
gs = [Direction2D] -> [Int] -> GapSpec
forall a b. [a] -> [b] -> [(a, b)]
zip (((Direction2D, Int) -> Direction2D) -> GapSpec -> [Direction2D]
forall a b. (a -> b) -> [a] -> [b]
map (Direction2D, Int) -> Direction2D
forall a b. (a, b) -> a
fst GapSpec
gs) (((Direction2D, Int) -> Int) -> GapSpec -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Direction2D -> Int -> Int) -> (Direction2D, Int) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Direction2D -> Int -> Int
f) GapSpec
gs)
continuation :: (Int -> Int) -> Direction2D -> GapSpec -> GapSpec
continuation :: (Int -> Int) -> Direction2D -> GapSpec -> GapSpec
continuation Int -> Int
f Direction2D
d1 = (Direction2D -> Int -> Int) -> GapSpec -> GapSpec
weakToStrong Direction2D -> Int -> Int
h
where h :: Direction2D -> Int -> Int
h Direction2D
d2 | Direction2D
d2 Direction2D -> Direction2D -> Bool
forall a. Eq a => a -> a -> Bool
== Direction2D
d1 = Int -> Int
f
| Bool
otherwise = Int -> Int
forall a. a -> a
id
applyGaps :: Gaps a -> Rectangle -> Rectangle
applyGaps :: Gaps a -> Rectangle -> Rectangle
applyGaps Gaps a
gs Rectangle
r = ((Direction2D, Int) -> Rectangle -> Rectangle)
-> Rectangle -> GapSpec -> Rectangle
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Direction2D, Int) -> Rectangle -> Rectangle
forall a. Integral a => (Direction2D, a) -> Rectangle -> Rectangle
applyGap Rectangle
r (Gaps a -> GapSpec
forall a. Gaps a -> GapSpec
activeGaps Gaps a
gs)
where
applyGap :: (Direction2D, a) -> Rectangle -> Rectangle
applyGap (Direction2D
U,a
z) (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ a -> Position
forall a b. (Integral a, Num b) => a -> b
fi a
z) Dimension
w (Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- a -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi a
z)
applyGap (Direction2D
D,a
z) (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w (Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- a -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi a
z)
applyGap (Direction2D
L,a
z) (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ a -> Position
forall a b. (Integral a, Num b) => a -> b
fi a
z) Position
y (Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- a -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi a
z) Dimension
h
applyGap (Direction2D
R,a
z) (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
- a -> Dimension
forall a b. (Integral a, Num b) => a -> b
fi a
z) Dimension
h
activeGaps :: Gaps a -> GapSpec
activeGaps :: Gaps a -> GapSpec
activeGaps (Gaps GapSpec
conf [Direction2D]
cur) = ((Direction2D, Int) -> Bool) -> GapSpec -> GapSpec
forall a. (a -> Bool) -> [a] -> [a]
filter ((Direction2D -> [Direction2D] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Direction2D]
cur) (Direction2D -> Bool)
-> ((Direction2D, Int) -> Direction2D)
-> (Direction2D, Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Direction2D, Int) -> Direction2D
forall a b. (a, b) -> a
fst) GapSpec
conf
toggleGaps :: GapSpec -> [Direction2D] -> [Direction2D]
toggleGaps :: GapSpec -> [Direction2D] -> [Direction2D]
toggleGaps GapSpec
conf [] = ((Direction2D, Int) -> Direction2D) -> GapSpec -> [Direction2D]
forall a b. (a -> b) -> [a] -> [b]
map (Direction2D, Int) -> Direction2D
forall a b. (a, b) -> a
fst GapSpec
conf
toggleGaps GapSpec
_ [Direction2D]
_ = []
toggleGap :: GapSpec -> [Direction2D] -> Direction2D -> [Direction2D]
toggleGap :: GapSpec -> [Direction2D] -> Direction2D -> [Direction2D]
toggleGap GapSpec
conf [Direction2D]
cur Direction2D
d | Direction2D
d Direction2D -> [Direction2D] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Direction2D]
cur = Direction2D -> [Direction2D] -> [Direction2D]
forall a. Eq a => a -> [a] -> [a]
delete Direction2D
d [Direction2D]
cur
| Direction2D
d Direction2D -> [Direction2D] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Direction2D, Int) -> Direction2D) -> GapSpec -> [Direction2D]
forall a b. (a -> b) -> [a] -> [b]
map (Direction2D, Int) -> Direction2D
forall a b. (a, b) -> a
fst GapSpec
conf = Direction2D
dDirection2D -> [Direction2D] -> [Direction2D]
forall a. a -> [a] -> [a]
:[Direction2D]
cur
| Bool
otherwise = [Direction2D]
cur
gaps :: GapSpec
-> l a
-> ModifiedLayout Gaps l a
gaps :: GapSpec -> l a -> ModifiedLayout Gaps l a
gaps GapSpec
g = Gaps a -> l a -> ModifiedLayout Gaps l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (GapSpec -> [Direction2D] -> Gaps a
forall a. GapSpec -> [Direction2D] -> Gaps a
Gaps GapSpec
g (((Direction2D, Int) -> Direction2D) -> GapSpec -> [Direction2D]
forall a b. (a -> b) -> [a] -> [b]
map (Direction2D, Int) -> Direction2D
forall a b. (a, b) -> a
fst GapSpec
g))
gaps' :: [((Direction2D,Int),Bool)]
-> l a
-> ModifiedLayout Gaps l a
gaps' :: [((Direction2D, Int), Bool)] -> l a -> ModifiedLayout Gaps l a
gaps' [((Direction2D, Int), Bool)]
g = Gaps a -> l a -> ModifiedLayout Gaps l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (GapSpec -> [Direction2D] -> Gaps a
forall a. GapSpec -> [Direction2D] -> Gaps a
Gaps ((((Direction2D, Int), Bool) -> (Direction2D, Int))
-> [((Direction2D, Int), Bool)] -> GapSpec
forall a b. (a -> b) -> [a] -> [b]
map ((Direction2D, Int), Bool) -> (Direction2D, Int)
forall a b. (a, b) -> a
fst [((Direction2D, Int), Bool)]
g) [Direction2D
d | ((Direction2D
d,Int
_),Bool
v) <- [((Direction2D, Int), Bool)]
g, Bool
v])