    {-# 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 XMonad.Layout.Grid
    import XMonad.Layout.LayoutModifier
    import XMonad.Prelude
    import XMonad.Util.WindowProperties
    import qualified XMonad.StackSet as S

    import Control.Arrow (first)

    -- $usage
    -- You can use this module with the following in your @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
    -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
    -- "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
    $creadsPrec :: forall a. Int -> ReadS (AddRoster a)
    readsPrec :: Int -> ReadS (AddRoster a)
    $creadList :: forall a. ReadS [AddRoster a]
    readList :: ReadS [AddRoster a]
    $creadPrec :: forall a. ReadPrec (AddRoster a)
    readPrec :: ReadPrec (AddRoster a)
    $creadListPrec :: forall a. ReadPrec [AddRoster a]
    readListPrec :: ReadPrec [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
    $cshowsPrec :: forall a. Int -> AddRoster a -> ShowS
    showsPrec :: Int -> AddRoster a -> ShowS
    $cshow :: forall a. AddRoster a -> String
    show :: AddRoster a -> String
    $cshowList :: forall a. [AddRoster a] -> ShowS
    showList :: [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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
    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 {S.stack = filteredStack}) Rectangle
    slaveRect
                ([(Window, Rectangle)], Maybe (l Window))
    -> X ([(Window, Rectangle)], Maybe (l Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([(Window, Rectangle)] -> [(Window, Rectangle)])
    -> ([(Window, Rectangle)], Maybe (l Window))
    -> ([(Window, Rectangle)], Maybe (l Window))
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    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

    -- | 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
    $creadsPrec :: forall a. Int -> ReadS (IM a)
    readsPrec :: Int -> ReadS (IM a)
    $creadList :: forall a. ReadS [IM a]
    readList :: ReadS [IM a]
    $creadPrec :: forall a. ReadPrec (IM a)
    readPrec :: ReadPrec (IM a)
    $creadListPrec :: forall a. ReadPrec [IM a]
    readListPrec :: ReadPrec [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
    $cshowsPrec :: forall a. Int -> IM a -> ShowS
    showsPrec :: Int -> IM a -> ShowS
    $cshow :: forall a. IM a -> String
    show :: IM a -> String
    $cshowList :: forall a. [IM a] -> ShowS
    showList :: [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 a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Window, Rectangle)]
    positions, Maybe (IM Window)
    forall a. Maybe a
    Nothing)