{-# 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.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
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "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:
--
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

data MirrorResize = MirrorShrink | MirrorExpand
instance Message MirrorResize

data ResizableTall a = ResizableTall
    { forall a. ResizableTall a -> Int
_nmaster :: Int       -- ^ number of master windows
    , forall a. ResizableTall a -> Rational
_delta  :: Rational   -- ^ change when resizing by 'Shrink', 'Expand',
                            -- 'MirrorShrink', 'MirrorExpand'
    , forall a. ResizableTall a -> Rational
_frac   :: Rational   -- ^ width of master
    , forall a. 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
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)
ReadS [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 =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, forall a. Maybe a
Nothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap forall a b. [a] -> [b] -> [(a, b)]
zip (Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
tile Rational
frac ([Rational]
mfrac forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Rational
1) Rectangle
r Int
nmaster forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <- forall i l a. Workspace i l a -> Maybe (Stack a)
W.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
W.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
W.current forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
           [Window]
fs <- forall k a. Map k a -> [k]
M.keys forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet String (Layout Window) Window ScreenId ScreenDetail
windowset
           forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe (Stack Window)
ms forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. Eq a => [a] -> Stack a -> Maybe (Stack a)
unfloat [Window]
fs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {a}. Stack a -> Maybe (ResizableTall a)
handleMesg
        where handleMesg :: Stack a -> Maybe (ResizableTall a)
handleMesg Stack a
s = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. Resize -> ResizableTall a
resize (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                                  ,forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {a} {a}. MirrorResize -> Stack a -> ResizableTall a
`mresize` Stack a
s) (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                                  ,forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. IncMasterN -> ResizableTall a
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 forall a. Stack a -> a
W.focus Stack a
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
fs
                               then forall a. Maybe a
Nothing
                               else forall a. a -> Maybe a
Just (Stack a
s { up :: [a]
W.up = forall a. Stack a -> [a]
W.up Stack a
s forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
fs
                                            , down :: [a]
W.down = forall a. Stack a -> [a]
W.down Stack a
s forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
fs })
              resize :: Resize -> ResizableTall a
resize Resize
Shrink = forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall Int
nmaster Rational
delta (forall a. Ord a => a -> a -> a
max Rational
0 forall a b. (a -> b) -> a -> b
$ Rational
fracforall a. Num a => a -> a -> a
-Rational
delta) [Rational]
mfrac
              resize Resize
Expand = forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall Int
nmaster Rational
delta (forall a. Ord a => a -> a -> a
min Rational
1 forall a b. (a -> b) -> a -> b
$ Rational
fracforall a. Num a => a -> a -> a
+Rational
delta) [Rational]
mfrac
              mresize :: MirrorResize -> Stack a -> ResizableTall a
mresize MirrorResize
MirrorShrink Stack a
s = forall {a} {a}. Stack a -> Rational -> ResizableTall a
mresize' Stack a
s Rational
delta
              mresize MirrorResize
MirrorExpand Stack a
s = forall {a} {a}. Stack a -> Rational -> ResizableTall a
mresize' Stack a
s (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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> [a]
W.up Stack a
s
                                 total :: Int
total = Int
n forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Stack a -> [a]
W.down Stack a
s) forall a. Num a => a -> a -> a
+ Int
1
                                 pos :: Int
pos = if Int
n forall a. Eq a => a -> a -> Bool
== (Int
nmasterforall a. Num a => a -> a -> a
-Int
1) Bool -> Bool -> Bool
|| Int
n forall a. Eq a => a -> a -> Bool
== (Int
totalforall a. Num a => a -> a -> a
-Int
1) then Int
nforall a. Num a => a -> a -> a
-Int
1 else Int
n
                                 mfrac' :: [Rational]
mfrac' = forall {t} {t}. (Eq t, Num t, Num t) => [t] -> t -> t -> [t]
modifymfrac ([Rational]
mfrac forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Rational
1) Rational
d Int
pos
                             in forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall Int
nmaster Rational
delta Rational
frac forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== t
0    = t
fforall a. Num a => a -> a -> a
+t
d forall a. a -> [a] -> [a]
: [t]
fx
                                     | Bool
otherwise = t
f forall a. a -> [a] -> [a]
: [t] -> t -> t -> [t]
modifymfrac [t]
fx t
d (t
nforall a. Num a => a -> a -> a
-t
1)
              incmastern :: IncMasterN -> ResizableTall a
incmastern (IncMasterN Int
d) = forall a.
Int -> Rational -> Rational -> [Rational] -> ResizableTall a
ResizableTall (forall a. Ord a => a -> a -> a
max Int
0 (Int
nmasterforall 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 forall a. Ord a => a -> a -> Bool
<= Int
nmaster Bool -> Bool -> Bool
|| Int
nmaster forall a. Eq a => a -> a -> Bool
== Int
0
    then forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [Rational]
mf Int
n Rectangle
r
    else forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [Rational]
mf Int
nmaster Rectangle
r1 forall a. [a] -> [a] -> [a]
++ forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically (forall a. Int -> [a] -> [a]
drop Int
nmaster [Rational]
mf) (Int
nforall a. Num a => a -> a -> a
-Int
nmaster) Rectangle
r2 -- two columns
  where (Rectangle
r1,Rectangle
r2) = forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
f Rectangle
r

splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically :: forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [] Int
_ Rectangle
r = [Rectangle
r]
splitVertically [r]
_ Int
n Rectangle
r | Int
n 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 forall a. a -> [a] -> [a]
:
    forall r. RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
splitVertically [r]
fx (Int
nforall a. Num a => a -> a -> a
-Int
1) (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
sx (Position
syforall a. Num a => a -> a -> a
+forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
smallh) Dimension
sw (Dimension
shforall a. Num a => a -> a -> a
-Dimension
smallh))
  where smallh :: Dimension
smallh = forall a. Ord a => a -> a -> a
min Dimension
sh (forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Dimension
sh forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) forall a. Num a => a -> a -> a
* r
f) --hmm, this is a fold or map.

splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy :: forall r. RealFrac r => 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 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
leftw) Position
sy (Dimension
swforall a. Num a => a -> a -> a
-forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
leftw) Dimension
sh)
  where leftw :: Dimension
leftw = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
sw forall a. Num a => a -> a -> a
* r
f