{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# LANGUAGE MultiParamTypeClasses, Rank2Types, ViewPatterns #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Groups.Helpers
-- Description :  Utility functions for "XMonad.Layout.Groups".
-- Copyright   :  Quentin Moser <moserq@gmail.com>
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  orphaned
-- Stability   :  stable
-- Portability :  unportable
--
-- Utility functions for "XMonad.Layout.Groups".
--
-----------------------------------------------------------------------------

module XMonad.Layout.Groups.Helpers ( -- * Usage
                                      -- $usage

                                      -- ** Layout-generic actions
                                      swapUp
                                    , swapDown
                                    , swapMaster
                                    , focusUp
                                    , focusDown
                                    , focusMaster
                                    , toggleFocusFloat

                                      -- ** 'G.Groups'-secific actions
                                    , swapGroupUp
                                    , swapGroupDown
                                    , swapGroupMaster
                                    , focusGroupUp
                                    , focusGroupDown
                                    , focusGroupMaster
                                    , moveToGroupUp
                                    , moveToGroupDown
                                    , moveToNewGroupUp
                                    , moveToNewGroupDown
                                    , splitGroup ) where

import XMonad hiding ((|||))
import qualified XMonad.StackSet as W

import qualified XMonad.Layout.Groups as G

import XMonad.Actions.MessageFeedback (sendMessageB)

import XMonad.Prelude (unless)
import qualified Data.Map as M

-- $usage
--
-- This module provides helpers functions for use with "XMonad.Layout.Groups"-based
-- layouts. You can use its contents by adding
--
-- > import XMonad.Layout.Groups.Helpers
--
-- to the top of your @.\/.xmonad\/xmonad.hs@.
--
-- "XMonad.Layout.Groups"-based layouts do not have the same notion
-- of window ordering as the rest of XMonad. For this reason, the usual
-- ways of reordering windows and moving focus do not work with them.
-- "XMonad.Layout.Groups" provides 'Message's that can be used to obtain
-- the right effect.
--
-- But what if you want to use both 'G.Groups' and other layouts?
-- This module provides actions that try to send 'G.GroupsMessage's, and
-- fall back to the classic way if the current layout doesn't hande them.
-- They are in the section called \"Layout-generic actions\".
--
-- The sections \"Groups-specific actions\" contains actions that don't make
-- sense for non-'G.Groups'-based layouts. These are simply wrappers around
-- the equivalent 'G.GroupsMessage's, but are included so you don't have to
-- write @sendMessage $ Modify $ ...@ everytime.
--
-- This module exports many operations with the same names as
-- 'G.ModifySpec's from "XMonad.Layout.Groups", so if you want
-- to import both, we suggest to import "XMonad.Layout.Groups"
-- qualified:
--
-- > import qualified XMonad.Layout.Groups as G
--
-- For more information on how to extend your layour hook and key bindings, see
-- "XMonad.Doc.Extending".

-- ** Layout-generic actions
-- #Layout-generic actions#

alt :: G.ModifySpec -> (WindowSet -> WindowSet) -> X ()
alt :: ModifySpec -> (WindowSet -> WindowSet) -> X ()
alt ModifySpec
f WindowSet -> WindowSet
g = GroupsMessage -> X () -> X ()
alt2 (ModifySpec -> GroupsMessage
G.Modify ModifySpec
f) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows WindowSet -> WindowSet
g

alt2 :: G.GroupsMessage -> X () -> X ()
alt2 :: GroupsMessage -> X () -> X ()
alt2 GroupsMessage
m X ()
x = do Bool
b <- GroupsMessage -> X Bool
forall a. Message a => a -> X Bool
sendMessageB GroupsMessage
m
              Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b X ()
x

-- | Swap the focused window with the previous one
swapUp :: X ()
swapUp :: X ()
swapUp = ModifySpec -> (WindowSet -> WindowSet) -> X ()
alt ModifySpec
G.swapUp WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapUp

-- | Swap the focused window with the next one
swapDown :: X ()
swapDown :: X ()
swapDown = ModifySpec -> (WindowSet -> WindowSet) -> X ()
alt ModifySpec
G.swapDown WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapDown

-- | Swap the focused window with the master window
swapMaster :: X ()
swapMaster :: X ()
swapMaster = ModifySpec -> (WindowSet -> WindowSet) -> X ()
alt ModifySpec
G.swapMaster WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapMaster

-- | If the focused window is floating, focus the next floating
-- window. otherwise, focus the next non-floating one.
focusUp :: X ()
focusUp :: X ()
focusUp = X () -> X () -> X ()
ifFloat X ()
focusFloatUp X ()
focusNonFloatUp

-- | If the focused window is floating, focus the next floating
-- window. otherwise, focus the next non-floating one.
focusDown :: X ()
focusDown :: X ()
focusDown = X () -> X () -> X ()
ifFloat X ()
focusFloatDown X ()
focusNonFloatDown

-- | Move focus to the master window
focusMaster :: X ()
focusMaster :: X ()
focusMaster = ModifySpec -> (WindowSet -> WindowSet) -> X ()
alt ModifySpec
G.focusMaster WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster

-- | Move focus between the floating and non-floating layers
toggleFocusFloat :: X ()
toggleFocusFloat :: X ()
toggleFocusFloat = X () -> X () -> X ()
ifFloat X ()
focusNonFloat X ()
focusFloatUp

-- *** Floating layer helpers

getFloats :: X [Window]
getFloats :: X [Window]
getFloats = (XState -> [Window]) -> X [Window]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [Window]) -> X [Window])
-> (XState -> [Window]) -> X [Window]
forall a b. (a -> b) -> a -> b
$ Map Window RationalRect -> [Window]
forall k a. Map k a -> [k]
M.keys (Map Window RationalRect -> [Window])
-> (XState -> Map Window RationalRect) -> XState -> [Window]
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

getWindows :: X [Window]
getWindows :: X [Window]
getWindows = (XState -> [Window]) -> X [Window]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [Window]) -> X [Window])
-> (XState -> [Window]) -> X [Window]
forall a b. (a -> b) -> a -> b
$ Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack Window) -> [Window])
-> (XState -> Maybe (Stack Window)) -> XState -> [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))
-> (XState -> Workspace WorkspaceId (Layout Window) Window)
-> XState
-> 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
 -> Workspace WorkspaceId (Layout Window) Window)
-> (XState
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> (XState -> WindowSet)
-> XState
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset

ifFloat :: X () -> X () -> X ()
ifFloat :: X () -> X () -> X ()
ifFloat X ()
x1 X ()
x2 = (Window -> X ()) -> X ()
withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
w -> do [Window]
floats <- X [Window]
getFloats
                                       if Window
w Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
floats then X ()
x1 else X ()
x2

focusNonFloat :: X ()
focusNonFloat :: X ()
focusNonFloat = GroupsMessage -> X () -> X ()
alt2 GroupsMessage
G.Refocus X ()
helper
    where helper :: X ()
helper = (Window -> X ()) -> X ()
withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
w -> do
                     [Window]
ws <- X [Window]
getWindows
                     [Window]
floats <- X [Window]
getFloats
                     let ([Window]
before,  [Window]
after) = (Window -> Bool) -> [Window] -> ([Window], [Window])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/=Window
w) [Window]
ws
                     case (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Window]
floats) ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ [Window]
after [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window]
before of
                       [] -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                       Window
w':[Window]
_ -> Window -> X ()
focus Window
w'

focusHelper :: (Bool -> Bool) -- ^ if you want to focus a floating window, 'id'.
                              -- if you want a non-floating one, 'not'.
            -> ([Window] -> [Window]) -- ^ if you want the next window, 'id'.
                                      -- if you want the previous one, 'reverse'.
            -> X ()
focusHelper :: (Bool -> Bool) -> ([Window] -> [Window]) -> X ()
focusHelper Bool -> Bool
f [Window] -> [Window]
g = (Window -> X ()) -> X ()
withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
w -> do
                 [Window]
ws <- X [Window]
getWindows
                 let ([Window]
before, [Window] -> [Window]
forall a. [a] -> [a]
tail -> [Window]
after) = (Window -> Bool) -> [Window] -> ([Window], [Window])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/=Window
w) [Window]
ws
                 let toFocus :: [Window]
toFocus = [Window] -> [Window]
g ([Window] -> [Window]) -> [Window] -> [Window]
forall a b. (a -> b) -> a -> b
$ [Window]
after [Window] -> [Window] -> [Window]
forall a. [a] -> [a] -> [a]
++ [Window]
before
                 [Window]
floats <- X [Window]
getFloats
                 case (Window -> Bool) -> [Window] -> [Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
f (Bool -> Bool) -> (Window -> Bool) -> Window -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> [Window] -> Bool) -> [Window] -> Window -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Window]
floats) [Window]
toFocus of
                   [] -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   Window
w':[Window]
_ -> Window -> X ()
focus Window
w'


focusNonFloatUp :: X ()
focusNonFloatUp :: X ()
focusNonFloatUp = GroupsMessage -> X () -> X ()
alt2 (ModifySpec -> GroupsMessage
G.Modify ModifySpec
G.focusUp) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> ([Window] -> [Window]) -> X ()
focusHelper Bool -> Bool
not [Window] -> [Window]
forall a. [a] -> [a]
reverse

focusNonFloatDown :: X ()
focusNonFloatDown :: X ()
focusNonFloatDown = GroupsMessage -> X () -> X ()
alt2 (ModifySpec -> GroupsMessage
G.Modify ModifySpec
G.focusDown) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> ([Window] -> [Window]) -> X ()
focusHelper Bool -> Bool
not [Window] -> [Window]
forall a. a -> a
id

focusFloatUp :: X ()
focusFloatUp :: X ()
focusFloatUp = (Bool -> Bool) -> ([Window] -> [Window]) -> X ()
focusHelper Bool -> Bool
forall a. a -> a
id [Window] -> [Window]
forall a. [a] -> [a]
reverse

focusFloatDown :: X ()
focusFloatDown :: X ()
focusFloatDown = (Bool -> Bool) -> ([Window] -> [Window]) -> X ()
focusHelper Bool -> Bool
forall a. a -> a
id [Window] -> [Window]
forall a. a -> a
id


-- ** Groups-specific actions

wrap :: G.ModifySpec -> X ()
wrap :: ModifySpec -> X ()
wrap ModifySpec
x = GroupsMessage -> X ()
forall a. Message a => a -> X ()
sendMessage (ModifySpec -> GroupsMessage
G.Modify ModifySpec
x)

-- | Swap the focused group with the previous one
swapGroupUp :: X ()
swapGroupUp :: X ()
swapGroupUp = ModifySpec -> X ()
wrap ModifySpec
G.swapGroupUp

-- | Swap the focused group with the next one
swapGroupDown :: X ()
swapGroupDown :: X ()
swapGroupDown = ModifySpec -> X ()
wrap ModifySpec
G.swapGroupDown

-- | Swap the focused group with the master group
swapGroupMaster :: X ()
swapGroupMaster :: X ()
swapGroupMaster = ModifySpec -> X ()
wrap ModifySpec
G.swapGroupMaster

-- | Move the focus to the previous group
focusGroupUp :: X ()
focusGroupUp :: X ()
focusGroupUp = ModifySpec -> X ()
wrap ModifySpec
G.focusGroupUp

-- | Move the focus to the next group
focusGroupDown :: X ()
focusGroupDown :: X ()
focusGroupDown = ModifySpec -> X ()
wrap ModifySpec
G.focusGroupDown

-- | Move the focus to the master group
focusGroupMaster :: X ()
focusGroupMaster :: X ()
focusGroupMaster = ModifySpec -> X ()
wrap ModifySpec
G.focusGroupMaster

-- | Move the focused window to the previous group. The 'Bool' argument
-- determines what will be done if the focused window is in the very first
-- group: Wrap back to the end ('True'), or create a new group before
-- it ('False').
moveToGroupUp :: Bool -> X ()
moveToGroupUp :: Bool -> X ()
moveToGroupUp Bool
b = ModifySpec -> X ()
wrap (Bool -> ModifySpec
G.moveToGroupUp Bool
b)

-- | Move the focused window to the next group. The 'Bool' argument
-- determines what will be done if the focused window is in the very last
-- group: Wrap back to the beginning ('True'), or create a new group after
-- it ('False').
moveToGroupDown :: Bool -> X ()
moveToGroupDown :: Bool -> X ()
moveToGroupDown Bool
b = ModifySpec -> X ()
wrap (Bool -> ModifySpec
G.moveToGroupDown Bool
b)

-- | Move the focused window to a new group before the current one
moveToNewGroupUp :: X ()
moveToNewGroupUp :: X ()
moveToNewGroupUp = ModifySpec -> X ()
wrap ModifySpec
G.moveToNewGroupUp

-- | Move the focused window to a new group after the current one
moveToNewGroupDown :: X ()
moveToNewGroupDown :: X ()
moveToNewGroupDown = ModifySpec -> X ()
wrap ModifySpec
G.moveToNewGroupDown

-- | Split the focused group in two at the position of the focused
-- window.
splitGroup :: X ()
splitGroup :: X ()
splitGroup = ModifySpec -> X ()
wrap ModifySpec
G.splitGroup