    {-# 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