-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.IfMax
-- Description :  Decide upon a layout depending on the number of windows.
-- Copyright   :  (c) 2013 Ilya Portnov
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides IfMax layout, which will run one layout if there are maximum N
-- windows on workspace, and another layout, when number of windows is greater
-- than N.
--
-----------------------------------------------------------------------------

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

module XMonad.Layout.IfMax
    ( -- * Usage
      -- $usage
      IfMax (..)
    , ifMax
    ) where

import Control.Arrow ((&&&))
import qualified Data.List as L
import qualified Data.Map  as M

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W

-- $usage
-- IfMax layout will run one layout if number of windows on workspace is as
-- maximum N, and else will run another layout.
--
-- You can use this module by adding folowing in your @xmonad.hs@:
--
-- > import XMonad.Layout.IfMax
--
-- Then add layouts to your layoutHook:
--
-- > myLayoutHook = IfMax 2 Full (Tall ...) ||| ...
--
-- In this example, if there are 1 or 2 windows, Full layout will be used;
-- otherwise, Tall layout will be used.
--

data IfMax l1 l2 w = IfMax Int (l1 w) (l2 w)
  deriving (ReadPrec [IfMax l1 l2 w]
ReadPrec (IfMax l1 l2 w)
Int -> ReadS (IfMax l1 l2 w)
ReadS [IfMax l1 l2 w]
(Int -> ReadS (IfMax l1 l2 w))
-> ReadS [IfMax l1 l2 w]
-> ReadPrec (IfMax l1 l2 w)
-> ReadPrec [IfMax l1 l2 w]
-> Read (IfMax l1 l2 w)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (l1 :: * -> *) (l2 :: * -> *) w.
(Read (l1 w), Read (l2 w)) =>
ReadPrec [IfMax l1 l2 w]
forall (l1 :: * -> *) (l2 :: * -> *) w.
(Read (l1 w), Read (l2 w)) =>
ReadPrec (IfMax l1 l2 w)
forall (l1 :: * -> *) (l2 :: * -> *) w.
(Read (l1 w), Read (l2 w)) =>
Int -> ReadS (IfMax l1 l2 w)
forall (l1 :: * -> *) (l2 :: * -> *) w.
(Read (l1 w), Read (l2 w)) =>
ReadS [IfMax l1 l2 w]
readListPrec :: ReadPrec [IfMax l1 l2 w]
$creadListPrec :: forall (l1 :: * -> *) (l2 :: * -> *) w.
(Read (l1 w), Read (l2 w)) =>
ReadPrec [IfMax l1 l2 w]
readPrec :: ReadPrec (IfMax l1 l2 w)
$creadPrec :: forall (l1 :: * -> *) (l2 :: * -> *) w.
(Read (l1 w), Read (l2 w)) =>
ReadPrec (IfMax l1 l2 w)
readList :: ReadS [IfMax l1 l2 w]
$creadList :: forall (l1 :: * -> *) (l2 :: * -> *) w.
(Read (l1 w), Read (l2 w)) =>
ReadS [IfMax l1 l2 w]
readsPrec :: Int -> ReadS (IfMax l1 l2 w)
$creadsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) w.
(Read (l1 w), Read (l2 w)) =>
Int -> ReadS (IfMax l1 l2 w)
Read, Int -> IfMax l1 l2 w -> ShowS
[IfMax l1 l2 w] -> ShowS
IfMax l1 l2 w -> String
(Int -> IfMax l1 l2 w -> ShowS)
-> (IfMax l1 l2 w -> String)
-> ([IfMax l1 l2 w] -> ShowS)
-> Show (IfMax l1 l2 w)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (l1 :: * -> *) (l2 :: * -> *) w.
(Show (l1 w), Show (l2 w)) =>
Int -> IfMax l1 l2 w -> ShowS
forall (l1 :: * -> *) (l2 :: * -> *) w.
(Show (l1 w), Show (l2 w)) =>
[IfMax l1 l2 w] -> ShowS
forall (l1 :: * -> *) (l2 :: * -> *) w.
(Show (l1 w), Show (l2 w)) =>
IfMax l1 l2 w -> String
showList :: [IfMax l1 l2 w] -> ShowS
$cshowList :: forall (l1 :: * -> *) (l2 :: * -> *) w.
(Show (l1 w), Show (l2 w)) =>
[IfMax l1 l2 w] -> ShowS
show :: IfMax l1 l2 w -> String
$cshow :: forall (l1 :: * -> *) (l2 :: * -> *) w.
(Show (l1 w), Show (l2 w)) =>
IfMax l1 l2 w -> String
showsPrec :: Int -> IfMax l1 l2 w -> ShowS
$cshowsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) w.
(Show (l1 w), Show (l2 w)) =>
Int -> IfMax l1 l2 w -> ShowS
Show)

instance (LayoutClass l1 Window, LayoutClass l2 Window) => LayoutClass (IfMax l1 l2) Window where

  runLayout :: Workspace String (IfMax l1 l2 Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window))
runLayout (W.Workspace String
wname (IfMax Int
n l1 Window
l1 l2 Window
l2) Maybe (Stack Window)
s) Rectangle
rect = (WindowSet
 -> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window)))
-> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window))
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet
  -> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window)))
 -> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window)))
-> (WindowSet
    -> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window)))
-> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> [Window]
-> [Window]
-> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window))
forall {a}.
Eq a =>
[a] -> [a] -> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window))
arrange (Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' Maybe (Stack Window)
s) (Map Window RationalRect -> [Window]
forall k a. Map k a -> [k]
M.keys (Map Window RationalRect -> [Window])
-> (WindowSet -> Map Window RationalRect) -> WindowSet -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating (WindowSet -> [Window]) -> WindowSet -> [Window]
forall a b. (a -> b) -> a -> b
$ WindowSet
ws)
    where
      arrange :: [a] -> [a] -> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window))
arrange [a]
ws [a]
fw | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a]
ws [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [a]
fw) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = do
                                    ([(Window, Rectangle)]
wrs, Maybe (l1 Window)
ml1') <- Workspace String (l1 Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l1 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l1 Window
-> Maybe (Stack Window)
-> Workspace String (l1 Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
wname l1 Window
l1 Maybe (Stack Window)
s) Rectangle
rect
                                    let l1' :: l1 Window
l1' = l1 Window -> Maybe (l1 Window) -> l1 Window
forall a. a -> Maybe a -> a
fromMaybe l1 Window
l1 Maybe (l1 Window)
ml1'
                                    l2 Window
l2' <- l2 Window -> Maybe (l2 Window) -> l2 Window
forall a. a -> Maybe a -> a
fromMaybe l2 Window
l2 (Maybe (l2 Window) -> l2 Window)
-> X (Maybe (l2 Window)) -> X (l2 Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l2 Window -> SomeMessage -> X (Maybe (l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
l2 (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
                                    ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window))
-> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
wrs, IfMax l1 l2 Window -> Maybe (IfMax l1 l2 Window)
forall a. a -> Maybe a
Just (IfMax l1 l2 Window -> Maybe (IfMax l1 l2 Window))
-> IfMax l1 l2 Window -> Maybe (IfMax l1 l2 Window)
forall a b. (a -> b) -> a -> b
$ Int -> l1 Window -> l2 Window -> IfMax l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) w.
Int -> l1 w -> l2 w -> IfMax l1 l2 w
IfMax Int
n l1 Window
l1' l2 Window
l2')
                    | Bool
otherwise      = do
                                    ([(Window, Rectangle)]
wrs, Maybe (l2 Window)
ml2') <- Workspace String (l2 Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l2 Window
-> Maybe (Stack Window)
-> Workspace String (l2 Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
wname l2 Window
l2 Maybe (Stack Window)
s) Rectangle
rect
                                    l1 Window
l1' <- l1 Window -> Maybe (l1 Window) -> l1 Window
forall a. a -> Maybe a -> a
fromMaybe l1 Window
l1 (Maybe (l1 Window) -> l1 Window)
-> X (Maybe (l1 Window)) -> X (l1 Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> l1 Window -> SomeMessage -> X (Maybe (l1 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
l1 (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
Hide)
                                    let l2' :: l2 Window
l2' = l2 Window -> Maybe (l2 Window) -> l2 Window
forall a. a -> Maybe a -> a
fromMaybe l2 Window
l2 Maybe (l2 Window)
ml2'
                                    ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window))
-> X ([(Window, Rectangle)], Maybe (IfMax l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
wrs, IfMax l1 l2 Window -> Maybe (IfMax l1 l2 Window)
forall a. a -> Maybe a
Just (IfMax l1 l2 Window -> Maybe (IfMax l1 l2 Window))
-> IfMax l1 l2 Window -> Maybe (IfMax l1 l2 Window)
forall a b. (a -> b) -> a -> b
$ Int -> l1 Window -> l2 Window -> IfMax l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) w.
Int -> l1 w -> l2 w -> IfMax l1 l2 w
IfMax Int
n l1 Window
l1' l2 Window
l2')

  handleMessage :: IfMax l1 l2 Window -> SomeMessage -> X (Maybe (IfMax l1 l2 Window))
handleMessage (IfMax Int
n l1 Window
l1 l2 Window
l2) SomeMessage
m | Just LayoutMessages
ReleaseResources <- SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = do
      Maybe (l1 Window)
l1' <- l1 Window -> SomeMessage -> X (Maybe (l1 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
l1 (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
      Maybe (l2 Window)
l2' <- l2 Window -> SomeMessage -> X (Maybe (l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
l2 (LayoutMessages -> SomeMessage
forall a. Message a => a -> SomeMessage
SomeMessage LayoutMessages
ReleaseResources)
      if Maybe (l1 Window) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (l1 Window)
l1' Bool -> Bool -> Bool
&& Maybe (l2 Window) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (l2 Window)
l2'
         then Maybe (IfMax l1 l2 Window) -> X (Maybe (IfMax l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (IfMax l1 l2 Window)
forall a. Maybe a
Nothing
         else Maybe (IfMax l1 l2 Window) -> X (Maybe (IfMax l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IfMax l1 l2 Window) -> X (Maybe (IfMax l1 l2 Window)))
-> Maybe (IfMax l1 l2 Window) -> X (Maybe (IfMax l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ IfMax l1 l2 Window -> Maybe (IfMax l1 l2 Window)
forall a. a -> Maybe a
Just (IfMax l1 l2 Window -> Maybe (IfMax l1 l2 Window))
-> IfMax l1 l2 Window -> Maybe (IfMax l1 l2 Window)
forall a b. (a -> b) -> a -> b
$ Int -> l1 Window -> l2 Window -> IfMax l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) w.
Int -> l1 w -> l2 w -> IfMax l1 l2 w
IfMax Int
n (l1 Window -> Maybe (l1 Window) -> l1 Window
forall a. a -> Maybe a -> a
fromMaybe l1 Window
l1 Maybe (l1 Window)
l1') (l2 Window -> Maybe (l2 Window) -> l2 Window
forall a. a -> Maybe a -> a
fromMaybe l2 Window
l2 Maybe (l2 Window)
l2')
  handleMessage (IfMax Int
n l1 Window
l1 l2 Window
l2) SomeMessage
m = do
      ([Window]
allWindows, [Window]
floatingWindows) <- (XState -> ([Window], [Window])) -> X ([Window], [Window])
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack Window) -> [Window])
-> (WindowSet -> Maybe (Stack Window)) -> WindowSet -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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))
-> (WindowSet -> Workspace String (Layout Window) Window)
-> WindowSet
-> 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)
-> (WindowSet
    -> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> WindowSet
-> Workspace String (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> 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 (WindowSet -> [Window])
-> (WindowSet -> [Window]) -> WindowSet -> ([Window], [Window])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Map Window RationalRect -> [Window]
forall k a. Map k a -> [k]
M.keys (Map Window RationalRect -> [Window])
-> (WindowSet -> Map Window RationalRect) -> WindowSet -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating) (WindowSet -> ([Window], [Window]))
-> (XState -> WindowSet) -> XState -> ([Window], [Window])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
      if [Window] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Window]
allWindows [Window] -> [Window] -> [Window]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [Window]
floatingWindows) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
        then do
          Maybe (l1 Window)
l1' <- l1 Window -> SomeMessage -> X (Maybe (l1 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 Window
l1 SomeMessage
m
          Maybe (IfMax l1 l2 Window) -> X (Maybe (IfMax l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IfMax l1 l2 Window) -> X (Maybe (IfMax l1 l2 Window)))
-> Maybe (IfMax l1 l2 Window) -> X (Maybe (IfMax l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ (l1 Window -> l2 Window -> IfMax l1 l2 Window)
-> l2 Window -> l1 Window -> IfMax l1 l2 Window
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> l1 Window -> l2 Window -> IfMax l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) w.
Int -> l1 w -> l2 w -> IfMax l1 l2 w
IfMax Int
n) l2 Window
l2 (l1 Window -> IfMax l1 l2 Window)
-> Maybe (l1 Window) -> Maybe (IfMax l1 l2 Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (l1 Window)
l1'
        else do
          Maybe (l2 Window)
l2' <- l2 Window -> SomeMessage -> X (Maybe (l2 Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 Window
l2 SomeMessage
m
          Maybe (IfMax l1 l2 Window) -> X (Maybe (IfMax l1 l2 Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IfMax l1 l2 Window) -> X (Maybe (IfMax l1 l2 Window)))
-> Maybe (IfMax l1 l2 Window) -> X (Maybe (IfMax l1 l2 Window))
forall a b. (a -> b) -> a -> b
$ Int -> l1 Window -> l2 Window -> IfMax l1 l2 Window
forall (l1 :: * -> *) (l2 :: * -> *) w.
Int -> l1 w -> l2 w -> IfMax l1 l2 w
IfMax Int
n l1 Window
l1 (l2 Window -> IfMax l1 l2 Window)
-> Maybe (l2 Window) -> Maybe (IfMax l1 l2 Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (l2 Window)
l2'

  description :: IfMax l1 l2 Window -> String
description (IfMax Int
n l1 Window
l1 l2 Window
l2) = String
"If number of windows is <= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", then " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                l1 Window -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 Window
l1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", else " String -> ShowS
forall a. [a] -> [a] -> [a]
++ l2 Window -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 Window
l2

-- | Layout itself
ifMax :: (LayoutClass l1 w, LayoutClass l2 w)
      => Int            -- ^ Maximum number of windows for the first layout
      -> l1 w           -- ^ First layout
      -> l2 w           -- ^ Second layout
      -> IfMax l1 l2 w
ifMax :: forall (l1 :: * -> *) w (l2 :: * -> *).
(LayoutClass l1 w, LayoutClass l2 w) =>
Int -> l1 w -> l2 w -> IfMax l1 l2 w
ifMax = Int -> l1 w -> l2 w -> IfMax l1 l2 w
forall (l1 :: * -> *) (l2 :: * -> *) w.
Int -> l1 w -> l2 w -> IfMax l1 l2 w
IfMax