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

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.IM
-- Description :  Layout modfier for multi-windowed instant messengers like Psi or Tkabber.
-- Copyright   :  (c) Roman Cheplyaka, Ivan N. Veselov <veselov@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Layout modfier suitable for workspace with multi-windowed instant messenger
-- (like Psi or Tkabber).
--
-----------------------------------------------------------------------------

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

    -- * Hints
    -- $hints

    -- * TODO
    -- $todo
        Property(..), IM(..), withIM, gridIM,
        AddRoster,
) where

import XMonad
import qualified XMonad.StackSet as S
import XMonad.Layout.Grid
import XMonad.Layout.LayoutModifier
import XMonad.Util.WindowProperties

import Control.Arrow (first)

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.IM
-- > import Data.Ratio ((%))
--
-- Then edit your @layoutHook@ by adding IM modifier to layout which you prefer
-- for managing your chat windows (Grid in this example, another useful choice
-- to consider is Tabbed layout).
--
-- > myLayout = withIM (1%7) (ClassName "Tkabber") Grid ||| Full ||| etc..
-- > main = xmonad def { layoutHook = myLayout }
--
-- Here @1%7@ is the part of the screen which your roster will occupy,
-- @ClassName \"Tkabber\"@ tells xmonad which window is actually your roster.
--
-- Screenshot: <http://haskell.org/haskellwiki/Image:Xmonad-layout-im.png>
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"

-- $hints
--
-- To launch IM layout automatically on your IM workspace use "XMonad.Layout.PerWorkspace".
--
-- By default the roster window will appear on the left side.
-- To place roster window on the right side, use @reflectHoriz@ from
-- "XMonad.Layout.Reflect" module.

-- $todo
-- This item are questionable. Please let me know if you find them useful.
--
-- * shrink\/expand
--

-- | Data type for LayoutModifier which converts given layout to IM-layout
-- (with dedicated space for the roster and original layout for chat windows)
data AddRoster a = AddRoster Rational Property deriving (ReadPrec [AddRoster a]
ReadPrec (AddRoster a)
Int -> ReadS (AddRoster a)
ReadS [AddRoster a]
(Int -> ReadS (AddRoster a))
-> ReadS [AddRoster a]
-> ReadPrec (AddRoster a)
-> ReadPrec [AddRoster a]
-> Read (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
[AddRoster a] -> ShowS
AddRoster a -> String
(Int -> AddRoster a -> ShowS)
-> (AddRoster a -> String)
-> ([AddRoster a] -> ShowS)
-> Show (AddRoster a)
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) = Rational
-> Property
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
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"

-- | Modifier which converts given layout to IM-layout (with dedicated
-- space for roster and original layout for chat windows)
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 = AddRoster a -> l a -> ModifiedLayout AddRoster l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (AddRoster a -> l a -> ModifiedLayout AddRoster l a)
-> AddRoster a -> l a -> ModifiedLayout AddRoster l a
forall a b. (a -> b) -> a -> b
$ Rational -> Property -> AddRoster a
forall a. Rational -> Property -> AddRoster a
AddRoster Rational
ratio Property
prop

-- | IM layout modifier applied to the Grid layout
gridIM :: Rational -> Property -> ModifiedLayout AddRoster Grid a
gridIM :: forall a. Rational -> Property -> ModifiedLayout AddRoster Grid a
gridIM Rational
ratio Property
prop = Rational -> Property -> Grid a -> ModifiedLayout AddRoster Grid a
forall (l :: * -> *) a.
LayoutClass l a =>
Rational -> Property -> l a -> ModifiedLayout AddRoster l a
withIM Rational
ratio Property
prop Grid a
forall a. Grid a
Grid

-- | Internal function for adding space for the roster specified by
-- the property and running original layout for all chat windows
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 = 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)
stack
    let (Rectangle
masterRect, Rectangle
slaveRect) = Rational -> Rectangle -> (Rectangle, Rectangle)
forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
ratio Rectangle
rect
    Maybe Window
master <- (Window -> X Bool) -> [Window] -> X (Maybe Window)
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 Maybe (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
w Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/=)
            ([(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)
filteredStack}) Rectangle
slaveRect
            ([(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 ((Window
w, Rectangle
masterRect) (Window, Rectangle)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. a -> [a] -> [a]
:) ([(Window, Rectangle)], Maybe (l Window))
wrs)
        Maybe Window
Nothing -> 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

-- | Like find, but works with monadic computation instead of pure function.
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM a -> m Bool
_ [] = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
findM a -> m Bool
f (a
x:[a]
xs) = do { Bool
b <- a -> m Bool
f a
x; if Bool
b then Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x) else (a -> m Bool) -> [a] -> m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM a -> m Bool
f [a]
xs }

-- | This is for compatibility with old configs only and will be removed in future versions!
data IM a = IM Rational Property deriving (ReadPrec [IM a]
ReadPrec (IM a)
Int -> ReadS (IM a)
ReadS [IM a]
(Int -> ReadS (IM a))
-> ReadS [IM a]
-> ReadPrec (IM a)
-> ReadPrec [IM a]
-> Read (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
[IM a] -> ShowS
IM a -> String
(Int -> IM a -> ShowS)
-> (IM a -> String) -> ([IM a] -> ShowS) -> Show (IM a)
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 = Stack Window -> [Window]
forall a. Stack a -> [a]
S.integrate Stack Window
stack
        let (Rectangle
masterRect, Rectangle
slaveRect) = Rational -> Rectangle -> (Rectangle, Rectangle)
forall r. RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
splitHorizontallyBy Rational
r Rectangle
rect
        Maybe Window
master <- (Window -> X Bool) -> [Window] -> X (Maybe Window)
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) (Window, Rectangle)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. a -> [a] -> [a]
: Double -> Rectangle -> [Window] -> [(Window, Rectangle)]
forall a. Double -> Rectangle -> [a] -> [(a, Rectangle)]
arrange Double
defaultRatio Rectangle
slaveRect ((Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window
w Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/=) [Window]
ws)
                Maybe Window
Nothing -> Double -> Rectangle -> [Window] -> [(Window, Rectangle)]
forall a. Double -> Rectangle -> [a] -> [(a, Rectangle)]
arrange Double
defaultRatio Rectangle
rect [Window]
ws
        ([(Window, Rectangle)], Maybe (IM Window))
-> X ([(Window, Rectangle)], Maybe (IM Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
positions, Maybe (IM Window)
forall a. Maybe a
Nothing)