    ----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Hooks.PositionStoreHooks
    -- Description :  Hooks for XMonad.Util.PositionStore.
    -- Copyright   :  (c) Jan Vornberger 2009
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
    -- Stability   :  unstable
    -- Portability :  not portable
    --
    -- This module contains two hooks for the
    -- PositionStore (see "XMonad.Util.PositionStore") - a ManageHook and
    -- an EventHook.
    --
    -- The ManageHook can be used to fill the PositionStore with position and size
    -- information about new windows. The advantage of using this hook is, that the
    -- information is recorded independent of the currently active layout. So the
    -- floating shape of the window can later be restored even if it was opened in a
    -- tiled layout initially.
    --
    -- For windows, that do not request a particular position, a random position will
    -- be assigned. This prevents windows from piling up exactly on top of each other.
    --
    -- The EventHook makes sure that windows are deleted from the PositionStore
    -- when they are closed.
    --
    -----------------------------------------------------------------------------

    module XMonad.Hooks.PositionStoreHooks (
        -- * Usage
        -- $usage
        positionStoreManageHook,
        positionStoreEventHook
        ) where

    import XMonad
    import XMonad.Prelude
    import qualified XMonad.StackSet as W
    import XMonad.Util.PositionStore
    import XMonad.Hooks.ManageDocks
    import XMonad.Layout.Decoration

    import System.Random(randomRIO)
    import qualified Data.Set as S

    -- $usage
    -- You can use this module with the following in your @xmonad.hs@:
    --
    -- > import XMonad.Hooks.PositionStoreHooks
    --
    -- and adding 'positionStoreManageHook' to your 'ManageHook' as well
    -- as 'positionStoreEventHook' to your event hooks. To be accurate
    -- about window sizes, the module needs to know if any decoration is in effect.
    -- This is specified with the first argument: Supply 'Nothing' for no decoration,
    -- otherwise use 'Just def' or similar to inform the module about the
    -- decoration theme used.
    --
    -- > myManageHook = positionStoreManageHook Nothing <> manageHook def
    -- > myHandleEventHook = positionStoreEventHook
    -- >
    -- > main = xmonad def { manageHook = myManageHook
    -- >                   , handleEventHook = myHandleEventHook
    -- >                   }
    --

    positionStoreManageHook :: Maybe Theme -> ManageHook
    positionStoreManageHook :: Maybe Theme -> Query (Endo WindowSet)
    positionStoreManageHook Maybe Theme
    mDecoTheme = Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask Query Window -> (Window -> Query ()) -> Query ()
    forall a b. Query a -> (a -> Query b) -> Query b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= X () -> Query ()
    forall a. X a -> Query a
    liftX (X () -> Query ()) -> (Window -> X ()) -> Window -> Query ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe Theme -> Window -> X ()
    positionStoreInit Maybe Theme
    mDecoTheme Query () -> Query (Endo WindowSet) -> Query (Endo WindowSet)
    forall a b. Query a -> Query b -> Query b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Query (Endo WindowSet)
    forall m. Monoid m => m
    idHook

    positionStoreInit :: Maybe Theme -> Window -> X ()
    positionStoreInit :: Maybe Theme -> Window -> X ()
    positionStoreInit Maybe Theme
    mDecoTheme Window
    w  = (Display -> X ()) -> X ()
    forall a. (Display -> X a) -> X a
    withDisplay ((Display -> X ()) -> X ()) -> (Display -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \Display
    d -> Display -> Window -> (WindowAttributes -> X ()) -> X ()
    withWindowAttributes Display
    d Window
    w ((WindowAttributes -> X ()) -> X ())
    -> (WindowAttributes -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \WindowAttributes
    wa -> do
            let decoH :: EventType
    decoH = EventType -> (Theme -> EventType) -> Maybe Theme -> EventType
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe EventType
    0 Theme -> EventType
    decoHeight Maybe Theme
    mDecoTheme   -- take decoration into account, which - in its current
                                                        -- form - makes windows smaller to make room for it
            ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
            arbitraryOffsetX <- randomIntOffset
            arbitraryOffsetY <- randomIntOffset
            if (wa_x wa == 0) && (wa_y wa == 0)
                then do
                    let sr@(Rectangle srX srY _ _) = screenRect . W.screenDetail . W.current $ ws
                    modifyPosStore (\PositionStore
    ps -> PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore
    posStoreInsert PositionStore
    ps Window
    w
                                            (Position -> Position -> EventType -> EventType -> Rectangle
    Rectangle (Position
    srX Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    arbitraryOffsetX)
                                                       (Position
    srY Position -> Position -> Position
    forall a. Num a => a -> a -> a
    + Int -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    arbitraryOffsetY)
                                                        (CInt -> EventType
    forall a b. (Integral a, Num b) => a -> b
    fi (CInt -> EventType) -> CInt -> EventType
    forall a b. (a -> b) -> a -> b
    $ WindowAttributes -> CInt
    wa_width WindowAttributes
    wa)
                                                        (EventType
    decoH EventType -> EventType -> EventType
    forall a. Num a => a -> a -> a
    + CInt -> EventType
    forall a b. (Integral a, Num b) => a -> b
    fi (WindowAttributes -> CInt
    wa_height WindowAttributes
    wa))) Rectangle
    sr )
                else do
                    sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
                    let sr = ScreenDetail -> Rectangle
    screenRect (ScreenDetail -> Rectangle)
    -> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
        -> ScreenDetail)
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Rectangle
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenDetail
    forall i l a sid sd. Screen i l a sid sd -> sd
    W.screenDetail (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
     -> Rectangle)
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Rectangle
    forall a b. (a -> b) -> a -> b
    $ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    sc
                    sr' <- fmap ($ sr) (calcGap $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting
                                                                                           -- a somewhat unfortunate inter-dependency
                                                                                           -- with 'XMonad.Hooks.ManageDocks'
                    modifyPosStore (\PositionStore
    ps -> PositionStore -> Window -> Rectangle -> Rectangle -> PositionStore
    posStoreInsert PositionStore
    ps Window
    w
                                            (Position -> Position -> EventType -> EventType -> Rectangle
    Rectangle (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (CInt -> Position) -> CInt -> Position
    forall a b. (a -> b) -> a -> b
    $ WindowAttributes -> CInt
    wa_x WindowAttributes
    wa) (CInt -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi (WindowAttributes -> CInt
    wa_y WindowAttributes
    wa) Position -> Position -> Position
    forall a. Num a => a -> a -> a
    - EventType -> Position
    forall a b. (Integral a, Num b) => a -> b
    fi EventType
    decoH)
                                                (CInt -> EventType
    forall a b. (Integral a, Num b) => a -> b
    fi (CInt -> EventType) -> CInt -> EventType
    forall a b. (a -> b) -> a -> b
    $ WindowAttributes -> CInt
    wa_width WindowAttributes
    wa) (EventType
    decoH EventType -> EventType -> EventType
    forall a. Num a => a -> a -> a
    + CInt -> EventType
    forall a b. (Integral a, Num b) => a -> b
    fi (WindowAttributes -> CInt
    wa_height WindowAttributes
    wa))) Rectangle
    sr' )
        where
            randomIntOffset :: X Int
            randomIntOffset :: X Int
    randomIntOffset = IO Int -> X Int
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Int -> X Int) -> IO Int -> X Int
    forall a b. (a -> b) -> a -> b
    $ (Int, Int) -> IO Int
    forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
    randomRIO (Int
    42, Int
    242)

    positionStoreEventHook :: Event -> X All
    positionStoreEventHook :: Event -> X All
    positionStoreEventHook DestroyWindowEvent{ev_window :: Event -> Window
    ev_window = Window
    w, ev_event_type :: Event -> EventType
    ev_event_type = EventType
    et} = do
        Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (EventType
    et EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventType
    destroyNotify) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $
            (PositionStore -> PositionStore) -> X ()
    modifyPosStore (PositionStore -> Window -> PositionStore
    `posStoreRemove` Window
    w)
        All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)
    positionStoreEventHook Event
    _ = All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)