{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-}
----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.PositionStoreFloat
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-----------------------------------------------------------------------------

module XMonad.Layout.PositionStoreFloat
    ( positionStoreFloat
    ) where

import XMonad
import XMonad.PositionStore
import qualified XMonad.StackSet as S
import XMonad.Layout.WindowArranger
import Control.Monad(when)
import Data.Maybe(isJust)
import Data.List(nub)

positionStoreFloat :: PositionStoreFloat a
positionStoreFloat = PSF (Nothing, [])

data PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Show, Read)
instance LayoutClass PositionStoreFloat Window where
    description _ = "PSF"
    doLayout (PSF (maybeChange, paintOrder)) sr (S.Stack w l r) = do
            XState { positionStore = posStore } <- get
            let wrs = map (\w' -> (w', pSQ posStore w' sr)) (reverse l ++ r)
            let focused = case maybeChange of
                            Nothing -> (w, pSQ posStore w sr)
                            Just changedRect -> (w, changedRect)
            let wrs' = focused : wrs
            let paintOrder' = nub (w : paintOrder)
            when (isJust maybeChange) $ do
                updatePositionStore focused sr
            return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder'))
        where
            pSQ posStore w' sr' = case (posStoreQuery posStore w' sr') of
                                    Just rect   -> rect
                                    Nothing     -> (Rectangle 50 50 200 200)  -- should usually not happen
    pureMessage (PSF (_, paintOrder)) m
        | Just (SetGeometry rect) <- fromMessage m =
            Just $ PSF (Just rect, paintOrder)
        | otherwise = Nothing

updatePositionStore :: (Window, Rectangle) -> Rectangle -> X ()
updatePositionStore (w, rect) sr = modifyPosStore (\ps ->
                                            posStoreInsert ps w rect sr)

reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)]
reorder wrs order =
    let ordered = concat $ map (pickElem wrs) order
        rest = filter (\(w, _) -> not (w `elem` order)) wrs
    in ordered ++ rest
    where
        pickElem list e = case (lookup e list) of
                                Just result -> [(e, result)]
                                Nothing -> []