    {-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.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\/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)
    Int -> ReadS (Drawer l a)
    ReadS [Drawer l a]
    (Int -> ReadS (Drawer l a))
    -> ReadS [Drawer l a]
    -> ReadPrec (Drawer l a)
    -> ReadPrec [Drawer l a]
    -> Read (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
    [Drawer l a] -> ShowS
    Drawer l a -> String
    (Int -> Drawer l a -> ShowS)
    -> (Drawer l a -> String)
    -> ([Drawer l a] -> ShowS)
    -> Show (Drawer l a)
    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 :: (a -> m Bool) -> [a] -> m ([a], [a])
    partitionM _ [] = ([a], [a]) -> m ([a], [a])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [])
    partitionM f :: a -> m Bool
    f (x :: a
    x:xs :: [a]
    xs) = do
        Bool
    b <- a -> m Bool
    f a
    x
        (ys :: [a]
    ys, zs :: [a]
    zs) <- (a -> m Bool) -> [a] -> m ([a], [a])
    forall (m :: * -> *) a.
    Monad m =>
    (a -> m Bool) -> [a] -> m ([a], [a])
    partitionM a -> m Bool
    f [a]
    xs
        ([a], [a]) -> m ([a], [a])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([a], [a]) -> m ([a], [a])) -> ([a], [a]) -> m ([a], [a])
    forall a b. (a -> b) -> a -> b
    $ if Bool
    b
                    then (a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ys, [a]
    zs)
                    else ([a]
    ys, a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    zs)

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

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

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

                        (winsD :: [(Window, Rectangle)]
    winsD, _) <- 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
    ws { layout :: l Window
    layout=l Window
    l, stack :: Maybe (Stack Window)
    stack=Maybe (Stack Window)
    stackD }) Rectangle
    rectD
                        (winsM :: [(Window, Rectangle)]
    winsM, u' :: Maybe (l Window)
    u') <- 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
    ws { stack :: Maybe (Stack Window)
    stack=Maybe (Stack Window)
    stackM }) Rectangle
    rectM
                        ([(Window, Rectangle)], Maybe (l Window))
    -> X ([(Window, Rectangle)], Maybe (l Window))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Window, Rectangle)]
    winsD [(Window, Rectangle)]
    -> [(Window, Rectangle)] -> [(Window, Rectangle)]
    forall a. [a] -> [a] -> [a]
    ++ [(Window, Rectangle)]
    winsM, Maybe (l Window)
    u')
          where
            mkStack :: [a] -> [a] -> Maybe (Stack a)
    mkStack [] [] = Maybe (Stack a)
    forall a. Maybe a
    Nothing
            mkStack xs :: [a]
    xs (y :: a
    y:ys :: [a]
    ys) = Stack a -> Maybe (Stack a)
    forall a. a -> Maybe a
    Just ($WStack :: forall a. a -> [a] -> [a] -> Stack a
    Stack { up :: [a]
    up=[a]
    xs, focus :: a
    S.focus=a
    y, down :: [a]
    down=[a]
    ys })
            mkStack (x :: a
    x:xs :: [a]
    xs) ys :: [a]
    ys = Stack a -> Maybe (Stack a)
    forall a. a -> Maybe a
    Just ($WStack :: forall a. a -> [a] -> [a] -> Stack a
    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=Rational -> Dimension
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Rational -> Dimension) -> Rational -> Dimension
    forall a b. (a -> b) -> a -> b
    $ Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Rectangle -> Dimension
    rect_width Rectangle
    rect) Rational -> Rational -> Rational
    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 Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - (Rational -> Position
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Rational -> Position) -> Rational -> Position
    forall a b. (a -> b) -> a -> b
    $ (Rational
    rb Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    - Rational
    rs) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Dimension -> Rational
    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 Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Rational -> Position
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Rectangle -> Dimension
    rect_width Rectangle
    rect) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    rs)
                         , rect_width :: Dimension
    rect_width=Rectangle -> Dimension
    rect_width Rectangle
    rect Dimension -> Dimension -> Dimension
    forall a. Num a => a -> a -> a
    - Rational -> Dimension
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Dimension -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Rectangle -> Dimension
    rect_width Rectangle
    rect) Rational -> Rational -> Rational
    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 :: Rational -> Rational -> Property -> Drawer Tall a
    simpleDrawer rs :: Rational
    rs rb :: Rational
    rb p :: Property
    p = Rational -> Rational -> Property -> Tall a -> Drawer Tall a
    forall (l :: * -> *) a.
    Rational -> Rational -> Property -> l a -> Drawer l a
    Drawer Rational
    rs Rational
    rb Property
    p Tall a
    forall a. Tall a
    vertical
        where
            vertical :: Tall a
    vertical = Int -> Rational -> Rational -> Tall a
    forall a. Int -> Rational -> Rational -> Tall a
    Tall 0 0 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 :: Rational -> Rational -> Property -> l a -> Drawer l a
    drawer = Rational -> Rational -> Property -> l a -> Drawer l a
    forall (l :: * -> *) a.
    Rational -> Rational -> Property -> l a -> Drawer l a
    Drawer

    onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
    onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
    onLeft = Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
    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 :: Drawer l a
    -> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
    onRight d :: Drawer l a
    d = ModifiedLayout (Drawer l) (Reflected l') a
    -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
    forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
    reflectHoriz (ModifiedLayout (Drawer l) (Reflected l') a
     -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a)
    -> (l' a -> ModifiedLayout (Drawer l) (Reflected l') a)
    -> l' a
    -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Drawer l a
    -> ModifiedLayout Reflect l' a
    -> ModifiedLayout (Drawer l) (Reflected l') a
    forall (l :: * -> *) a (l' :: * -> *).
    Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
    onLeft Drawer l a
    d (ModifiedLayout Reflect l' a
     -> ModifiedLayout (Drawer l) (Reflected l') a)
    -> (l' a -> ModifiedLayout Reflect l' a)
    -> l' a
    -> ModifiedLayout (Drawer l) (Reflected l') a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . l' a -> ModifiedLayout Reflect l' a
    forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
    reflectHoriz

    onTop :: Drawer l a -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
    onTop :: Drawer l a
    -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
    onTop d :: Drawer l a
    d = ModifiedLayout (Drawer l) (Mirror l') a
    -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
    forall (l :: * -> *) a. l a -> Mirror l a
    Mirror (ModifiedLayout (Drawer l) (Mirror l') a
     -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a)
    -> (l' a -> ModifiedLayout (Drawer l) (Mirror l') a)
    -> l' a
    -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Drawer l a
    -> Mirror l' a -> ModifiedLayout (Drawer l) (Mirror l') a
    forall (l :: * -> *) a (l' :: * -> *).
    Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
    onLeft Drawer l a
    d (Mirror l' a -> ModifiedLayout (Drawer l) (Mirror l') a)
    -> (l' a -> Mirror l' a)
    -> l' a
    -> ModifiedLayout (Drawer l) (Mirror l') a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . l' a -> Mirror l' a
    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 :: Drawer l a
    -> l' a
    -> Reflected
         (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
    onBottom d :: Drawer l a
    d = Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a
    -> Reflected
         (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
    forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
    reflectVert (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a
     -> Reflected
          (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a)
    -> (l' a
        -> Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a)
    -> l' a
    -> Reflected
         (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Drawer l a
    -> ModifiedLayout Reflect l' a
    -> Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a
    forall (l :: * -> *) a (l' :: * -> *).
    Drawer l a
    -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
    onTop Drawer l a
    d (ModifiedLayout Reflect l' a
     -> Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a)
    -> (l' a -> ModifiedLayout Reflect l' a)
    -> l' a
    -> Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l'))) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . l' a -> ModifiedLayout Reflect l' a
    forall (l :: * -> *) a. l a -> ModifiedLayout Reflect l a
    reflectVert