{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, PatternGuards #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Master
-- Description :  Layout modfier that adds a master window to another layout.
-- Copyright   :  (c) Ismael Carnales, Lukas Mai
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Ismael Carnales <icarnales@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Layout modfier that adds a master window to another layout.
-----------------------------------------------------------------------------

module XMonad.Layout.Master (
    -- * Usage
    -- $usage

    mastered,
    fixMastered,
    multimastered,
    AddMaster,
) where

import XMonad
import qualified XMonad.StackSet as S
import XMonad.Layout.LayoutModifier

import Control.Arrow (first)

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.Master
--
-- Then edit your @layoutHook@ and add the Master modifier to the layout that
-- you prefer.
--
-- > mastered (1/100) (1/2) $ Grid
--
-- Or if you prefer to have a master with fixed width:
--
-- > fixMastered (1/100) (1/2) $ Grid
--
-- Or if you want multiple (here two) master windows from the beginning:
--
-- > multimastered 2 (1/100) (1/2) $ Grid
--
-- This will use the left half of your screen for a master window and let
-- Grid manage the right half.
--
-- For more detailed instructions on editing the layoutHook see
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
--
-- Like 'XMonad.Layout.Tall', 'withMaster' supports the
-- 'XMonad.Layout.Shrink' and XMonad.Layout.Expand' messages.

-- | Data type for LayoutModifier which converts given layout to a mastered
-- layout
data AddMaster a = AddMaster Int Rational Rational deriving (Int -> AddMaster a -> ShowS
[AddMaster a] -> ShowS
AddMaster a -> String
(Int -> AddMaster a -> ShowS)
-> (AddMaster a -> String)
-> ([AddMaster a] -> ShowS)
-> Show (AddMaster a)
forall a. Int -> AddMaster a -> ShowS
forall a. [AddMaster a] -> ShowS
forall a. AddMaster a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddMaster a] -> ShowS
$cshowList :: forall a. [AddMaster a] -> ShowS
show :: AddMaster a -> String
$cshow :: forall a. AddMaster a -> String
showsPrec :: Int -> AddMaster a -> ShowS
$cshowsPrec :: forall a. Int -> AddMaster a -> ShowS
Show, ReadPrec [AddMaster a]
ReadPrec (AddMaster a)
Int -> ReadS (AddMaster a)
ReadS [AddMaster a]
(Int -> ReadS (AddMaster a))
-> ReadS [AddMaster a]
-> ReadPrec (AddMaster a)
-> ReadPrec [AddMaster a]
-> Read (AddMaster a)
forall a. ReadPrec [AddMaster a]
forall a. ReadPrec (AddMaster a)
forall a. Int -> ReadS (AddMaster a)
forall a. ReadS [AddMaster a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddMaster a]
$creadListPrec :: forall a. ReadPrec [AddMaster a]
readPrec :: ReadPrec (AddMaster a)
$creadPrec :: forall a. ReadPrec (AddMaster a)
readList :: ReadS [AddMaster a]
$creadList :: forall a. ReadS [AddMaster a]
readsPrec :: Int -> ReadS (AddMaster a)
$creadsPrec :: forall a. Int -> ReadS (AddMaster a)
Read)

multimastered :: (LayoutClass l a) =>
       Int -- ^ @k@, number of master windows
    -> Rational -- ^ @delta@, the ratio of the screen to resize by
    -> Rational -- ^ @frac@, what portion of the screen to use for the master window
    -> l a      -- ^ the layout to be modified
    -> ModifiedLayout AddMaster l a
multimastered :: forall (l :: * -> *) a.
LayoutClass l a =>
Int -> Rational -> Rational -> l a -> ModifiedLayout AddMaster l a
multimastered Int
k Rational
delta Rational
frac = AddMaster a -> l a -> ModifiedLayout AddMaster l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (AddMaster a -> l a -> ModifiedLayout AddMaster l a)
-> AddMaster a -> l a -> ModifiedLayout AddMaster l a
forall a b. (a -> b) -> a -> b
$ Int -> Rational -> Rational -> AddMaster a
forall a. Int -> Rational -> Rational -> AddMaster a
AddMaster Int
k Rational
delta Rational
frac

mastered :: (LayoutClass l a) =>
       Rational -- ^ @delta@, the ratio of the screen to resize by
    -> Rational -- ^ @frac@, what portion of the screen to use for the master window
    -> l a      -- ^ the layout to be modified
    -> ModifiedLayout AddMaster l a
mastered :: forall (l :: * -> *) a.
LayoutClass l a =>
Rational -> Rational -> l a -> ModifiedLayout AddMaster l a
mastered = Int -> Rational -> Rational -> l a -> ModifiedLayout AddMaster l a
forall (l :: * -> *) a.
LayoutClass l a =>
Int -> Rational -> Rational -> l a -> ModifiedLayout AddMaster l a
multimastered Int
1

instance LayoutModifier AddMaster Window where
    modifyLayout :: forall (l :: * -> *).
LayoutClass l Window =>
AddMaster Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout (AddMaster Int
k Rational
delta Rational
frac) = Bool
-> Int
-> Rational
-> Rational
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
forall (l :: * -> *).
LayoutClass l Window =>
Bool
-> Int
-> Rational
-> Rational
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
applyMaster Bool
False Int
k Rational
delta Rational
frac
    modifierDescription :: AddMaster Window -> String
modifierDescription AddMaster Window
_               = String
"Mastered"

    pureMess :: AddMaster Window -> SomeMessage -> Maybe (AddMaster Window)
pureMess (AddMaster Int
k Rational
delta Rational
frac) SomeMessage
m
        | Just Resize
Shrink <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = AddMaster Window -> Maybe (AddMaster Window)
forall a. a -> Maybe a
Just (AddMaster Window -> Maybe (AddMaster Window))
-> AddMaster Window -> Maybe (AddMaster Window)
forall a b. (a -> b) -> a -> b
$ Int -> Rational -> Rational -> AddMaster Window
forall a. Int -> Rational -> Rational -> AddMaster a
AddMaster Int
k Rational
delta (Rational
fracRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
delta)
        | Just Resize
Expand <- SomeMessage -> Maybe Resize
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = AddMaster Window -> Maybe (AddMaster Window)
forall a. a -> Maybe a
Just (AddMaster Window -> Maybe (AddMaster Window))
-> AddMaster Window -> Maybe (AddMaster Window)
forall a b. (a -> b) -> a -> b
$ Int -> Rational -> Rational -> AddMaster Window
forall a. Int -> Rational -> Rational -> AddMaster a
AddMaster Int
k Rational
delta (Rational
fracRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
delta)
        | Just (IncMasterN Int
d) <- SomeMessage -> Maybe IncMasterN
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = AddMaster Window -> Maybe (AddMaster Window)
forall a. a -> Maybe a
Just (AddMaster Window -> Maybe (AddMaster Window))
-> AddMaster Window -> Maybe (AddMaster Window)
forall a b. (a -> b) -> a -> b
$ Int -> Rational -> Rational -> AddMaster Window
forall a. Int -> Rational -> Rational -> AddMaster a
AddMaster (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d)) Rational
delta Rational
frac

    pureMess AddMaster Window
_ SomeMessage
_ = Maybe (AddMaster Window)
forall a. Maybe a
Nothing

newtype FixMaster a = FixMaster (AddMaster a) deriving (Int -> FixMaster a -> ShowS
[FixMaster a] -> ShowS
FixMaster a -> String
(Int -> FixMaster a -> ShowS)
-> (FixMaster a -> String)
-> ([FixMaster a] -> ShowS)
-> Show (FixMaster a)
forall a. Int -> FixMaster a -> ShowS
forall a. [FixMaster a] -> ShowS
forall a. FixMaster a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixMaster a] -> ShowS
$cshowList :: forall a. [FixMaster a] -> ShowS
show :: FixMaster a -> String
$cshow :: forall a. FixMaster a -> String
showsPrec :: Int -> FixMaster a -> ShowS
$cshowsPrec :: forall a. Int -> FixMaster a -> ShowS
Show, ReadPrec [FixMaster a]
ReadPrec (FixMaster a)
Int -> ReadS (FixMaster a)
ReadS [FixMaster a]
(Int -> ReadS (FixMaster a))
-> ReadS [FixMaster a]
-> ReadPrec (FixMaster a)
-> ReadPrec [FixMaster a]
-> Read (FixMaster a)
forall a. ReadPrec [FixMaster a]
forall a. ReadPrec (FixMaster a)
forall a. Int -> ReadS (FixMaster a)
forall a. ReadS [FixMaster a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FixMaster a]
$creadListPrec :: forall a. ReadPrec [FixMaster a]
readPrec :: ReadPrec (FixMaster a)
$creadPrec :: forall a. ReadPrec (FixMaster a)
readList :: ReadS [FixMaster a]
$creadList :: forall a. ReadS [FixMaster a]
readsPrec :: Int -> ReadS (FixMaster a)
$creadsPrec :: forall a. Int -> ReadS (FixMaster a)
Read)

instance LayoutModifier FixMaster Window where
    modifyLayout :: forall (l :: * -> *).
LayoutClass l Window =>
FixMaster Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout (FixMaster (AddMaster Int
k Rational
d Rational
f)) = Bool
-> Int
-> Rational
-> Rational
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
forall (l :: * -> *).
LayoutClass l Window =>
Bool
-> Int
-> Rational
-> Rational
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
applyMaster Bool
True Int
k Rational
d Rational
f
    modifierDescription :: FixMaster Window -> String
modifierDescription (FixMaster AddMaster Window
a) = String
"Fix" String -> ShowS
forall a. [a] -> [a] -> [a]
++ AddMaster Window -> String
forall (m :: * -> *) a. LayoutModifier m a => m a -> String
modifierDescription AddMaster Window
a
    pureMess :: FixMaster Window -> SomeMessage -> Maybe (FixMaster Window)
pureMess (FixMaster AddMaster Window
a) SomeMessage
m = (AddMaster Window -> FixMaster Window)
-> Maybe (AddMaster Window) -> Maybe (FixMaster Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AddMaster Window -> FixMaster Window
forall a. AddMaster a -> FixMaster a
FixMaster (AddMaster Window -> SomeMessage -> Maybe (AddMaster Window)
forall (m :: * -> *) a.
LayoutModifier m a =>
m a -> SomeMessage -> Maybe (m a)
pureMess AddMaster Window
a SomeMessage
m)

fixMastered :: (LayoutClass l a) =>
       Rational -- ^ @delta@, the ratio of the screen to resize by
    -> Rational -- ^ @frac@, what portion of the screen to use for the master window
    -> l a      -- ^ the layout to be modified
    -> ModifiedLayout FixMaster l a
fixMastered :: forall (l :: * -> *) a.
LayoutClass l a =>
Rational -> Rational -> l a -> ModifiedLayout FixMaster l a
fixMastered Rational
delta Rational
frac = FixMaster a -> l a -> ModifiedLayout FixMaster l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (FixMaster a -> l a -> ModifiedLayout FixMaster l a)
-> (AddMaster a -> FixMaster a)
-> AddMaster a
-> l a
-> ModifiedLayout FixMaster l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddMaster a -> FixMaster a
forall a. AddMaster a -> FixMaster a
FixMaster (AddMaster a -> l a -> ModifiedLayout FixMaster l a)
-> AddMaster a -> l a -> ModifiedLayout FixMaster l a
forall a b. (a -> b) -> a -> b
$ Int -> Rational -> Rational -> AddMaster a
forall a. Int -> Rational -> Rational -> AddMaster a
AddMaster Int
1 Rational
delta Rational
frac

-- | Internal function for adding a master window and let the modified
-- layout handle the rest of the windows
applyMaster :: (LayoutClass l Window) =>
                  Bool
               -> Int
               -> Rational
               -> Rational
               -> S.Workspace WorkspaceId (l Window) Window
               -> Rectangle
               -> X ([(Window, Rectangle)], Maybe (l Window))
applyMaster :: forall (l :: * -> *).
LayoutClass l Window =>
Bool
-> Int
-> Rational
-> Rational
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
applyMaster Bool
f Int
k Rational
_ Rational
frac Workspace String (l Window) Window
wksp Rectangle
rect = do
    let st :: Maybe (Stack Window)
st= Workspace String (l Window) Window -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack Workspace String (l Window) Window
wksp
    let ws :: [Window]
ws = Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
S.integrate' Maybe (Stack Window)
st
    let n :: Int
n = [Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Window]
ws Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
f
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then
        if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
k then
             ([(Window, Rectangle)], Maybe (l Window))
-> X ([(Window, Rectangle)], Maybe (l Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Rectangle -> [Window] -> [(Window, Rectangle)]
forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideCol Rectangle
rect [Window]
ws, Maybe (l Window)
forall a. Maybe a
Nothing)
             else do
             let m :: [Window]
m = Int -> [Window] -> [Window]
forall a. Int -> [a] -> [a]
take Int
k [Window]
ws
             let (Rectangle
mr, Rectangle
sr) = Rational -> Rectangle -> (Rectangle, Rectangle)
forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
frac Rectangle
rect
             let nst :: Maybe (Stack Window)
nst = Maybe (Stack Window)
stMaybe (Stack Window)
-> (Stack Window -> Maybe (Stack Window)) -> Maybe (Stack Window)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Window -> Bool) -> Stack Window -> Maybe (Stack Window)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
S.filter (Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
m)
             ([(Window, Rectangle)], Maybe (l Window))
wrs <- Workspace String (l Window) Window
-> Rectangle -> X ([(Window, Rectangle)], 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
wksp {stack :: Maybe (Stack Window)
S.stack = Maybe (Stack Window)
nst}) Rectangle
sr
             ([(Window, Rectangle)], Maybe (l Window))
-> X ([(Window, Rectangle)], Maybe (l Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (([(Window, Rectangle)] -> [(Window, Rectangle)])
-> ([(Window, Rectangle)], Maybe (l Window))
-> ([(Window, Rectangle)], Maybe (l Window))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Rectangle -> [Window] -> [(Window, Rectangle)]
forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideCol Rectangle
mr [Window]
m [(Window, Rectangle)]
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. [a] -> [a] -> [a]
++) ([(Window, Rectangle)], Maybe (l Window))
wrs)
        else Workspace String (l Window) Window
-> Rectangle -> X ([(Window, Rectangle)], 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
wksp Rectangle
rect

-- | Shift rectangle down
shiftD :: Position -> Rectangle -> Rectangle
shiftD :: Position -> Rectangle -> Rectangle
shiftD Position
s (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x (Position
yPosition -> Position -> Position
forall a. Num a => a -> a -> a
+Position
s) Dimension
w Dimension
h

-- | Divide rectangle between windows
divideCol :: Rectangle -> [a] -> [(a, Rectangle)]
divideCol :: forall a. Rectangle -> [a] -> [(a, Rectangle)]
divideCol (Rectangle Position
x Position
y Dimension
w Dimension
h) [a]
ws = [a] -> [Rectangle] -> [(a, Rectangle)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
ws [Rectangle]
rects
    where n :: Int
n = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ws
          oneH :: Int
oneH = Dimension -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n
          oneRect :: Rectangle
oneRect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y Dimension
w (Int -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oneH)
          rects :: [Rectangle]
rects = Int -> [Rectangle] -> [Rectangle]
forall a. Int -> [a] -> [a]
take Int
n ([Rectangle] -> [Rectangle]) -> [Rectangle] -> [Rectangle]
forall a b. (a -> b) -> a -> b
$ (Rectangle -> Rectangle) -> Rectangle -> [Rectangle]
forall a. (a -> a) -> a -> [a]
iterate (Position -> Rectangle -> Rectangle
shiftD (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
oneH)) Rectangle
oneRect