-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.Plane
-- Description :  Navigate through workspaces in a bidimensional manner.
-- Copyright   :  (c) Marco Túlio Gontijo e Silva <marcot@riseup.net>,
--                    Leonardo Serra <leoserra@minaslivre.org>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Marco Túlio Gontijo e Silva <marcot@riseup.net>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module has functions to navigate through workspaces in a bidimensional
-- manner.  It allows the organization of workspaces in lines, and provides
-- functions to move and shift windows in all four directions (left, up, right
-- and down) possible in a surface.
--
-- This functionality was inspired by GNOME (finite) and KDE (infinite)
-- keybindings for workspace navigation, and by "XMonad.Actions.CycleWS" for
-- the idea of applying this approach to XMonad.
-----------------------------------------------------------------------------

module XMonad.Actions.Plane
    (
    -- * Usage
    -- $usage

    -- * Data types
    Direction (..)
    , Limits (..)
    , Lines (..)

    -- * Key bindings
    , planeKeys

    -- * Navigating through workspaces
    , planeShift
    , planeMove
    )
    where

import Data.Map (Map, fromList)

import XMonad.Prelude
import XMonad
import XMonad.StackSet hiding (workspaces)
import XMonad.Util.Run

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.Plane
-- > import Data.Map (union)
-- >
-- > main = xmonad def {keys = myKeys}
-- >
-- > myKeys conf = union (keys def conf) $ myNewKeys conf
-- >
-- > myNewKeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".

-- | Direction to go in the plane.
data Direction =  ToLeft | ToUp | ToRight | ToDown deriving Int -> Direction
Direction -> Int
Direction -> [Direction]
Direction -> Direction
Direction -> Direction -> [Direction]
Direction -> Direction -> Direction -> [Direction]
(Direction -> Direction)
-> (Direction -> Direction)
-> (Int -> Direction)
-> (Direction -> Int)
-> (Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> [Direction])
-> (Direction -> Direction -> Direction -> [Direction])
-> Enum Direction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
$cenumFromThenTo :: Direction -> Direction -> Direction -> [Direction]
enumFromTo :: Direction -> Direction -> [Direction]
$cenumFromTo :: Direction -> Direction -> [Direction]
enumFromThen :: Direction -> Direction -> [Direction]
$cenumFromThen :: Direction -> Direction -> [Direction]
enumFrom :: Direction -> [Direction]
$cenumFrom :: Direction -> [Direction]
fromEnum :: Direction -> Int
$cfromEnum :: Direction -> Int
toEnum :: Int -> Direction
$ctoEnum :: Int -> Direction
pred :: Direction -> Direction
$cpred :: Direction -> Direction
succ :: Direction -> Direction
$csucc :: Direction -> Direction
Enum

-- | Defines the behaviour when you're trying to move out of the limits.
data Limits
    = Finite   -- ^ Ignore the function call, and keep in the same workspace.
    | Circular -- ^ Get on the other side, like in the Snake game.
    | Linear   -- ^ The plan comes as a row, so it goes to the next or prev if
               -- the workspaces were numbered.
    deriving Limits -> Limits -> Bool
(Limits -> Limits -> Bool)
-> (Limits -> Limits -> Bool) -> Eq Limits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Limits -> Limits -> Bool
$c/= :: Limits -> Limits -> Bool
== :: Limits -> Limits -> Bool
$c== :: Limits -> Limits -> Bool
Eq

-- | The number of lines in which the workspaces will be arranged.  It's
-- possible to use a number of lines that is not a divisor of the number of
-- workspaces, but the results are better when using a divisor.  If it's not a
-- divisor, the last line will have the remaining workspaces.
data Lines
    = GConf     -- ^ Use @gconftool-2@ to find out the number of lines.
    | Lines Int -- ^ Specify the number of lines explicitly.

-- | This is the way most people would like to use this module.  It attaches the
-- 'KeyMask' passed as a parameter with 'xK_Left', 'xK_Up', 'xK_Right' and
-- 'xK_Down', associating it with 'planeMove' to the corresponding 'Direction'.
-- It also associates these bindings with 'shiftMask' to 'planeShift'.
planeKeys :: KeyMask -> Lines -> Limits -> Map (KeyMask, KeySym) (X ())
planeKeys :: KeyMask -> Lines -> Limits -> Map (KeyMask, Window) (X ())
planeKeys KeyMask
modm Lines
ln Limits
limits =
  [((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ()))
-> [((KeyMask, Window), X ())] -> Map (KeyMask, Window) (X ())
forall a b. (a -> b) -> a -> b
$
  [ ((KeyMask
keyMask, Window
keySym), Lines -> Limits -> Direction -> X ()
function Lines
ln Limits
limits Direction
direction)
  | (Window
keySym, Direction
direction) <- [Window] -> [Direction] -> [(Window, Direction)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Window
xK_Left .. Window
xK_Down] ([Direction] -> [(Window, Direction)])
-> [Direction] -> [(Window, Direction)]
forall a b. (a -> b) -> a -> b
$ Direction -> [Direction]
forall a. Enum a => a -> [a]
enumFrom Direction
ToLeft
  , (KeyMask
keyMask, Lines -> Limits -> Direction -> X ()
function) <- [(KeyMask
modm, Lines -> Limits -> Direction -> X ()
planeMove), (KeyMask
shiftMask KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
modm, Lines -> Limits -> Direction -> X ()
planeShift)]
  ]

-- | Shift a window to the next workspace in 'Direction'.  Note that this will
-- also move to the next workspace.  It's a good idea to use the same 'Lines'
-- and 'Limits' for all the bindings.
planeShift :: Lines -> Limits -> Direction -> X ()
planeShift :: Lines -> Limits -> Direction -> X ()
planeShift = (WorkspaceId -> WindowSet -> WindowSet)
-> Lines -> Limits -> Direction -> X ()
plane WorkspaceId -> WindowSet -> WindowSet
forall s i a l sd.
(Eq s, Eq i, Ord a) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
shift'

shift' ::
    (Eq s, Eq i, Ord a) => i -> StackSet i l a s sd -> StackSet i l a s sd
shift' :: forall s i a l sd.
(Eq s, Eq i, Ord a) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
shift' i
area = i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
greedyView i
area (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> StackSet i l a s sd -> StackSet i l a s sd
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
shift i
area

-- | Move to the next workspace in 'Direction'.
planeMove :: Lines -> Limits -> Direction -> X ()
planeMove :: Lines -> Limits -> Direction -> X ()
planeMove = (WorkspaceId -> WindowSet -> WindowSet)
-> Lines -> Limits -> Direction -> X ()
plane WorkspaceId -> WindowSet -> WindowSet
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
greedyView

plane ::
    (WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction ->
    X ()
plane :: (WorkspaceId -> WindowSet -> WindowSet)
-> Lines -> Limits -> Direction -> X ()
plane WorkspaceId -> WindowSet -> WindowSet
function Lines
numberLines_ Limits
limits Direction
direction = do
    XState
st <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
    XConf
xconf <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask

    Int
numberLines <-
        IO Int -> X Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> X Int) -> IO Int -> X Int
forall a b. (a -> b) -> a -> b
$
        case Lines
numberLines_ of
            Lines Int
numberLines__ ->
                Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
numberLines__
            Lines
GConf               ->
                do
                    WorkspaceId
numberLines__ <-
                        WorkspaceId -> [WorkspaceId] -> WorkspaceId -> IO WorkspaceId
forall (m :: * -> *).
MonadIO m =>
WorkspaceId -> [WorkspaceId] -> WorkspaceId -> m WorkspaceId
runProcessWithInput WorkspaceId
gconftool [WorkspaceId]
parameters WorkspaceId
""
                    case ReadS Int
forall a. Read a => ReadS a
reads WorkspaceId
numberLines__ of
                        [(Int
numberRead, WorkspaceId
_)] -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
numberRead
                        [(Int, WorkspaceId)]
_                 ->
                            do
                                WorkspaceId -> IO ()
forall (m :: * -> *). MonadIO m => WorkspaceId -> m ()
trace (WorkspaceId -> IO ()) -> WorkspaceId -> IO ()
forall a b. (a -> b) -> a -> b
$
                                    WorkspaceId
"XMonad.Actions.Plane: Could not parse the output of " WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
gconftool WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++
                                    [WorkspaceId] -> WorkspaceId
unwords [WorkspaceId]
parameters WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
": " WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
numberLines__ WorkspaceId -> WorkspaceId -> WorkspaceId
forall a. [a] -> [a] -> [a]
++ WorkspaceId
"; assuming 1."
                                Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1

    let
        notBorder :: Bool
        notBorder :: Bool
notBorder = (Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
2 (Int
circular_ Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
currentWS) [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Int -> Bool -> [Bool]
forall a. Int -> a -> [a]
replicate Int
2 (Int
circular_ Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
currentWS)) [Bool] -> Int -> Bool
forall a. [a] -> Int -> a
!! Direction -> Int
forall a. Enum a => a -> Int
fromEnum Direction
direction

        circular_ :: Int
        circular_ :: Int
circular_ = Int -> Int
circular Int
currentWS

        circular :: Int -> Int
        circular :: Int -> Int
circular =
            [ (Int -> Int) -> Int -> Int
onLine   Int -> Int
forall a. Enum a => a -> a
pred
            , (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
pred
            , (Int -> Int) -> Int -> Int
onLine   Int -> Int
forall a. Enum a => a -> a
succ
            , (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
succ
            ]
            [Int -> Int] -> Int -> Int -> Int
forall a. [a] -> Int -> a
!! Direction -> Int
forall a. Enum a => a -> Int
fromEnum Direction
direction

        linear :: Int -> Int
        linear :: Int -> Int
linear =
            [ (Int -> Int) -> Int -> Int
onLine   Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
pred
            , (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Int -> Int
onLine Int -> Int
forall a. Enum a => a -> a
pred
            , (Int -> Int) -> Int -> Int
onLine   Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
succ
            , (Int -> Int) -> Int -> Int
onColumn Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> Int -> Int
onLine Int -> Int
forall a. Enum a => a -> a
succ
            ]
            [Int -> Int] -> Int -> Int -> Int
forall a. [a] -> Int -> a
!! Direction -> Int
forall a. Enum a => a -> Int
fromEnum Direction
direction

        onLine :: (Int -> Int) -> Int -> Int
        onLine :: (Int -> Int) -> Int -> Int
onLine Int -> Int
f Int
currentWS_
            | Int
line Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
areasLine = Int -> Int
mod_ Int
columns
            | Bool
otherwise        = Int -> Int
mod_ Int
areasColumn
            where
                line, column :: Int
                (Int
line, Int
column) = Int -> (Int, Int)
split Int
currentWS_

                mod_ :: Int -> Int
                mod_ :: Int -> Int
mod_ Int
columns_ = Int -> Int -> Int
compose Int
line (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int -> Int
f Int
column) Int
columns_

        onColumn :: (Int -> Int) -> Int -> Int
        onColumn :: (Int -> Int) -> Int -> Int
onColumn Int -> Int
f Int
currentWS_
            | Int
column Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
areasColumn Bool -> Bool -> Bool
|| Int
areasColumn Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = Int -> Int
mod_ Int
numberLines
            | Bool
otherwise                                 = Int -> Int
mod_ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
pred Int
numberLines
            where
                line, column :: Int
                (Int
line, Int
column) = Int -> (Int, Int)
split Int
currentWS_

                mod_ :: Int -> Int
                mod_ :: Int -> Int
mod_ Int
lines_ = Int -> Int -> Int
compose (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (Int -> Int
f Int
line) Int
lines_) Int
column

        compose :: Int -> Int -> Int
        compose :: Int -> Int -> Int
compose Int
line Int
column = Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
column

        split :: Int -> (Int, Int)
        split :: Int -> (Int, Int)
split Int
currentWS_ =
            ((Int -> Int -> Int) -> Int
operation Int -> Int -> Int
forall a. Integral a => a -> a -> a
div, (Int -> Int -> Int) -> Int
operation Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod)
            where
                operation :: (Int -> Int -> Int) -> Int
                operation :: (Int -> Int -> Int) -> Int
operation Int -> Int -> Int
f = Int -> Int -> Int
f Int
currentWS_ Int
columns

        areasLine :: Int
        areasLine :: Int
areasLine = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
areas Int
columns

        areasColumn :: Int
        areasColumn :: Int
areasColumn = Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
areas Int
columns

        columns :: Int
        columns :: Int
columns =
            if Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
areas Int
numberLines Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
preColumns else Int
preColumns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

        currentWS :: Int
        currentWS :: Int
currentWS = Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
mCurrentWS

        preColumns :: Int
        preColumns :: Int
preColumns = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
areas Int
numberLines

        mCurrentWS :: Maybe Int
        mCurrentWS :: Maybe Int
mCurrentWS = WorkspaceId -> [WorkspaceId] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (WindowSet -> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
currentTag (WindowSet -> WorkspaceId) -> WindowSet -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ XState -> WindowSet
windowset XState
st) [WorkspaceId]
areaNames

        areas :: Int
        areas :: Int
areas = [WorkspaceId] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [WorkspaceId]
areaNames

        run :: (Int -> Int) -> X ()
        run :: (Int -> Int) -> X ()
run Int -> Int
f = (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> WindowSet -> WindowSet
function (WorkspaceId -> WindowSet -> WindowSet)
-> WorkspaceId -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ [WorkspaceId]
areaNames [WorkspaceId] -> Int -> WorkspaceId
forall a. [a] -> Int -> a
!! Int -> Int
f Int
currentWS

        areaNames :: [String]
        areaNames :: [WorkspaceId]
areaNames = XConfig Layout -> [WorkspaceId]
forall (l :: * -> *). XConfig l -> [WorkspaceId]
workspaces (XConfig Layout -> [WorkspaceId])
-> XConfig Layout -> [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ XConf -> XConfig Layout
config XConf
xconf

    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
mCurrentWS) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$
        case Limits
limits of
        Limits
Finite   -> Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
notBorder (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> X ()
run Int -> Int
circular
        Limits
Circular -> (Int -> Int) -> X ()
run Int -> Int
circular
        Limits
Linear -> if Bool
notBorder then (Int -> Int) -> X ()
run Int -> Int
circular else (Int -> Int) -> X ()
run Int -> Int
linear

gconftool :: String
gconftool :: WorkspaceId
gconftool = WorkspaceId
"gconftool-2"

parameters :: [String]
parameters :: [WorkspaceId]
parameters = [WorkspaceId
"--get", WorkspaceId
"/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"]