    {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module       : XMonad.Layout.MagicFocus
    -- Description :  Automagically put the focused window in the master area.
    -- Copyright    : (c) Peter De Wachter <pdewacht@gmail.com>
    -- License      : BSD
    --
    -- Maintainer   : Peter De Wachter <pdewacht@gmail.com>
    -- Stability    : unstable
    -- Portability  : unportable
    --
    -- Automagically put the focused window in the master area.
    -----------------------------------------------------------------------------

    module XMonad.Layout.MagicFocus
        (-- * Usage
         -- $usage
         magicFocus,
         promoteWarp,
         promoteWarp',
         followOnlyIf,
         disableFollowOnWS,
         MagicFocus,
        ) where

    import XMonad
    import qualified XMonad.StackSet as W
    import XMonad.Layout.LayoutModifier

    import XMonad.Actions.UpdatePointer (updatePointer)
    import XMonad.Prelude(All(..))
    import qualified Data.Map as M

    -- $usage
    -- You can use this module with the following in your @xmonad.hs@:
    --
    -- > import XMonad.Layout.MagicFocus
    --
    -- Then edit your @layoutHook@ by adding the magicFocus layout
    -- modifier:
    --
    -- > myLayout = magicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
    -- > main = xmonad def { layoutHook = myLayout,
    -- >                     handleEventHook = promoteWarp }
    --
    -- For more detailed instructions on editing the layoutHook see
    -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
    -- "XMonad.Doc.Extending#Editing_the_layout_hook".

    -- | Create a new layout which automagically puts the focused window
    --   in the master area.
    magicFocus :: l a -> ModifiedLayout MagicFocus l a
    magicFocus :: forall (l :: * -> *) a. l a -> ModifiedLayout MagicFocus l a
    magicFocus = MagicFocus a -> l a -> ModifiedLayout MagicFocus l a
    forall (m :: * -> *) (l :: * -> *) a.
    m a -> l a -> ModifiedLayout m l a
    ModifiedLayout MagicFocus a
    forall a. MagicFocus a
    MagicFocus

    data MagicFocus a = MagicFocus deriving (Int -> MagicFocus a -> ShowS
    [MagicFocus a] -> ShowS
    MagicFocus a -> WorkspaceId
    (Int -> MagicFocus a -> ShowS)
    -> (MagicFocus a -> WorkspaceId)
    -> ([MagicFocus a] -> ShowS)
    -> Show (MagicFocus a)
    forall a. Int -> MagicFocus a -> ShowS
    forall a. [MagicFocus a] -> ShowS
    forall a. MagicFocus a -> WorkspaceId
    forall a.
    (Int -> a -> ShowS)
    -> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Int -> MagicFocus a -> ShowS
    showsPrec :: Int -> MagicFocus a -> ShowS
    $cshow :: forall a. MagicFocus a -> WorkspaceId
    show :: MagicFocus a -> WorkspaceId
    $cshowList :: forall a. [MagicFocus a] -> ShowS
    showList :: [MagicFocus a] -> ShowS
    Show, ReadPrec [MagicFocus a]
    ReadPrec (MagicFocus a)
    Int -> ReadS (MagicFocus a)
    ReadS [MagicFocus a]
    (Int -> ReadS (MagicFocus a))
    -> ReadS [MagicFocus a]
    -> ReadPrec (MagicFocus a)
    -> ReadPrec [MagicFocus a]
    -> Read (MagicFocus a)
    forall a. ReadPrec [MagicFocus a]
    forall a. ReadPrec (MagicFocus a)
    forall a. Int -> ReadS (MagicFocus a)
    forall a. ReadS [MagicFocus a]
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: forall a. Int -> ReadS (MagicFocus a)
    readsPrec :: Int -> ReadS (MagicFocus a)
    $creadList :: forall a. ReadS [MagicFocus a]
    readList :: ReadS [MagicFocus a]
    $creadPrec :: forall a. ReadPrec (MagicFocus a)
    readPrec :: ReadPrec (MagicFocus a)
    $creadListPrec :: forall a. ReadPrec [MagicFocus a]
    readListPrec :: ReadPrec [MagicFocus a]
    Read)

    instance LayoutModifier MagicFocus Window where
      modifyLayout :: forall (l :: * -> *).
    LayoutClass l Window =>
    MagicFocus Window
    -> Workspace WorkspaceId (l Window) Window
    -> Rectangle
    -> X ([(Window, Rectangle)], Maybe (l Window))
    modifyLayout MagicFocus Window
    MagicFocus (W.Workspace WorkspaceId
    i l Window
    l Maybe (Stack Window)
    s) =
        Workspace WorkspaceId (l Window) Window
    -> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    Workspace WorkspaceId (layout a) a
    -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
    runLayout (WorkspaceId
    -> l Window
    -> Maybe (Stack Window)
    -> Workspace WorkspaceId (l Window) Window
    forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
    W.Workspace WorkspaceId
    i l Window
    l (Maybe (Stack Window)
    s Maybe (Stack Window)
    -> (Stack Window -> Maybe (Stack Window)) -> Maybe (Stack Window)
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Stack Window -> Maybe (Stack Window)
    forall a. a -> Maybe a
    Just (Stack Window -> Maybe (Stack Window))
    -> (Stack Window -> Stack Window)
    -> Stack Window
    -> Maybe (Stack Window)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Stack Window -> Stack Window
    forall a. Eq a => Stack a -> Stack a
    shift))

    shift :: (Eq a) => W.Stack a -> W.Stack a
    shift :: forall a. Eq a => Stack a -> Stack a
    shift (W.Stack a
    f [a]
    u [a]
    d) = a -> [a] -> [a] -> Stack a
    forall a. a -> [a] -> [a] -> Stack a
    W.Stack a
    f [] ([a] -> [a]
    forall a. [a] -> [a]
    reverse [a]
    u [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    d)

    -- | An eventHook that overrides the normal focusFollowsMouse. When the mouse
    -- it moved to another window, that window is replaced as the master, and the
    -- mouse is warped to inside the new master.
    --
    -- It prevents infinite loops when focusFollowsMouse is true (the default), and
    -- MagicFocus is in use when changing focus with the mouse.
    --
    -- This eventHook does nothing when there are floating windows on the current
    -- workspace.
    promoteWarp :: Event -> X All
    promoteWarp :: Event -> X All
    promoteWarp = (Rational, Rational) -> (Rational, Rational) -> Event -> X All
    promoteWarp' (Rational
    0.5, Rational
    0.5) (Rational
    0.85, Rational
    0.85)

    -- | promoteWarp' allows you to specify an arbitrary pair of arguments to
    -- pass to 'updatePointer' when the mouse enters another window.
    promoteWarp' :: (Rational, Rational) -> (Rational, Rational) -> Event -> X All
    promoteWarp' :: (Rational, Rational) -> (Rational, Rational) -> Event -> X All
    promoteWarp' (Rational, Rational)
    refPos (Rational, Rational)
    ratio e :: Event
    e@CrossingEvent{ev_window :: Event -> Window
    ev_window = Window
    w, ev_event_type :: Event -> EventType
    ev_event_type = EventType
    t}
        | EventType
    t EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventType
    enterNotify Bool -> Bool -> Bool
    && Event -> NotifyMode
    ev_mode   Event
    e NotifyMode -> NotifyMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == NotifyMode
    notifyNormal = do
            WindowSet
    ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
            let foc :: Maybe Window
    foc = WindowSet -> Maybe Window
    forall i l a s sd. StackSet i l a s sd -> Maybe a
    W.peek WindowSet
    ws
                st :: [Window]
    st = Maybe (Stack Window) -> [Window]
    forall a. Maybe (Stack a) -> [a]
    W.integrate' (Maybe (Stack Window) -> [Window])
    -> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
        -> Maybe (Stack Window))
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace WorkspaceId (Layout Window) Window
    -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack (Workspace WorkspaceId (Layout Window) Window
     -> Maybe (Stack Window))
    -> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
        -> Workspace WorkspaceId (Layout Window) Window)
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WorkspaceId (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
     -> [Window])
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> [Window]
    forall a b. (a -> b) -> a -> b
    $ WindowSet
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current WindowSet
    ws
                wsFloats :: Map Window RationalRect
    wsFloats = (Window -> RationalRect -> Bool)
    -> Map Window RationalRect -> Map Window RationalRect
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    M.filterWithKey (\Window
    k RationalRect
    _ -> Window
    k Window -> [Window] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Window]
    st) (Map Window RationalRect -> Map Window RationalRect)
    -> Map Window RationalRect -> Map Window RationalRect
    forall a b. (a -> b) -> a -> b
    $ WindowSet -> Map Window RationalRect
    forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
    W.floating WindowSet
    ws
            if Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    w Maybe Window -> Maybe Window -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe Window
    foc Bool -> Bool -> Bool
    && Map Window RationalRect -> Bool
    forall k a. Map k a -> Bool
    M.null Map Window RationalRect
    wsFloats then do
                (WindowSet -> WindowSet) -> X ()
    windows (WindowSet -> WindowSet
    forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
    W.swapMaster (WindowSet -> WindowSet)
    -> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Window -> WindowSet -> WindowSet
    forall s a i l sd.
    (Eq s, Eq a, Eq i) =>
    a -> StackSet i l a s sd -> StackSet i l a s sd
    W.focusWindow Window
    w)
                (Rational, Rational) -> (Rational, Rational) -> X ()
    updatePointer (Rational, Rational)
    refPos (Rational, Rational)
    ratio
                All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (All -> X All) -> All -> X All
    forall a b. (a -> b) -> a -> b
    $ Bool -> All
    All Bool
    False
              else All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (All -> X All) -> All -> X All
    forall a b. (a -> b) -> a -> b
    $ Bool -> All
    All Bool
    True
    promoteWarp' (Rational, Rational)
    _ (Rational, Rational)
    _ Event
    _ = All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (All -> X All) -> All -> X All
    forall a b. (a -> b) -> a -> b
    $ Bool -> All
    All Bool
    True

    -- | Another event hook to override the focusFollowsMouse and make the pointer
    -- only follow if a given condition is satisfied. This could be used to disable
    -- focusFollowsMouse only for given workspaces or layouts.
    -- Beware that your focusFollowsMouse setting is ignored if you use this event hook.
    followOnlyIf :: X Bool -> Event -> X All
    followOnlyIf :: X Bool -> Event -> X All
    followOnlyIf X Bool
    cond e :: Event
    e@CrossingEvent{ev_window :: Event -> Window
    ev_window = Window
    w, ev_event_type :: Event -> EventType
    ev_event_type = EventType
    t}
        | EventType
    t EventType -> EventType -> Bool
    forall a. Eq a => a -> a -> Bool
    == EventType
    enterNotify Bool -> Bool -> Bool
    && Event -> NotifyMode
    ev_mode Event
    e NotifyMode -> NotifyMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == NotifyMode
    notifyNormal
        = X Bool -> X () -> X ()
    whenX X Bool
    cond (Window -> X ()
    focus Window
    w) X () -> X All -> X All
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    False)
    followOnlyIf X Bool
    _ Event
    _ = All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (All -> X All) -> All -> X All
    forall a b. (a -> b) -> a -> b
    $ Bool -> All
    All Bool
    True

    -- | Disables focusFollow on the given workspaces:
    disableFollowOnWS :: [WorkspaceId] -> X Bool
    disableFollowOnWS :: [WorkspaceId] -> X Bool
    disableFollowOnWS [WorkspaceId]
    wses = (WorkspaceId -> [WorkspaceId] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [WorkspaceId]
    wses) (WorkspaceId -> Bool) -> X WorkspaceId -> X Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (XState -> WorkspaceId) -> X WorkspaceId
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (WindowSet -> WorkspaceId
    forall i l a s sd. StackSet i l a s sd -> i
    W.currentTag (WindowSet -> WorkspaceId)
    -> (XState -> WindowSet) -> XState -> WorkspaceId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState -> WindowSet
    windowset)