{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.StackTile
-- Description :  Like "XMonad.Layout.Dishes" but with the ability to resize the master pane.
-- Copyright   :  (c) Rickard Gustafsson <acura@allyourbase.se>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Rickard Gustafsson <acura@allyourbase.se>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A stacking layout, like dishes but with the ability to resize master pane.
-- Mostly useful on small screens.
--
-----------------------------------------------------------------------------

module XMonad.Layout.StackTile (
                                    -- * Usage
                                    -- $usage
                                    StackTile(..)
                                   ) where

import XMonad hiding (tile)
import qualified XMonad.StackSet as W
import XMonad.Prelude

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.StackTile
--
-- Then edit your @layoutHook@ by adding the StackTile layout:
--
-- > myLayout =  StackTile 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"
--
data StackTile a = StackTile !Int !Rational !Rational deriving (Int -> StackTile a -> ShowS
[StackTile a] -> ShowS
StackTile a -> String
(Int -> StackTile a -> ShowS)
-> (StackTile a -> String)
-> ([StackTile a] -> ShowS)
-> Show (StackTile a)
forall a. Int -> StackTile a -> ShowS
forall a. [StackTile a] -> ShowS
forall a. StackTile a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackTile a] -> ShowS
$cshowList :: forall a. [StackTile a] -> ShowS
show :: StackTile a -> String
$cshow :: forall a. StackTile a -> String
showsPrec :: Int -> StackTile a -> ShowS
$cshowsPrec :: forall a. Int -> StackTile a -> ShowS
Show, ReadPrec [StackTile a]
ReadPrec (StackTile a)
Int -> ReadS (StackTile a)
ReadS [StackTile a]
(Int -> ReadS (StackTile a))
-> ReadS [StackTile a]
-> ReadPrec (StackTile a)
-> ReadPrec [StackTile a]
-> Read (StackTile a)
forall a. ReadPrec [StackTile a]
forall a. ReadPrec (StackTile a)
forall a. Int -> ReadS (StackTile a)
forall a. ReadS [StackTile a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StackTile a]
$creadListPrec :: forall a. ReadPrec [StackTile a]
readPrec :: ReadPrec (StackTile a)
$creadPrec :: forall a. ReadPrec (StackTile a)
readList :: ReadS [StackTile a]
$creadList :: forall a. ReadS [StackTile a]
readsPrec :: Int -> ReadS (StackTile a)
$creadsPrec :: forall a. Int -> ReadS (StackTile a)
Read)

instance LayoutClass StackTile a where
    pureLayout :: StackTile a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout (StackTile Int
nmaster Rational
_ Rational
frac) Rectangle
r Stack a
s = [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rs
      where ws :: [a]
ws = Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
s
            rs :: [Rectangle]
rs = Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile Rational
frac Rectangle
r Int
nmaster ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws)

    pureMessage :: StackTile a -> SomeMessage -> Maybe (StackTile a)
pureMessage (StackTile Int
nmaster Rational
delta Rational
frac) SomeMessage
m =
            [Maybe (StackTile a)] -> Maybe (StackTile a)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(Resize -> StackTile a) -> Maybe Resize -> Maybe (StackTile a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Resize -> StackTile a
forall {a}. Resize -> StackTile a
resize     (SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)
                 ,(IncMasterN -> StackTile a)
-> Maybe IncMasterN -> Maybe (StackTile a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IncMasterN -> StackTile a
forall {a}. IncMasterN -> StackTile a
incmastern (SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)]

      where resize :: Resize -> StackTile a
resize Resize
Shrink             = Int -> Rational -> Rational -> StackTile a
forall a. Int -> Rational -> Rational -> StackTile a
StackTile 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)
            resize Resize
Expand             = Int -> Rational -> Rational -> StackTile a
forall a. Int -> Rational -> Rational -> StackTile a
StackTile 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)
            incmastern :: IncMasterN -> StackTile a
incmastern (IncMasterN Int
d) = Int -> Rational -> Rational -> StackTile a
forall a. Int -> Rational -> Rational -> StackTile a
StackTile (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

    description :: StackTile a -> String
description StackTile a
_ = String
"StackTile"

tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
tile Rational
f 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 Int -> Rectangle -> [Rectangle]
splitHorizontally Int
n Rectangle
r
    else Int -> Rectangle -> [Rectangle]
splitHorizontally Int
nmaster Rectangle
r1 [Rectangle] -> [Rectangle] -> [Rectangle]
forall a. [a] -> [a] -> [a]
++ Int -> Rectangle -> [Rectangle]
splitVertically (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)
splitVerticallyBy Rational
f Rectangle
r