{-# 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
--
-- A floating layout which has been designed with a dual-head setup
-- in mind. It makes use of "XMonad.Util.PositionStore" as well as
-- "XMonad.Hooks.PositionStoreHooks" . Since there is currently no way
-- to move or resize windows with the keyboard alone in this layout,
-- it is adviced to use it in combination with a decoration such as
-- "XMonad.Layout.NoFrillsDecoration" (to move windows) and the
-- layout modifier "XMonad.Layout.BorderResize" (to resize windows).
--
-----------------------------------------------------------------------------

module XMonad.Layout.PositionStoreFloat
    ( -- * Usage
      -- $usage
      positionStoreFloat, PositionStoreFloat
    ) where

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

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.PositionStoreFloat
-- > import XMonad.Layout.NoFrillsDecoration
-- > import XMonad.Layout.BorderResize
--
-- Then edit your @layoutHook@ by adding the PositionStoreFloat layout.
-- Below is a suggestion which uses the mentioned NoFrillsDecoration and
-- BorderResize:
--
-- > myLayouts = floatingDeco $ borderResize $ positionStoreFloat ||| etc..
-- >               where floatingDeco l = noFrillsDeco shrinkText def l
-- > main = xmonad def { layoutHook = myLayouts }
--
-- See the documentation of "XMonad.Hooks.PositionStoreHooks" on how
-- to add the support hooks.

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
            posStore <- getPosStore
            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 -> []