    {-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-}
    ----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.PositionStoreFloat
    -- Description :  A floating layout; designed with a dual-head setup in mind.
    -- 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 XMonad.Prelude (fromMaybe, isJust, nub, when)

    -- $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 :: forall a. PositionStoreFloat a
    positionStoreFloat = (Maybe Rectangle, [a]) -> PositionStoreFloat a
    forall a. (Maybe Rectangle, [a]) -> PositionStoreFloat a
    PSF (Maybe Rectangle
    forall a. Maybe a
    Nothing, [])

    newtype PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Int -> PositionStoreFloat a -> ShowS
    [PositionStoreFloat a] -> ShowS
    PositionStoreFloat a -> String
    (Int -> PositionStoreFloat a -> ShowS)
    -> (PositionStoreFloat a -> String)
    -> ([PositionStoreFloat a] -> ShowS)
    -> Show (PositionStoreFloat a)
    forall a. Show a => Int -> PositionStoreFloat a -> ShowS
    forall a. Show a => [PositionStoreFloat a] -> ShowS
    forall a. Show a => PositionStoreFloat a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> PositionStoreFloat a -> ShowS
    showsPrec :: Int -> PositionStoreFloat a -> ShowS
    $cshow :: forall a. Show a => PositionStoreFloat a -> String
    show :: PositionStoreFloat a -> String
    $cshowList :: forall a. Show a => [PositionStoreFloat a] -> ShowS
    showList :: [PositionStoreFloat a] -> ShowS
    Show, ReadPrec [PositionStoreFloat a]
    ReadPrec (PositionStoreFloat a)
    Int -> ReadS (PositionStoreFloat a)
    ReadS [PositionStoreFloat a]
    (Int -> ReadS (PositionStoreFloat a))
    -> ReadS [PositionStoreFloat a]
    -> ReadPrec (PositionStoreFloat a)
    -> ReadPrec [PositionStoreFloat a]
    -> Read (PositionStoreFloat a)
    forall a. Read a => ReadPrec [PositionStoreFloat a]
    forall a. Read a => ReadPrec (PositionStoreFloat a)
    forall a. Read a => Int -> ReadS (PositionStoreFloat a)
    forall a. Read a => ReadS [PositionStoreFloat a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Read a => Int -> ReadS (PositionStoreFloat a)
    readsPrec :: Int -> ReadS (PositionStoreFloat a)
    $creadList :: forall a. Read a => ReadS [PositionStoreFloat a]
    readList :: ReadS [PositionStoreFloat a]
    $creadPrec :: forall a. Read a => ReadPrec (PositionStoreFloat a)
    readPrec :: ReadPrec (PositionStoreFloat a)
    $creadListPrec :: forall a. Read a => ReadPrec [PositionStoreFloat a]
    readListPrec :: ReadPrec [PositionStoreFloat a]
    Read)
    instance LayoutClass PositionStoreFloat Window where
        description :: PositionStoreFloat Window -> String
    description PositionStoreFloat Window
    _ = String
    "PSF"
        doLayout :: PositionStoreFloat Window
    -> Rectangle
    -> Stack Window
    -> X ([(Window, Rectangle)], Maybe (PositionStoreFloat Window))
    doLayout (PSF (Maybe Rectangle
    maybeChange, [Window]
    paintOrder)) Rectangle
    sr (S.Stack Window
    w [Window]
    l [Window]
    r) = do
                PositionStore
    posStore <- X PositionStore
    getPosStore
                let wrs :: [(Window, Rectangle)]
    wrs = (Window -> (Window, Rectangle))
    -> [Window] -> [(Window, Rectangle)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Window
    w' -> (Window
    w', PositionStore -> Window -> Rectangle -> Rectangle
    pSQ PositionStore
    posStore Window
    w' Rectangle
    sr)) ([Window] -> [Window]
    forall a. [a] -> [a]
    reverse [Window]
    l [Window] -> [Window] -> [Window]
    forall a. [a] -> [a] -> [a]
    ++ [Window]
    r)
                let focused :: (Window, Rectangle)
    focused = case Maybe Rectangle
    maybeChange of
                                Maybe Rectangle
    Nothing -> (Window
    w, PositionStore -> Window -> Rectangle -> Rectangle
    pSQ PositionStore
    posStore Window
    w Rectangle
    sr)
                                Just Rectangle
    changedRect -> (Window
    w, Rectangle
    changedRect)
                let wrs' :: [(Window, Rectangle)]
    wrs' = (Window, Rectangle)
    focused (Window, Rectangle)
    -> [(Window, Rectangle)] -> [(Window, Rectangle)]
    forall a. a -> [a] -> [a]
    : [(Window, Rectangle)]
    wrs
                let paintOrder' :: [Window]
    paintOrder' = [Window] -> [Window]
    forall a. Eq a => [a] -> [a]
    nub (Window
    w Window -> [Window] -> [Window]
    forall a. a -> [a] -> [a]
    : [Window]
    paintOrder)
                Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe Rectangle -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Rectangle
    maybeChange) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $
                    (Window, Rectangle) -> Rectangle -> X ()
    updatePositionStore (Window, Rectangle)
    focused Rectangle
    sr
                ([(Window, Rectangle)], Maybe (PositionStoreFloat Window))
    -> X ([(Window, Rectangle)], Maybe (PositionStoreFloat Window))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Window, Rectangle)] -> [Window] -> [(Window, Rectangle)]
    forall a b. Eq a => [(a, b)] -> [a] -> [(a, b)]
    reorder [(Window, Rectangle)]
    wrs' [Window]
    paintOrder', PositionStoreFloat Window -> Maybe (PositionStoreFloat Window)
    forall a. a -> Maybe a
    Just (PositionStoreFloat Window -> Maybe (PositionStoreFloat Window))
    -> PositionStoreFloat Window -> Maybe (PositionStoreFloat Window)
    forall a b. (a -> b) -> a -> b
    $ (Maybe Rectangle, [Window]) -> PositionStoreFloat Window
    forall a. (Maybe Rectangle, [a]) -> PositionStoreFloat a
    PSF (Maybe Rectangle
    forall a. Maybe a
    Nothing, [Window]
    paintOrder'))
            where
                pSQ :: PositionStore -> Window -> Rectangle -> Rectangle
    pSQ PositionStore
    posStore Window
    w' Rectangle
    sr' = Rectangle -> Maybe Rectangle -> Rectangle
    forall a. a -> Maybe a -> a
    fromMaybe (Position -> Position -> Dimension -> Dimension -> Rectangle
    Rectangle Position
    50 Position
    50 Dimension
    200 Dimension
    200)       -- should usually not happen
                                                (PositionStore -> Window -> Rectangle -> Maybe Rectangle
    posStoreQuery PositionStore
    posStore Window
    w' Rectangle
    sr')
        pureMessage :: PositionStoreFloat Window
    -> SomeMessage -> Maybe (PositionStoreFloat Window)
    pureMessage (PSF (Maybe Rectangle
    _, [Window]
    paintOrder)) SomeMessage
    m
            | Just (SetGeometry Rectangle
    rect) <- SomeMessage -> Maybe WindowArrangerMsg
    forall m. Message m => SomeMessage -> Maybe m
    fromMessage SomeMessage
    m =
                PositionStoreFloat Window -> Maybe (PositionStoreFloat Window)
    forall a. a -> Maybe a
    Just (PositionStoreFloat Window -> Maybe (PositionStoreFloat Window))
    -> PositionStoreFloat Window -> Maybe (PositionStoreFloat Window)
    forall a b. (a -> b) -> a -> b
    $ (Maybe Rectangle, [Window]) -> PositionStoreFloat Window
    forall a. (Maybe Rectangle, [a]) -> PositionStoreFloat a
    PSF (Rectangle -> Maybe Rectangle
    forall a. a -> Maybe a
    Just Rectangle
    rect, [Window]
    paintOrder)
            | Bool
    otherwise = Maybe (PositionStoreFloat Window)
    forall a. Maybe a
    Nothing

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

    reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)]
    reorder :: forall a b. Eq a => [(a, b)] -> [a] -> [(a, b)]
    reorder [(a, b)]
    wrs [a]
    order =
        let ordered :: [(a, b)]
    ordered = (a -> [(a, b)]) -> [a] -> [(a, b)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ([(a, b)] -> a -> [(a, b)]
    forall {a} {b}. Eq a => [(a, b)] -> a -> [(a, b)]
    pickElem [(a, b)]
    wrs) [a]
    order
            rest :: [(a, b)]
    rest = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(a
    w, b
    _) -> a
    w a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [a]
    order) [(a, b)]
    wrs
        in [(a, b)]
    ordered [(a, b)] -> [(a, b)] -> [(a, b)]
    forall a. [a] -> [a] -> [a]
    ++ [(a, b)]
    rest
        where
            pickElem :: [(a, b)] -> a -> [(a, b)]
    pickElem [(a, b)]
    list a
    e = case a -> [(a, b)] -> Maybe b
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup a
    e [(a, b)]
    list of
                                    Just b
    result -> [(a
    e, b
    result)]
                                    Maybe b
    Nothing -> []