    -- |
    -- Module      :  XMonad.Actions.ToggleFullFloat
    -- Description :  Fullscreen (float) a window while remembering its original state.
    -- Copyright   :  (c) 2022 Tomáš Janoušek <tomi@nomi.cz>
    -- License     :  BSD3
    -- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>
    --
    module XMonad.Actions.ToggleFullFloat (
        -- * Usage
        -- $usage
        toggleFullFloatEwmhFullscreen,
        toggleFullFloat,
        fullFloat,
        unFullFloat,
        gcToggleFullFloat,
        ) where

    import qualified Data.Map.Strict as M

    import XMonad
    import XMonad.Prelude
    import XMonad.Hooks.EwmhDesktops (setEwmhFullscreenHooks)
    import XMonad.Hooks.ManageHelpers
    import qualified XMonad.StackSet as W
    import qualified XMonad.Util.ExtensibleState as XS

    -- ---------------------------------------------------------------------
    -- $usage
    --
    -- The main use-case is to make 'ewmhFullscreen' (re)store the size and
    -- position of floating windows instead of just unconditionally sinking them
    -- into the floating layer. To enable this, you'll need this in your
    -- @xmonad.hs@:
    --
    -- > import XMonad
    -- > import XMonad.Actions.ToggleFullFloat
    -- > import XMonad.Hooks.EwmhDesktops
    -- >
    -- > main = xmonad $ … . toggleFullFloatEwmhFullscreen . ewmhFullscreen . ewmh . … $ def{…}
    --
    -- Additionally, this "smart" fullscreening can be bound to a key and invoked
    -- manually whenever one needs a larger window temporarily:
    --
    -- >   , ((modMask .|. shiftMask, xK_t), withFocused toggleFullFloat)

    newtype ToggleFullFloat = ToggleFullFloat{ ToggleFullFloat -> Map Window (Maybe RationalRect)
    fromToggleFullFloat :: M.Map Window (Maybe W.RationalRect) }
        deriving (Int -> ToggleFullFloat -> ShowS
    [ToggleFullFloat] -> ShowS
    ToggleFullFloat -> String
    (Int -> ToggleFullFloat -> ShowS)
    -> (ToggleFullFloat -> String)
    -> ([ToggleFullFloat] -> ShowS)
    -> Show ToggleFullFloat
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ToggleFullFloat -> ShowS
    showsPrec :: Int -> ToggleFullFloat -> ShowS
    $cshow :: ToggleFullFloat -> String
    show :: ToggleFullFloat -> String
    $cshowList :: [ToggleFullFloat] -> ShowS
    showList :: [ToggleFullFloat] -> ShowS
    Show, ReadPrec [ToggleFullFloat]
    ReadPrec ToggleFullFloat
    Int -> ReadS ToggleFullFloat
    ReadS [ToggleFullFloat]
    (Int -> ReadS ToggleFullFloat)
    -> ReadS [ToggleFullFloat]
    -> ReadPrec ToggleFullFloat
    -> ReadPrec [ToggleFullFloat]
    -> Read ToggleFullFloat
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS ToggleFullFloat
    readsPrec :: Int -> ReadS ToggleFullFloat
    $creadList :: ReadS [ToggleFullFloat]
    readList :: ReadS [ToggleFullFloat]
    $creadPrec :: ReadPrec ToggleFullFloat
    readPrec :: ReadPrec ToggleFullFloat
    $creadListPrec :: ReadPrec [ToggleFullFloat]
    readListPrec :: ReadPrec [ToggleFullFloat]
    Read)

    instance ExtensionClass ToggleFullFloat where
        extensionType :: ToggleFullFloat -> StateExtension
    extensionType = ToggleFullFloat -> StateExtension
    forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
    PersistentExtension
        initialValue :: ToggleFullFloat
    initialValue = Map Window (Maybe RationalRect) -> ToggleFullFloat
    ToggleFullFloat Map Window (Maybe RationalRect)
    forall a. Monoid a => a
    mempty

    -- | Full-float a window, remembering its state (tiled/floating and
    -- position/size).
    fullFloat :: Window -> X ()
    fullFloat :: Window -> X ()
    fullFloat = (WindowSet -> WindowSet) -> X ()
    windows ((WindowSet -> WindowSet) -> X ())
    -> (Endo WindowSet -> WindowSet -> WindowSet)
    -> Endo WindowSet
    -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Endo WindowSet -> WindowSet -> WindowSet
    forall a. Endo a -> a -> a
    appEndo (Endo WindowSet -> X ())
    -> (Window -> X (Endo WindowSet)) -> Window -> X ()
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Query (Endo WindowSet) -> Window -> X (Endo WindowSet)
    forall a. Query a -> Window -> X a
    runQuery Query (Endo WindowSet)
    doFullFloatSave

    -- | Restore window to its remembered state.
    unFullFloat :: Window -> X ()
    unFullFloat :: Window -> X ()
    unFullFloat = (WindowSet -> WindowSet) -> X ()
    windows ((WindowSet -> WindowSet) -> X ())
    -> (Endo WindowSet -> WindowSet -> WindowSet)
    -> Endo WindowSet
    -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Endo WindowSet -> WindowSet -> WindowSet
    forall a. Endo a -> a -> a
    appEndo (Endo WindowSet -> X ())
    -> (Window -> X (Endo WindowSet)) -> Window -> X ()
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< Query (Endo WindowSet) -> Window -> X (Endo WindowSet)
    forall a. Query a -> Window -> X a
    runQuery Query (Endo WindowSet)
    doFullFloatRestore

    -- | Full-float a window, if it's not already full-floating. Otherwise,
    -- restore its original state.
    toggleFullFloat :: Window -> X ()
    toggleFullFloat :: Window -> X ()
    toggleFullFloat Window
    w = X Bool -> X () -> X () -> X ()
    forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
    ifM (Window -> X Bool
    isFullFloat Window
    w) (Window -> X ()
    unFullFloat Window
    w) (Window -> X ()
    fullFloat Window
    w)

    isFullFloat :: Window -> X Bool
    isFullFloat :: Window -> X Bool
    isFullFloat Window
    w = (XState -> Bool) -> X Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XState -> Bool) -> X Bool) -> (XState -> Bool) -> X Bool
    forall a b. (a -> b) -> a -> b
    $ (RationalRect -> Maybe RationalRect
    forall a. a -> Maybe a
    Just RationalRect
    fullRect Maybe RationalRect -> Maybe RationalRect -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (Maybe RationalRect -> Bool)
    -> (XState -> Maybe RationalRect) -> XState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Window -> Map Window RationalRect -> Maybe RationalRect
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Window
    w (Map Window RationalRect -> Maybe RationalRect)
    -> (XState -> Map Window RationalRect)
    -> XState
    -> Maybe RationalRect
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet -> Map Window RationalRect
    forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
    W.floating (WindowSet -> Map Window RationalRect)
    -> (XState -> WindowSet) -> XState -> Map Window RationalRect
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState -> WindowSet
    windowset
      where
        fullRect :: RationalRect
    fullRect = Rational -> Rational -> Rational -> Rational -> RationalRect
    W.RationalRect Rational
    0 Rational
    0 Rational
    1 Rational
    1

    doFullFloatSave :: ManageHook
    doFullFloatSave :: Query (Endo WindowSet)
    doFullFloatSave = do
        Window
    w <- Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        X () -> Query ()
    forall a. X a -> Query a
    liftX (X () -> Query ()) -> X () -> Query ()
    forall a b. (a -> b) -> a -> b
    $ do
            Maybe RationalRect
    f <- (XState -> Maybe RationalRect) -> X (Maybe RationalRect)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets ((XState -> Maybe RationalRect) -> X (Maybe RationalRect))
    -> (XState -> Maybe RationalRect) -> X (Maybe RationalRect)
    forall a b. (a -> b) -> a -> b
    $ Window -> Map Window RationalRect -> Maybe RationalRect
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Window
    w (Map Window RationalRect -> Maybe RationalRect)
    -> (XState -> Map Window RationalRect)
    -> XState
    -> Maybe RationalRect
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet -> Map Window RationalRect
    forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
    W.floating (WindowSet -> Map Window RationalRect)
    -> (XState -> WindowSet) -> XState -> Map Window RationalRect
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState -> WindowSet
    windowset
            -- @M.insertWith const@ = don't overwrite stored original state
            (ToggleFullFloat -> ToggleFullFloat) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    XS.modify' ((ToggleFullFloat -> ToggleFullFloat) -> X ())
    -> (ToggleFullFloat -> ToggleFullFloat) -> X ()
    forall a b. (a -> b) -> a -> b
    $ Map Window (Maybe RationalRect) -> ToggleFullFloat
    ToggleFullFloat (Map Window (Maybe RationalRect) -> ToggleFullFloat)
    -> (ToggleFullFloat -> Map Window (Maybe RationalRect))
    -> ToggleFullFloat
    -> ToggleFullFloat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Maybe RationalRect -> Maybe RationalRect -> Maybe RationalRect)
    -> Window
    -> Maybe RationalRect
    -> Map Window (Maybe RationalRect)
    -> Map Window (Maybe RationalRect)
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith Maybe RationalRect -> Maybe RationalRect -> Maybe RationalRect
    forall a b. a -> b -> a
    const Window
    w Maybe RationalRect
    f (Map Window (Maybe RationalRect)
     -> Map Window (Maybe RationalRect))
    -> (ToggleFullFloat -> Map Window (Maybe RationalRect))
    -> ToggleFullFloat
    -> Map Window (Maybe RationalRect)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ToggleFullFloat -> Map Window (Maybe RationalRect)
    fromToggleFullFloat
        Query (Endo WindowSet)
    doFullFloat

    doFullFloatRestore :: ManageHook
    doFullFloatRestore :: Query (Endo WindowSet)
    doFullFloatRestore = do
        Window
    w <- Query Window
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        Maybe (Maybe RationalRect)
    mf <- X (Maybe (Maybe RationalRect))
    -> Query (Maybe (Maybe RationalRect))
    forall a. X a -> Query a
    liftX (X (Maybe (Maybe RationalRect))
     -> Query (Maybe (Maybe RationalRect)))
    -> X (Maybe (Maybe RationalRect))
    -> Query (Maybe (Maybe RationalRect))
    forall a b. (a -> b) -> a -> b
    $ do
            Maybe (Maybe RationalRect)
    mf <- (ToggleFullFloat -> Maybe (Maybe RationalRect))
    -> X (Maybe (Maybe RationalRect))
    forall a (m :: * -> *) b.
    (ExtensionClass a, XLike m) =>
    (a -> b) -> m b
    XS.gets ((ToggleFullFloat -> Maybe (Maybe RationalRect))
     -> X (Maybe (Maybe RationalRect)))
    -> (ToggleFullFloat -> Maybe (Maybe RationalRect))
    -> X (Maybe (Maybe RationalRect))
    forall a b. (a -> b) -> a -> b
    $ Window
    -> Map Window (Maybe RationalRect) -> Maybe (Maybe RationalRect)
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Window
    w (Map Window (Maybe RationalRect) -> Maybe (Maybe RationalRect))
    -> (ToggleFullFloat -> Map Window (Maybe RationalRect))
    -> ToggleFullFloat
    -> Maybe (Maybe RationalRect)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ToggleFullFloat -> Map Window (Maybe RationalRect)
    fromToggleFullFloat
            (ToggleFullFloat -> ToggleFullFloat) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    XS.modify' ((ToggleFullFloat -> ToggleFullFloat) -> X ())
    -> (ToggleFullFloat -> ToggleFullFloat) -> X ()
    forall a b. (a -> b) -> a -> b
    $ Map Window (Maybe RationalRect) -> ToggleFullFloat
    ToggleFullFloat (Map Window (Maybe RationalRect) -> ToggleFullFloat)
    -> (ToggleFullFloat -> Map Window (Maybe RationalRect))
    -> ToggleFullFloat
    -> ToggleFullFloat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Window
    -> Map Window (Maybe RationalRect)
    -> Map Window (Maybe RationalRect)
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete Window
    w (Map Window (Maybe RationalRect)
     -> Map Window (Maybe RationalRect))
    -> (ToggleFullFloat -> Map Window (Maybe RationalRect))
    -> ToggleFullFloat
    -> Map Window (Maybe RationalRect)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ToggleFullFloat -> Map Window (Maybe RationalRect)
    fromToggleFullFloat
            Maybe (Maybe RationalRect) -> X (Maybe (Maybe RationalRect))
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe (Maybe RationalRect)
    mf
        (WindowSet -> WindowSet) -> Query (Endo WindowSet)
    forall s. (s -> s) -> Query (Endo s)
    doF ((WindowSet -> WindowSet) -> Query (Endo WindowSet))
    -> (WindowSet -> WindowSet) -> Query (Endo WindowSet)
    forall a b. (a -> b) -> a -> b
    $ case Maybe (Maybe RationalRect)
    mf of
            Just (Just RationalRect
    f) -> Window -> RationalRect -> WindowSet -> WindowSet
    forall a i l s sd.
    Ord a =>
    a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
    W.float Window
    w RationalRect
    f  -- was floating before
            Just Maybe RationalRect
    Nothing -> Window -> WindowSet -> WindowSet
    forall a i l s sd.
    Ord a =>
    a -> StackSet i l a s sd -> StackSet i l a s sd
    W.sink Window
    w      -- was tiled before
            Maybe (Maybe RationalRect)
    Nothing -> Window -> WindowSet -> WindowSet
    forall a i l s sd.
    Ord a =>
    a -> StackSet i l a s sd -> StackSet i l a s sd
    W.sink Window
    w           -- fallback when not found in ToggleFullFloat

    -- | Install ToggleFullFloat garbage collection hooks.
    --
    -- Note: This is included in 'toggleFullFloatEwmhFullscreen', only needed if
    -- using the 'toggleFullFloat' separately from the EWMH hook.
    gcToggleFullFloat :: XConfig a -> XConfig a
    gcToggleFullFloat :: forall (a :: * -> *). XConfig a -> XConfig a
    gcToggleFullFloat XConfig a
    c = XConfig a
    c { startupHook     = startupHook c <> gcToggleFullFloatStartupHook
                            , handleEventHook = handleEventHook c <> gcToggleFullFloatEventHook }

    -- | ToggleFullFloat garbage collection: drop windows when they're destroyed.
    gcToggleFullFloatEventHook :: Event -> X All
    gcToggleFullFloatEventHook :: Event -> X All
    gcToggleFullFloatEventHook DestroyWindowEvent{ev_window :: Event -> Window
    ev_window = Window
    w} = do
        (ToggleFullFloat -> ToggleFullFloat) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    XS.modify' ((ToggleFullFloat -> ToggleFullFloat) -> X ())
    -> (ToggleFullFloat -> ToggleFullFloat) -> X ()
    forall a b. (a -> b) -> a -> b
    $ Map Window (Maybe RationalRect) -> ToggleFullFloat
    ToggleFullFloat (Map Window (Maybe RationalRect) -> ToggleFullFloat)
    -> (ToggleFullFloat -> Map Window (Maybe RationalRect))
    -> ToggleFullFloat
    -> ToggleFullFloat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Window
    -> Map Window (Maybe RationalRect)
    -> Map Window (Maybe RationalRect)
    forall k a. Ord k => k -> Map k a -> Map k a
    M.delete Window
    w (Map Window (Maybe RationalRect)
     -> Map Window (Maybe RationalRect))
    -> (ToggleFullFloat -> Map Window (Maybe RationalRect))
    -> ToggleFullFloat
    -> Map Window (Maybe RationalRect)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ToggleFullFloat -> Map Window (Maybe RationalRect)
    fromToggleFullFloat
        X All
    forall a. Monoid a => a
    mempty
    gcToggleFullFloatEventHook Event
    _ = X All
    forall a. Monoid a => a
    mempty

    -- | ToggleFullFloat garbage collection: restrict to existing windows at
    -- startup.
    gcToggleFullFloatStartupHook :: X ()
    gcToggleFullFloatStartupHook :: X ()
    gcToggleFullFloatStartupHook = (WindowSet -> X ()) -> X ()
    forall a. (WindowSet -> X a) -> X a
    withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \WindowSet
    ws ->
        (ToggleFullFloat -> ToggleFullFloat) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    XS.modify' ((ToggleFullFloat -> ToggleFullFloat) -> X ())
    -> (ToggleFullFloat -> ToggleFullFloat) -> X ()
    forall a b. (a -> b) -> a -> b
    $ Map Window (Maybe RationalRect) -> ToggleFullFloat
    ToggleFullFloat (Map Window (Maybe RationalRect) -> ToggleFullFloat)
    -> (ToggleFullFloat -> Map Window (Maybe RationalRect))
    -> ToggleFullFloat
    -> ToggleFullFloat
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Window -> Maybe RationalRect -> Bool)
    -> Map Window (Maybe RationalRect)
    -> Map Window (Maybe RationalRect)
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    M.filterWithKey (\Window
    w Maybe RationalRect
    _ -> Window
    w Window -> WindowSet -> Bool
    forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Bool
    `W.member` WindowSet
    ws) (Map Window (Maybe RationalRect)
     -> Map Window (Maybe RationalRect))
    -> (ToggleFullFloat -> Map Window (Maybe RationalRect))
    -> ToggleFullFloat
    -> Map Window (Maybe RationalRect)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ToggleFullFloat -> Map Window (Maybe RationalRect)
    fromToggleFullFloat

    -- | Hook this module into 'XMonad.Hooks.EwmhDesktops.ewmhFullscreen'. This
    -- makes windows restore their original state (size and position if floating)
    -- instead of unconditionally sinking into the tiling layer.
    --
    -- ('gcToggleFullFloat' is included here.)
    toggleFullFloatEwmhFullscreen :: XConfig a -> XConfig a
    toggleFullFloatEwmhFullscreen :: forall (a :: * -> *). XConfig a -> XConfig a
    toggleFullFloatEwmhFullscreen =
        Query (Endo WindowSet)
    -> Query (Endo WindowSet) -> XConfig a -> XConfig a
    forall (l :: * -> *).
    Query (Endo WindowSet)
    -> Query (Endo WindowSet) -> XConfig l -> XConfig l
    setEwmhFullscreenHooks Query (Endo WindowSet)
    doFullFloatSave Query (Endo WindowSet)
    doFullFloatRestore (XConfig a -> XConfig a)
    -> (XConfig a -> XConfig a) -> XConfig a -> XConfig a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        XConfig a -> XConfig a
    forall (a :: * -> *). XConfig a -> XConfig a
    gcToggleFullFloat