{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
module XMonad.Layout.IM (
Property(..), IM(..), withIM, gridIM,
AddRoster,
) where
import XMonad
import XMonad.Layout.Grid
import XMonad.Layout.LayoutModifier
import XMonad.Prelude
import XMonad.Util.WindowProperties
import qualified XMonad.StackSet as S
import Control.Arrow (first)
data AddRoster a = AddRoster Rational Property deriving (ReadPrec [AddRoster a]
ReadPrec (AddRoster a)
ReadS [AddRoster a]
forall a. ReadPrec [AddRoster a]
forall a. ReadPrec (AddRoster a)
forall a. Int -> ReadS (AddRoster a)
forall a. ReadS [AddRoster a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddRoster a]
$creadListPrec :: forall a. ReadPrec [AddRoster a]
readPrec :: ReadPrec (AddRoster a)
$creadPrec :: forall a. ReadPrec (AddRoster a)
readList :: ReadS [AddRoster a]
$creadList :: forall a. ReadS [AddRoster a]
readsPrec :: Int -> ReadS (AddRoster a)
$creadsPrec :: forall a. Int -> ReadS (AddRoster a)
Read, Int -> AddRoster a -> ShowS
forall a. Int -> AddRoster a -> ShowS
forall a. [AddRoster a] -> ShowS
forall a. AddRoster a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddRoster a] -> ShowS
$cshowList :: forall a. [AddRoster a] -> ShowS
show :: AddRoster a -> String
$cshow :: forall a. AddRoster a -> String
showsPrec :: Int -> AddRoster a -> ShowS
$cshowsPrec :: forall a. Int -> AddRoster a -> ShowS
Show)
instance LayoutModifier AddRoster Window where
modifyLayout :: forall (l :: * -> *).
LayoutClass l Window =>
AddRoster Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout (AddRoster Rational
ratio Property
prop) = forall (l :: * -> *).
LayoutClass l Window =>
Rational
-> Property
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
applyIM Rational
ratio Property
prop
modifierDescription :: AddRoster Window -> String
modifierDescription AddRoster Window
_ = String
"IM"
withIM :: LayoutClass l a => Rational -> Property -> l a -> ModifiedLayout AddRoster l a
withIM :: forall (l :: * -> *) a.
LayoutClass l a =>
Rational -> Property -> l a -> ModifiedLayout AddRoster l a
withIM Rational
ratio Property
prop = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a b. (a -> b) -> a -> b
$ forall a. Rational -> Property -> AddRoster a
AddRoster Rational
ratio Property
prop
gridIM :: Rational -> Property -> ModifiedLayout AddRoster Grid a
gridIM :: forall a. Rational -> Property -> ModifiedLayout AddRoster Grid a
gridIM Rational
ratio Property
prop = forall (l :: * -> *) a.
LayoutClass l a =>
Rational -> Property -> l a -> ModifiedLayout AddRoster l a
withIM Rational
ratio Property
prop forall a. Grid a
Grid
applyIM :: (LayoutClass l Window) =>
Rational
-> Property
-> S.Workspace WorkspaceId (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
applyIM :: forall (l :: * -> *).
LayoutClass l Window =>
Rational
-> Property
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
applyIM Rational
ratio Property
prop Workspace String (l Window) Window
wksp Rectangle
rect = do
let stack :: Maybe (Stack Window)
stack = forall i l a. Workspace i l a -> Maybe (Stack a)
S.stack Workspace String (l Window) Window
wksp
let ws :: [Window]
ws = forall a. Maybe (Stack a) -> [a]
S.integrate' Maybe (Stack Window)
stack
let (Rectangle
masterRect, Rectangle
slaveRect) = forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
ratio Rectangle
rect
Maybe Window
master <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM (Property -> Window -> X Bool
hasProperty Property
prop) [Window]
ws
case Maybe Window
master of
Just Window
w -> do
let filteredStack :: Maybe (Stack Window)
filteredStack = Maybe (Stack Window)
stack forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
S.filter (Window
w forall a. Eq a => a -> a -> Bool
/=)
([(Window, Rectangle)], Maybe (l Window))
wrs <- 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)
filteredStack}) Rectangle
slaveRect
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Window
w, Rectangle
masterRect) forall a. a -> [a] -> [a]
:) ([(Window, Rectangle)], Maybe (l Window))
wrs)
Maybe Window
Nothing -> 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
data IM a = IM Rational Property deriving (ReadPrec [IM a]
ReadPrec (IM a)
ReadS [IM a]
forall a. ReadPrec [IM a]
forall a. ReadPrec (IM a)
forall a. Int -> ReadS (IM a)
forall a. ReadS [IM a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IM a]
$creadListPrec :: forall a. ReadPrec [IM a]
readPrec :: ReadPrec (IM a)
$creadPrec :: forall a. ReadPrec (IM a)
readList :: ReadS [IM a]
$creadList :: forall a. ReadS [IM a]
readsPrec :: Int -> ReadS (IM a)
$creadsPrec :: forall a. Int -> ReadS (IM a)
Read, Int -> IM a -> ShowS
forall a. Int -> IM a -> ShowS
forall a. [IM a] -> ShowS
forall a. IM a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IM a] -> ShowS
$cshowList :: forall a. [IM a] -> ShowS
show :: IM a -> String
$cshow :: forall a. IM a -> String
showsPrec :: Int -> IM a -> ShowS
$cshowsPrec :: forall a. Int -> IM a -> ShowS
Show)
instance LayoutClass IM Window where
description :: IM Window -> String
description IM Window
_ = String
"IM"
doLayout :: IM Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (IM Window))
doLayout (IM Rational
r Property
prop) Rectangle
rect Stack Window
stack = do
let ws :: [Window]
ws = forall a. Stack a -> [a]
S.integrate Stack Window
stack
let (Rectangle
masterRect, Rectangle
slaveRect) = forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
r Rectangle
rect
Maybe Window
master <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM (Property -> Window -> X Bool
hasProperty Property
prop) [Window]
ws
let positions :: [(Window, Rectangle)]
positions = case Maybe Window
master of
Just Window
w -> (Window
w, Rectangle
masterRect) forall a. a -> [a] -> [a]
: forall a. Double -> Rectangle -> [a] -> [(a, Rectangle)]
arrange Double
defaultRatio Rectangle
slaveRect (forall a. (a -> Bool) -> [a] -> [a]
filter (Window
w forall a. Eq a => a -> a -> Bool
/=) [Window]
ws)
Maybe Window
Nothing -> forall a. Double -> Rectangle -> [a] -> [(a, Rectangle)]
arrange Double
defaultRatio Rectangle
rect [Window]
ws
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
positions, forall a. Maybe a
Nothing)