{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Drawer
-- Description :  A layout modifier to put windows in a "drawer".
-- Copyright   :  (c) 2009 Max Rabkin
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  max.rabkin@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- A layout modifier that puts some windows in a "drawer" which retracts and
-- expands depending on whether any window in it has focus.
--
-- Useful for music players, tool palettes, etc.
--
-----------------------------------------------------------------------------

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

      -- * Drawers
      simpleDrawer
    , drawer

      -- * Placing drawers
      -- The drawer can be placed on any side of the screen with these functions
    , onLeft, onTop, onRight, onBottom

    , module XMonad.Util.WindowProperties

    , Drawer, Reflected
    ) where

import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Util.WindowProperties
import XMonad.StackSet as S
import XMonad.Layout.Reflect

-- $usage
-- To use this module, add the following import to @xmonad.hs@:
--
-- > import XMonad.Layout.Drawer
--
-- > myLayout = drawer `onTop` (Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout...
-- >     where
-- >         drawer = simpleDrawer 0.01 0.3 (ClassName "Rhythmbox" `Or` ClassName "Xchat")
-- >
-- > main = xmonad def { layoutHook = myLayout }
--
-- This will place the Rhythmbox and Xchat windows in at the top of the screen
-- only when using the 'Tall' layout.  See "XMonad.Util.WindowProperties" for
-- more information on selecting windows.

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

-- | filter : filterM :: partition : partitionM
partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
partitionM a -> m Bool
f (a
x:[a]
xs) = do
    Bool
b <- a -> m Bool
f a
x
    ([a]
ys, [a]
zs) <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
f [a]
xs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
b
                then (a
xforall a. a -> [a] -> [a]
:[a]
ys, [a]
zs)
                else ([a]
ys, a
xforall a. a -> [a] -> [a]
:[a]
zs)

instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Window where
    modifyLayout :: forall (l :: * -> *).
LayoutClass l Window =>
Drawer l Window
-> Workspace String (l Window) Window
-> Rectangle
-> X ([(Window, Rectangle)], Maybe (l Window))
modifyLayout (Drawer Rational
rs Rational
rb Property
p l Window
l) Workspace String (l Window) Window
ws Rectangle
rect =
        case forall i l a. Workspace i l a -> Maybe (Stack a)
stack Workspace String (l Window) Window
ws of
            Maybe (Stack 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
ws Rectangle
rect
            Just stk :: Stack Window
stk@Stack{ up :: forall a. Stack a -> [a]
up=[Window]
up_, down :: forall a. Stack a -> [a]
down=[Window]
down_, focus :: forall a. Stack a -> a
S.focus=Window
w } -> do
                    ([Window]
upD, [Window]
upM) <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM (Property -> Window -> X Bool
hasProperty Property
p) [Window]
up_
                    ([Window]
downD, [Window]
downM) <- forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM (Property -> Window -> X Bool
hasProperty Property
p) [Window]
down_
                    Bool
b <- Property -> Window -> X Bool
hasProperty Property
p Window
w
                    Maybe Window
focusedWindow <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Stack a -> a
S.focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)

                    let rectD :: Rectangle
rectD = if Bool
b Bool -> Bool -> Bool
&& forall a. a -> Maybe a
Just Window
w forall a. Eq a => a -> a -> Bool
== Maybe Window
focusedWindow then Rectangle
rectB else Rectangle
rectS

                    let (Maybe (Stack Window)
stackD, Maybe (Stack Window)
stackM) = if Bool
b
                                            then ( forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Stack Window
stk { up :: [Window]
up=[Window]
upD, down :: [Window]
down=[Window]
downD }
                                                 , forall {a}. [a] -> [a] -> Maybe (Stack a)
mkStack [Window]
upM [Window]
downM )
                                            else ( forall {a}. [a] -> [a] -> Maybe (Stack a)
mkStack [Window]
upD [Window]
downD
                                                 , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Stack Window
stk { up :: [Window]
up=[Window]
upM, down :: [Window]
down=[Window]
downM } )

                    ([(Window, Rectangle)]
winsD, 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
ws { layout :: l Window
layout=l Window
l, stack :: Maybe (Stack Window)
stack=Maybe (Stack Window)
stackD }) Rectangle
rectD
                    ([(Window, Rectangle)]
winsM, Maybe (l Window)
u') <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (Workspace String (l Window) Window
ws { stack :: Maybe (Stack Window)
stack=Maybe (Stack Window)
stackM }) Rectangle
rectM
                    forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
winsD forall a. [a] -> [a] -> [a]
++ [(Window, Rectangle)]
winsM, Maybe (l Window)
u')
      where
        mkStack :: [a] -> [a] -> Maybe (Stack a)
mkStack [] [] = forall a. Maybe a
Nothing
        mkStack [a]
xs (a
y:[a]
ys) = forall a. a -> Maybe a
Just (Stack { up :: [a]
up=[a]
xs, focus :: a
S.focus=a
y, down :: [a]
down=[a]
ys })
        mkStack (a
x:[a]
xs) [a]
ys = forall a. a -> Maybe a
Just (Stack { up :: [a]
up=[a]
xs, focus :: a
S.focus=a
x, down :: [a]
down=[a]
ys })

        rectB :: Rectangle
rectB = Rectangle
rect { rect_width :: Dimension
rect_width=forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_width Rectangle
rect) forall a. Num a => a -> a -> a
* Rational
rb }
        rectS :: Rectangle
rectS = Rectangle
rectB { rect_x :: Position
rect_x=Rectangle -> Position
rect_x Rectangle
rectB forall a. Num a => a -> a -> a
- forall a b. (RealFrac a, Integral b) => a -> b
round ((Rational
rb forall a. Num a => a -> a -> a
- Rational
rs) forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_width Rectangle
rect)) }
        rectM :: Rectangle
rectM = Rectangle
rect { rect_x :: Position
rect_x=Rectangle -> Position
rect_x Rectangle
rect forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_width Rectangle
rect) forall a. Num a => a -> a -> a
* Rational
rs)
                     , rect_width :: Dimension
rect_width=Rectangle -> Dimension
rect_width Rectangle
rect forall a. Num a => a -> a -> a
- forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rectangle -> Dimension
rect_width Rectangle
rect) forall a. Num a => a -> a -> a
* Rational
rs) }

type Reflected l = ModifiedLayout Reflect l

-- | Construct a drawer with a simple layout of the windows inside
simpleDrawer :: Rational -- ^ The portion of the screen taken up by the drawer when closed
              -> Rational   -- ^ The portion of the screen taken up by the drawer when open
              -> Property   -- ^ Which windows to put in the drawer
              -> Drawer Tall a
simpleDrawer :: forall a. Rational -> Rational -> Property -> Drawer Tall a
simpleDrawer Rational
rs Rational
rb Property
p = forall (l :: * -> *) a.
Rational -> Rational -> Property -> l a -> Drawer l a
Drawer Rational
rs Rational
rb Property
p forall {a}. Tall a
vertical
    where
        vertical :: Tall a
vertical = forall a. Int -> Rational -> Rational -> Tall a
Tall Int
0 Rational
0 Rational
0

-- Export a synonym for the constructor as a Haddock workaround
-- | Construct a drawer with an arbitrary layout for windows inside
drawer ::    Rational   -- ^ The portion of the screen taken up by the drawer when closed
          -> Rational   -- ^ The portion of the screen taken up by the drawer when open
          -> Property   -- ^ Which windows to put in the drawer
          -> l a        -- ^ The layout of windows in the drawer
          -> Drawer l a
drawer :: forall (l :: * -> *) a.
Rational -> Rational -> Property -> l a -> Drawer l a
drawer = forall (l :: * -> *) a.
Rational -> Rational -> Property -> l a -> Drawer l a
Drawer

onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout

onRight :: Drawer l a -> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
onRight :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
onRight Drawer l a
d = forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectHoriz forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a (l' :: * -> *).
Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft Drawer l a
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectHoriz

onTop :: Drawer l a -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
onTop :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
onTop Drawer l a
d = forall (l :: * -> *) a. l a -> Mirror l a
Mirror forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a (l' :: * -> *).
Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
onLeft Drawer l a
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a. l a -> Mirror l a
Mirror

onBottom :: Drawer l a -> l' a -> Reflected (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
onBottom :: forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a
-> Reflected
     (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
onBottom Drawer l a
d = forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectVert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a (l' :: * -> *).
Drawer l a
-> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
onTop Drawer l a
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
reflectVert