{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.ResizableTile
-- Description :  More useful tiled layout that allows you to change a width\/height of window.
-- Copyright   :  (c) MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- More useful tiled layout that allows you to change a width\/height of window.
--
-----------------------------------------------------------------------------

module XMonad.Layout.ResizableTile (
                                    -- * Usage
                                    -- $usage
                                    ResizableTall(..), MirrorResize(..)
                                   ) where

import XMonad hiding (tile, splitVertically, splitHorizontallyBy)
import XMonad.Prelude
import qualified XMonad.StackSet as W
import qualified Data.Map as M

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.ResizableTile
--
-- Then edit your @layoutHook@ by adding the ResizableTile layout:
--
-- > myLayout =  ResizableTall 1 (3/100) (1/2) [] ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
--
-- You may also want to add the following key bindings:
--
-- > , ((modm,               xK_a), sendMessage MirrorShrink)
-- > , ((modm,               xK_z), sendMessage MirrorExpand)
--
-- For detailed instruction on editing the key binding see:
--
-- "XMonad.Doc.Extending#Editing_key_bindings".

data MirrorResize = MirrorShrink | MirrorExpand
instance Message MirrorResize

data ResizableTall a = ResizableTall
    { ResizableTall a -> Int
_nmaster :: Int       -- ^ number of master windows
    , ResizableTall a -> Rational
_delta  :: Rational   -- ^ change when resizing by 'Shrink', 'Expand',
                            -- 'MirrorShrink', 'MirrorExpand'
    , ResizableTall a -> Rational
_frac   :: Rational   -- ^ width of master
    , ResizableTall a -> [Rational]
_slaves :: [Rational] -- ^ fraction to multiply the window
                            -- height that would be given when divided equally.
                            --
                            -- slave windows are assigned their modified
                            -- heights in order, from top to bottom
                            --
                            -- unspecified values are replaced by 1
    } deriving (Int -> ResizableTall a -> ShowS
[ResizableTall a] -> ShowS
ResizableTall a -> String
(Int -> ResizableTall a -> ShowS)
-> (ResizableTall a -> String)
-> ([ResizableTall a] -> ShowS)
-> Show (ResizableTall a)
forall a. Int -> ResizableTall a -> ShowS
forall a. [ResizableTall a] -> ShowS
forall a. ResizableTall a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResizableTall a] -> ShowS
$cshowList :: forall a. [ResizableTall a] -> ShowS
show :: ResizableTall a -> String
$cshow :: forall a. ResizableTall a -> String
showsPrec :: Int -> ResizableTall a -> ShowS
$cshowsPrec :: forall a. Int -> ResizableTall a -> ShowS
Show, ReadPrec [ResizableTall a]
ReadPrec (ResizableTall a)
Int -> ReadS (ResizableTall a)
ReadS [ResizableTall a]
(Int -> ReadS (ResizableTall a))
-> ReadS [ResizableTall a]
-> ReadPrec (ResizableTall a)
-> ReadPrec [ResizableTall a]
-> Read (ResizableTall a)
forall a. ReadPrec [ResizableTall a]
forall a. ReadPrec (ResizableTall a)
forall a. Int -> ReadS (ResizableTall a)
forall a. ReadS [ResizableTall a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResizableTall a]
$creadListPrec :: forall a. ReadPrec [ResizableTall a]
readPrec :: ReadPrec (ResizableTall a)
$creadPrec :: forall a. ReadPrec (ResizableTall a)
readList :: ReadS [ResizableTall a]
$creadList :: forall a. ReadS [ResizableTall a]
readsPrec :: Int -> ReadS (ResizableTall a)
$creadsPrec :: forall a. Int -> ReadS (ResizableTall a)
Read)

instance LayoutClass ResizableTall a where
    doLayout :: ResizableTall a
-> Rectangle
-> Stack a
-> X ([(a, Rectangle)], Maybe (ResizableTall a))
doLayout (ResizableTall Int
nmaster Rational
_ Rational
frac [Rational]
mfrac) Rectangle
r =
        ([(a, Rectangle)], Maybe (ResizableTall a))
-> X ([(a, Rectangle)], Maybe (ResizableTall a))
forall (m :: * -> *) a. Monad m => a -> m a
return (([(a, Rectangle)], Maybe (ResizableTall a))
 -> X ([(a, Rectangle)], Maybe (ResizableTall a)))
-> (Stack a -> ([(a, Rectangle)], Maybe (ResizableTall a)))
-> Stack a
-> X ([(a, Rectangle)], Maybe (ResizableTall a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, Maybe (ResizableTall a)
forall a. Maybe a
Nothing) ([(a, Rectangle)] -> ([(a, Rectangle)], Maybe (ResizableTall a)))
-> (Stack a -> [(a, Rectangle)])
-> Stack a
-> ([(a, Rectangle)], Maybe (ResizableTall a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        ([a] -> [Rectangle] -> [(a, Rectangle)])
-> ([a] -> [Rectangle]) -> [a] -> [(a, Rectangle)]
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
tile Rational
frac ([Rational]
mfrac [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ Rational -> [Rational]
forall a. a -> [a]
repeat Rational
1) Rectangle
r Int
nmaster (Int -> [Rectangle]) -> ([a] -> Int) -> [a] -> [Rectangle]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([a] -> [(a, Rectangle)])
-> (Stack a -> [a]) -> Stack a -> [(a, Rectangle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> [a]
forall a. Stack a -> [a]
W.integrate
    handleMessage :: ResizableTall a -> SomeMessage -> X (Maybe (ResizableTall a))
handleMessage (ResizableTall Int
nmaster Rational
delta Rational
frac [Rational]
mfrac) SomeMessage
m =
        do Maybe (Stack Window)
ms <- Workspace String (Layout Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace String (Layout Window) Window -> Maybe (Stack Window))
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
 -> Workspace String (Layout Window) Window)
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> Maybe (Stack Window))
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X (Maybe (Stack Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
           [Window]
fs <- Map Window RationalRect -> [Window]
forall k a. Map k a -> [k]
M.keys (Map Window RationalRect -> [Window])
-> (StackSet String (Layout Window) Window ScreenId ScreenDetail
    -> Map Window RationalRect)
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet String (Layout Window) Window ScreenId ScreenDetail
-> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating (StackSet String (Layout Window) Window ScreenId ScreenDetail
 -> [Window])
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X [Window]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XState
 -> StackSet String (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet String (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
           Maybe (ResizableTall a) -> X (Maybe (ResizableTall a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ResizableTall a) -> X (Maybe (ResizableTall a)))
-> Maybe (ResizableTall a) -> X (Maybe (ResizableTall a))
forall a b. (a -> b) -> a -> b
$ Maybe (Stack Window)
ms Maybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window)) -> Maybe (Stack Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Window] -> Stack Window -> Maybe (Stack Window)
forall a. Eq a => [a] -> Stack a -> Maybe (Stack a)
unfloat [Window]
fs Maybe (Stack Window)
-> (Stack Window -> Maybe (ResizableTall a))
-> Maybe (ResizableTall a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stack Window -> Maybe (ResizableTall a)
forall a a. Stack a -> Maybe (ResizableTall a)
handleMesg
        where handleMesg :: Stack a -> Maybe (ResizableTall a)
handleMesg Stack a
s = [Maybe (ResizableTall a)] -> Maybe (ResizableTall a)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(Resize -> ResizableTall a)
-> Maybe Resize -> Maybe (ResizableTall a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> ResizableTall a
forall a. Resize -> ResizableTall a
resize (SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                                  ,(MirrorResize -> ResizableTall a)
-> Maybe MirrorResize -> Maybe (ResizableTall a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MirrorResize -> Stack a -> ResizableTall a
forall a a. MirrorResize -> Stack a -> ResizableTall a
`mresize` Stack a
s) (SomeMessage -> Maybe MirrorResize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                                  ,(IncMasterN -> ResizableTall a)
-> Maybe IncMasterN -> Maybe (ResizableTall a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IncMasterN -> ResizableTall a
forall a. IncMasterN -> ResizableTall a
incmastern (SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)]
              unfloat :: [a] -> Stack a -> Maybe (Stack a)
unfloat [a]
fs Stack a
s = if Stack a -> a
forall a. Stack a -> a
W.focus Stack a
s a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
fs
                               then Maybe (Stack a)
forall a. Maybe a
Nothing
                               else Stack a -> Maybe (Stack a)
forall a. a -> Maybe a
Just (Stack a
s { up :: [a]
W.up = Stack a -> [a]
forall a. Stack a -> [a]
W.up Stack a
s [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
fs
                                            , down :: [a]
W.down = Stack a -> [a]
forall a. Stack a -> [a]
W.down Stack a
s [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
fs })
              resize :: Resize -> ResizableTall a
resize Resize
Shrink = Int -> Rational -> Rational -> [Rational] -> ResizableTall a
forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall Int
nmaster Rational
delta (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
0 (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
fracRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
delta) [Rational]
mfrac
              resize Resize
Expand = Int -> Rational -> Rational -> [Rational] -> ResizableTall a
forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall Int
nmaster Rational
delta (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
fracRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
delta) [Rational]
mfrac
              mresize :: MirrorResize -> Stack a -> ResizableTall a
mresize MirrorResize
MirrorShrink Stack a
s = Stack a -> Rational -> ResizableTall a
forall a a. Stack a -> Rational -> ResizableTall a
mresize' Stack a
s Rational
delta
              mresize MirrorResize
MirrorExpand Stack a
s = Stack a -> Rational -> ResizableTall a
forall a a. Stack a -> Rational -> ResizableTall a
mresize' Stack a
s (Rational -> Rational
forall a. Num a => a -> a
negate Rational
delta)
              mresize' :: Stack a -> Rational -> ResizableTall a
mresize' Stack a
s Rational
d = let n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> [a] -> Int
forall a b. (a -> b) -> a -> b
$ Stack a -> [a]
forall a. Stack a -> [a]
W.up Stack a
s
                                 total :: Int
total = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Stack a -> [a]
forall a. Stack a -> [a]
W.down Stack a
s) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                                 pos :: Int
pos = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
nmasterInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
totalInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) then Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 else Int
n
                                 mfrac' :: [Rational]
mfrac' = [Rational] -> Rational -> Int -> [Rational]
forall t t. (Eq t, Num t, Num t) => [t] -> t -> t -> [t]
modifymfrac ([Rational]
mfrac [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ Rational -> [Rational]
forall a. a -> [a]
repeat Rational
1) Rational
d Int
pos
                             in Int -> Rational -> Rational -> [Rational] -> ResizableTall a
forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall Int
nmaster Rational
delta Rational
frac ([Rational] -> ResizableTall a) -> [Rational] -> ResizableTall a
forall a b. (a -> b) -> a -> b
$ Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
take Int
total [Rational]
mfrac'
              modifymfrac :: [t] -> t -> t -> [t]
modifymfrac [] t
_ t
_ = []
              modifymfrac (t
f:[t]
fx) t
d t
n | t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0    = t
ft -> t -> t
forall a. Num a => a -> a -> a
+t
d t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t]
fx
                                     | Bool
otherwise = t
f t -> [t] -> [t]
forall a. a -> [a] -> [a]
: [t] -> t -> t -> [t]
modifymfrac [t]
fx t
d (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)
              incmastern :: IncMasterN -> ResizableTall a
incmastern (IncMasterN Int
d) = Int -> Rational -> Rational -> [Rational] -> ResizableTall a
forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
nmasterInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)) Rational
delta Rational
frac [Rational]
mfrac
    description :: ResizableTall a -> String
description ResizableTall a
_ = String
"ResizableTall"

tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
tile Rational
f [Rational]
mf Rectangle
r Int
nmaster Int
n = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nmaster Bool -> Bool -> Bool
|| Int
nmaster Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    then [Rational] -> Int -> Rectangle -> [Rectangle]
forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [Rational]
mf Int
n Rectangle
r
    else [Rational] -> Int -> Rectangle -> [Rectangle]
forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [Rational]
mf Int
nmaster Rectangle
r1 [Rectangle] -> [Rectangle] -> [Rectangle]
forall a. [a] -> [a] -> [a]
++ [Rational] -> Int -> Rectangle -> [Rectangle]
forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically (Int -> [Rational] -> [Rational]
forall a. Int -> [a] -> [a]
drop Int
nmaster [Rational]
mf) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nmaster) Rectangle
r2 -- two columns
  where (Rectangle
r1,Rectangle
r2) = Rational -> Rectangle -> (Rectangle, Rectangle)
forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
f Rectangle
r

splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically :: [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [] Int
_ Rectangle
r = [Rectangle
r]
splitVertically [r]
_ Int
n Rectangle
r | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = [Rectangle
r]
splitVertically (r
f:[r]
fx) Int
n (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
sw Dimension
smallh Rectangle -> [Rectangle] -> [Rectangle]
forall a. a -> [a] -> [a]
:
    [r] -> Int -> Rectangle -> [Rectangle]
forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [r]
fx (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
syPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
smallh) Dimension
sw (Dimension
shDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-Dimension
smallh))
  where smallh :: Dimension
smallh = Dimension -> Dimension -> Dimension
forall a. Ord a => a -> a -> a
min Dimension
sh (r -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
floor (r -> Dimension) -> r -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> r
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
sh Dimension -> Dimension -> Dimension
forall a. Integral a => a -> a -> a
`div` Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) r -> r -> r
forall a. Num a => a -> a -> a
* r
f) --hmm, this is a fold or map.

splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy :: r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy r
f (Rectangle Position
sx Position
sy Dimension
sw Dimension
sh) =
    ( Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx Position
sy Dimension
leftw Dimension
sh
    , Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Position
sx Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
leftw) Position
sy (Dimension
swDimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
-Dimension -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
leftw) Dimension
sh)
  where leftw :: Dimension
leftw = r -> Dimension
forall a b. (RealFrac a, Integral b) => a -> b
floor (r -> Dimension) -> r -> Dimension
forall a b. (a -> b) -> a -> b
$ Dimension -> r
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw r -> r -> r
forall a. Num a => a -> a -> a
* r
f