content: {-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Layout.LayoutBuilderP
  -- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>, 2011 Ilya Portnov <portnov84@rambler.ru>
  -- License     :  BSD3-style (see LICENSE)
  --
  -- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
  -- Stability   :  unstable
  -- Portability :  unportable
  --
  -- A layout combinator that sends windows matching given predicate to one rectangle
  -- and the rest to another.
  --
  -----------------------------------------------------------------------------
  
  module XMonad.Layout.LayoutBuilderP (
    LayoutP (..),
    layoutP, layoutAll,
    B.relBox, B.absBox,
    -- * Overloading ways to select windows
    -- $selectWin
    Predicate (..), Proxy(..),
    ) where
  
  import Control.Monad
  import Data.Maybe (isJust)
  
  import XMonad
  import qualified XMonad.StackSet as W
  import XMonad.Util.WindowProperties
  
  import qualified XMonad.Layout.LayoutBuilder as B
  
  -- $selectWin
  --
  -- 'Predicate' exists because layouts are required to be serializable, and
  -- "XMonad.Util.WindowProperties" is not sufficient (for example it does not
  -- allow using regular expressions).
  --
  -- compare "XMonad.Util.Invisible"
  
  -- | Type class for predicates. This enables us to manage not only Windows,
  -- but any objects, for which instance Predicate is defined.
  --
  -- Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras
  class Predicate p w where
    alwaysTrue :: Proxy w -> p         -- ^ A predicate that is always True.
    checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate
  
  -- | Contains no actual data, but is needed to help select the correct instance
  -- of 'Predicate'
  data Proxy a = Proxy
  
  -- | Data type for our layout.
  data LayoutP p l1 l2 a =
      LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a))
      deriving (Show,Read)
  
  -- | Use the specified layout in the described area windows that match given predicate and send the rest of the windows to the next layout in the chain.
  --   It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout.
  layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) =>
         p
      -> B.SubBox                       -- ^ The box to place the windows in
      -> Maybe B.SubBox                 -- ^ Possibly an alternative box that is used when this layout handles all windows that are left
      -> l1 a                         -- ^ The layout to use in the specified area
      -> LayoutP p l2 l3 a              -- ^ Where to send the remaining windows
      -> LayoutP p l1 (LayoutP p l2 l3) a -- ^ The resulting layout
  layoutP prop box mbox sub next = LayoutP Nothing Nothing prop box mbox sub (Just next)
  
  -- | Use the specified layout in the described area for all remaining windows.
  layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) =>
         B.SubBox             -- ^ The box to place the windows in
      -> l1 a               -- ^ The layout to use in the specified area
      -> LayoutP p l1 Full a  -- ^ The resulting layout
  layoutAll box sub =
    let a = alwaysTrue (Proxy :: Proxy a)
    in  LayoutP Nothing Nothing a box Nothing sub Nothing
  
  instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p) =>
      LayoutClass (LayoutP p l1 l2) w where
  
          -- | Update window locations.
          runLayout (W.Workspace _ (LayoutP subf nextf prop box mbox sub next) s) rect
              = do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf
                   let selBox = if isJust nextf'
                                  then box
                                  else maybe box id mbox
  
                   (sublist,sub') <- handle sub subs $ calcArea selBox rect
  
                   (nextlist,next') <- case next of Nothing -> return ([],Nothing)
                                                    Just n -> do (res,l) <- handle n nexts rect
                                                                 return (res,Just l)
  
                   return (sublist++nextlist, Just $ LayoutP subf' nextf' prop box mbox sub' next' )
                where
                    handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r
                                       l' <- return $ maybe l id ml
                                       return (res,l')
  
          -- |  Propagate messages.
          handleMessage l m
              | Just (IncMasterN _) <- fromMessage m = sendFocus l m
              | Just (Shrink) <- fromMessage m = sendFocus l m
              | Just (Expand) <- fromMessage m = sendFocus l m
              | otherwise = sendBoth l m
  
          -- |  Descriptive name for layout.
          description (LayoutP _ _ _ _ _ sub (Just next)) = "layoutP "++ description sub ++" "++ description next
          description (LayoutP _ _ _ _ _ sub Nothing)     = "layoutP "++ description sub
  
  
  sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
          => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
  sendSub (LayoutP subf nextf prop box mbox sub next) m =
      do sub' <- handleMessage sub m
         return $ if isJust sub'
                  then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') next
                  else Nothing
  
  sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
           => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
  sendBoth l@(LayoutP _ _ _ _ _ _ Nothing) m = sendSub l m
  sendBoth (LayoutP subf nextf prop box mbox sub (Just next)) m =
      do sub' <- handleMessage sub m
         next' <- handleMessage next m
         return $ if isJust sub' || isJust next'
                  then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') (Just $ maybe next id next')
                  else Nothing
  
  sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
           => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
  sendNext (LayoutP _ _ _ _ _ _ Nothing) _ = return Nothing
  sendNext (LayoutP subf nextf prop box mbox sub (Just next)) m =
      do next' <- handleMessage next m
         return $ if isJust next'
                  then Just $ LayoutP subf nextf prop box mbox sub next'
                  else Nothing
  
  sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
            => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
  sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf
                                                if foc then sendSub l m
                                                       else sendNext l m
  
  isFocus :: (Show a) => Maybe a -> X Bool
  isFocus Nothing = return False
  isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset
                        return $ maybe False (\s -> show w == (show $ W.focus s)) ms
  
  
  -- | Split given list of objects (i.e. windows) using predicate.
  splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w])
  splitBy prop ws = foldM step ([], []) ws
    where
      step (good, bad) w = do
        ok <- checkPredicate prop w
        return $ if ok
                  then (w:good, bad)
                  else (good,   w:bad)
  
  splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w)
  splitStack Nothing _ _ _ = return (Nothing,Nothing,Nothing,Nothing)
  splitStack (Just s) prop subf nextf = do
      let ws = W.integrate s
      (good, other) <- splitBy prop ws
      let subf'  = foc good subf
          nextf' = foc other nextf
      return ( differentiate' subf' good
             , differentiate' nextf' other
             , subf'
             , nextf'
             )
    where
      foc [] _ = Nothing
      foc l f = if W.focus s `elem` l
                then Just $ W.focus s
                else if maybe False (`elem` l) f
                     then f
                     else Just $ head l
  
  calcArea :: B.SubBox -> Rectangle -> Rectangle
  calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height'
      where
          xpos' = calc False xpos $ rect_width rect
          ypos' = calc False ypos $ rect_height rect
          width' = calc True width $ rect_width rect - xpos'
          height' = calc True height $ rect_height rect - ypos'
  
          calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $
              case val of B.Rel v -> floor $ v * fromIntegral tot
                          B.Abs v -> if v<0 || (zneg && v==0)
                                   then (fromIntegral tot)+v
                                   else v
  
  differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)
  differentiate' _ [] = Nothing
  differentiate' Nothing w = W.differentiate w
  differentiate' (Just f) w
      | f `elem` w = Just $ W.Stack { W.focus = f
                                    , W.up    = reverse $ takeWhile (/=f) w
                                    , W.down  = tail $ dropWhile (/=f) w
                                    }
      | otherwise = W.differentiate w
  
  instance Predicate Property Window where
    alwaysTrue _ = Const True
    checkPredicate = hasProperty
  
  