content: {-# 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 (Read, Show)
  
  -- | filter : filterM :: partition : partitionM
  partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
  partitionM _ [] = return ([], [])
  partitionM f (x:xs) = do
      b <- f x
      (ys, zs) <- partitionM f xs
      return $ if b
                  then (x:ys, zs)
                  else (ys, x:zs)
  
  instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Window where
      modifyLayout (Drawer rs rb p l) ws rect =
          case stack ws of
              Nothing -> runLayout ws rect
              Just stk@(Stack { up=up_, down=down_, S.focus=w }) -> do
                      (upD, upM) <- partitionM (hasProperty p) up_
                      (downD, downM) <- partitionM (hasProperty p) down_
                      b <- hasProperty p w
                      focusedWindow <- gets (fmap S.focus . stack . workspace . current . windowset)
  
                      let rectD = if b && Just w == focusedWindow then rectB else rectS
  
                      let (stackD, stackM) = if b
                                              then ( Just $ stk { up=upD, down=downD }
                                                   , mkStack upM downM )
                                              else ( mkStack upD downD
                                                   , Just $ stk { up=upM, down=downM } )
  
                      (winsD, _) <- runLayout (ws { layout=l, stack=stackD }) rectD
                      (winsM, u') <- runLayout (ws { stack=stackM }) rectM
                      return (winsD ++ winsM, u')
        where
          mkStack [] [] = Nothing
          mkStack xs (y:ys) = Just (Stack { up=xs, S.focus=y, down=ys })
          mkStack (x:xs) ys = Just (Stack { up=xs, S.focus=x, down=ys })
  
          rectB = rect { rect_width=round $ fromIntegral (rect_width rect) * rb }
          rectS = rectB { rect_x=rect_x rectB - (round $ (rb - rs) * fromIntegral (rect_width rect)) }
          rectM = rect { rect_x=rect_x rect + round (fromIntegral (rect_width rect) * rs)
                       , rect_width=rect_width rect - round (fromIntegral (rect_width rect) * 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 rs rb p = Drawer rs rb p vertical
      where
          vertical = 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 = Drawer
  
  onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
  onLeft = ModifiedLayout
  
  onRight :: Drawer l a -> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
  onRight d = reflectHoriz . onLeft d . reflectHoriz
  
  onTop :: Drawer l a -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
  onTop d = Mirror . onLeft d . Mirror
  
  onBottom :: Drawer l a -> l' a -> Reflected (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
  onBottom d = reflectVert . onTop d . reflectVert
  