module XMonad.Layout.LimitWindows (
    
    
    
    limitWindows,limitSlice,limitSelect,
    
    increaseLimit,decreaseLimit,setLimit,
#ifdef TESTING
    
    select,update,Selection(..),updateAndSelect,
#endif
    
    LimitWindows, Selection,
    ) where
import XMonad.Layout.LayoutModifier
import XMonad
import qualified XMonad.StackSet as W
import Control.Monad((<=<),guard)
import Control.Applicative((<$>))
import Data.Maybe(fromJust)
increaseLimit :: X ()
increaseLimit = sendMessage $ LimitChange succ
decreaseLimit :: X ()
decreaseLimit = sendMessage . LimitChange $ max 1 . pred
setLimit :: Int -> X ()
setLimit tgt = sendMessage . LimitChange $ const tgt
limitWindows :: Int -> l a -> ModifiedLayout LimitWindows l a
limitWindows n = ModifiedLayout (LimitWindows FirstN n)
limitSlice :: Int -> l a -> ModifiedLayout LimitWindows l a
limitSlice n = ModifiedLayout (LimitWindows Slice n)
limitSelect :: Int -> Int -> l a -> ModifiedLayout Selection l a
limitSelect m r = ModifiedLayout Sel{ nMaster=m, start=m, nRest=r }
data LimitWindows a = LimitWindows SliceStyle Int deriving (Read,Show)
data SliceStyle = FirstN | Slice deriving (Read,Show)
data LimitChange = LimitChange { unLC :: (Int -> Int) } deriving (Typeable)
instance Message LimitChange
instance LayoutModifier LimitWindows a where
     pureMess (LimitWindows s n) =
        fmap (LimitWindows s) . pos <=< (`app` n) . unLC <=< fromMessage
      where pos x   = guard (x>=1)     >> return x
            app f x = guard (f x /= x) >>  return (f x)
     modifyLayout (LimitWindows style n) ws r =
        runLayout ws { W.stack = f n <$> W.stack ws } r
      where f = case style of
                    FirstN -> firstN
                    Slice -> slice
firstN ::  Int -> W.Stack a -> W.Stack a
firstN n st = upfocus $ fromJust $ W.differentiate $ take (max 1 n) $ W.integrate st
    where upfocus = foldr (.) id $ replicate (length (W.up st)) W.focusDown'
slice ::  Int -> W.Stack t -> W.Stack t
slice n (W.Stack f u d) =
        W.Stack f (take (nu + unusedD) u)
                  (take (nd + unusedU) d)
    where unusedD = max 0 $ nd  length d
          unusedU = max 0 $ nu  length u
          nd = div (n  1) 2
          nu = uncurry (+) $ divMod (n  1) 2
data Selection a = Sel { nMaster :: Int, start :: Int, nRest :: Int }
    deriving (Read, Show, Eq)
instance LayoutModifier Selection a where
    modifyLayout s w r =
        runLayout (w { W.stack = updateAndSelect s <$> W.stack w }) r
    pureModifier sel _ stk wins = (wins, update sel <$> stk)
    pureMess sel m
        | Just f <- unLC <$> fromMessage m =
            Just $ sel { nRest = max 0 (f (nMaster sel + nRest sel)  nMaster sel) }
        | Just (IncMasterN n) <- fromMessage m =
            Just $ sel { nMaster = max 0 (nMaster sel + n) }
        | otherwise =
            Nothing
select :: Selection l -> W.Stack a -> W.Stack a
select s stk
    | lups < nMaster s
        = stk { W.down=take (nMaster s  lups  1) downs ++
                    (take (nRest s) . drop (start s  lups  1) $ downs) }
    | otherwise
        = stk { W.up=reverse (take (nMaster s) ups ++ drop (start s) ups),
                W.down=take ((nRest s)  (lups  start s)  1) downs }
    where
        downs = W.down stk
        ups = reverse $ W.up stk
        lups = length ups
updateStart :: Selection l -> W.Stack a -> Int
updateStart s stk
    | lups < nMaster s  
        = start s `min` (lups + ldown  (nRest s) + 1) `max` nMaster s
    | otherwise
        = start s `min` lups
                  `max` (lups  (nRest s) + 1)
                  `min` (lups + ldown  (nRest s) + 1)
                  `max` nMaster s
    where
        lups = length $ W.up stk
        ldown = length $ W.down stk
update :: Selection l -> W.Stack a -> Selection a
update sel stk = sel { start=updateStart sel stk }
updateAndSelect :: Selection l -> W.Stack a -> W.Stack a
updateAndSelect sel stk = select (update sel stk) stk