-----------------------------------------------------------------------------
-- |
-- Module     :  XMonad.Actions.Workscreen
-- Description:  Display a set of workspaces on several screens.
-- Copyright  :  (c) 2012 kedals0
-- License    :  BSD3-style (see LICENSE)
--
-- Maintainer :  Dal <kedasl0@gmail.com>
-- Stability  :  unstable
-- Portability:  unportable
--
-- A workscreen permits to display a set of workspaces on several
-- screens. In xinerama mode, when a workscreen is viewed, workspaces
-- associated to all screens are visible.
--
-- The first workspace of a workscreen is displayed on first screen,
-- second on second screen, etc. Workspace position can be easily
-- changed. If the current workscreen is called again, workspaces are
-- shifted.
--
-- This also permits to see all workspaces of a workscreen even if just
-- one screen is present, and to move windows from workspace to workscreen.
-----------------------------------------------------------------------------

module XMonad.Actions.Workscreen (
  -- * Usage
  -- $usage
  configWorkscreen
  ,viewWorkscreen
  ,Workscreen(..)
  ,shiftToWorkscreen
  ,fromWorkspace
  ,expandWorkspace
  ,WorkscreenId
  ) where

import XMonad hiding (workspaces)
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Actions.OnScreen

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.Workscreen
-- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"]
-- >                in Workscreen.expandWorkspace 2 myOldWorkspaces
-- > myStartupHook = do Workscreen.configWorkscreen (Workscreen.fromWorkspace 2 myWorkspaces)
-- >                    return ()
--
-- Then, replace normal workspace view and shift keybinding:
--
-- > [((m .|. modm, k), f i)
-- >      | (i, k) <- zip [0..] [1..12]
-- >      , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]]
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".


data Workscreen = Workscreen{Workscreen -> Int
workscreenId::Int,Workscreen -> [WorkspaceId]
workspaces::[WorkspaceId]} deriving (Int -> Workscreen -> ShowS
[Workscreen] -> ShowS
Workscreen -> WorkspaceId
(Int -> Workscreen -> ShowS)
-> (Workscreen -> WorkspaceId)
-> ([Workscreen] -> ShowS)
-> Show Workscreen
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [Workscreen] -> ShowS
$cshowList :: [Workscreen] -> ShowS
show :: Workscreen -> WorkspaceId
$cshow :: Workscreen -> WorkspaceId
showsPrec :: Int -> Workscreen -> ShowS
$cshowsPrec :: Int -> Workscreen -> ShowS
Show)
type WorkscreenId=Int

data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Int -> WorkscreenStorage -> ShowS
[WorkscreenStorage] -> ShowS
WorkscreenStorage -> WorkspaceId
(Int -> WorkscreenStorage -> ShowS)
-> (WorkscreenStorage -> WorkspaceId)
-> ([WorkscreenStorage] -> ShowS)
-> Show WorkscreenStorage
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [WorkscreenStorage] -> ShowS
$cshowList :: [WorkscreenStorage] -> ShowS
show :: WorkscreenStorage -> WorkspaceId
$cshow :: WorkscreenStorage -> WorkspaceId
showsPrec :: Int -> WorkscreenStorage -> ShowS
$cshowsPrec :: Int -> WorkscreenStorage -> ShowS
Show)
instance ExtensionClass WorkscreenStorage where
  initialValue :: WorkscreenStorage
initialValue = Int -> [Workscreen] -> WorkscreenStorage
WorkscreenStorage Int
0 []

-- | Helper to group workspaces. Multiply workspace by screens number.
expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
expandWorkspace Int
nscr = (WorkspaceId -> [WorkspaceId]) -> [WorkspaceId] -> [WorkspaceId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap WorkspaceId -> [WorkspaceId]
expandId
  where expandId :: WorkspaceId -> [WorkspaceId]
expandId WorkspaceId
wsId = let t :: WorkspaceId
t = WorkspaceId
wsId WorkspaceId -> ShowS
forall a. [a] -> [a] -> [a]
++ WorkspaceId
"_"
                        in (Int -> WorkspaceId) -> [Int] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map (WorkspaceId -> ShowS
forall a. [a] -> [a] -> [a]
(++) WorkspaceId
t ShowS -> (Int -> WorkspaceId) -> Int -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> WorkspaceId
forall a. Show a => a -> WorkspaceId
show ) [Int
1..Int
nscr]

-- | Create workscreen list from workspace list. Group workspaces to
-- packets of screens number size.
fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]
fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]
fromWorkspace Int
n [WorkspaceId]
ws = (Int -> [WorkspaceId] -> Workscreen)
-> [Int] -> [[WorkspaceId]] -> [Workscreen]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [WorkspaceId] -> Workscreen
Workscreen [Int
0..] (Int -> [WorkspaceId] -> [[WorkspaceId]]
fromWorkspace' Int
n [WorkspaceId]
ws)
fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
fromWorkspace' Int
_ [] = []
fromWorkspace' Int
n [WorkspaceId]
ws = Int -> [WorkspaceId] -> [WorkspaceId]
forall a. Int -> [a] -> [a]
take Int
n [WorkspaceId]
ws [WorkspaceId] -> [[WorkspaceId]] -> [[WorkspaceId]]
forall a. a -> [a] -> [a]
: Int -> [WorkspaceId] -> [[WorkspaceId]]
fromWorkspace' Int
n (Int -> [WorkspaceId] -> [WorkspaceId]
forall a. Int -> [a] -> [a]
drop Int
n [WorkspaceId]
ws)

-- | Initial configuration of workscreens
configWorkscreen :: [Workscreen] -> X ()
configWorkscreen :: [Workscreen] -> X ()
configWorkscreen [Workscreen]
wscrn = WorkscreenStorage -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (Int -> [Workscreen] -> WorkscreenStorage
WorkscreenStorage Int
0 [Workscreen]
wscrn)

-- | View workscreen of index @WorkscreenId@. If current workscreen is asked
-- workscreen, workscreen's workspaces are shifted.
viewWorkscreen :: WorkscreenId -> X ()
viewWorkscreen :: Int -> X ()
viewWorkscreen Int
wscrId = do (WorkscreenStorage Int
c [Workscreen]
a) <- X WorkscreenStorage
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
                           let wscr :: Workscreen
wscr = if Int
wscrId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
c
                                          then Int -> [WorkspaceId] -> Workscreen
Workscreen Int
wscrId ([WorkspaceId] -> Workscreen) -> [WorkspaceId] -> Workscreen
forall a b. (a -> b) -> a -> b
$ [WorkspaceId] -> [WorkspaceId]
shiftWs (Workscreen -> [WorkspaceId]
workspaces (Workscreen -> [WorkspaceId]) -> Workscreen -> [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ [Workscreen]
a [Workscreen] -> Int -> Workscreen
forall a. [a] -> Int -> a
!! Int
wscrId)
                                          else [Workscreen]
a [Workscreen] -> Int -> Workscreen
forall a. [a] -> Int -> a
!! Int
wscrId
                               ([Workscreen]
x,Workscreen
_:[Workscreen]
ys) = Int -> [Workscreen] -> ([Workscreen], [Workscreen])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
wscrId [Workscreen]
a
                               newWorkscreenStorage :: WorkscreenStorage
newWorkscreenStorage = Int -> [Workscreen] -> WorkscreenStorage
WorkscreenStorage Int
wscrId ([Workscreen]
x [Workscreen] -> [Workscreen] -> [Workscreen]
forall a. [a] -> [a] -> [a]
++ [Workscreen
wscr] [Workscreen] -> [Workscreen] -> [Workscreen]
forall a. [a] -> [a] -> [a]
++ [Workscreen]
ys)
                           (WindowSet -> WindowSet) -> X ()
windows (Workscreen -> WindowSet -> WindowSet
viewWorkscreen' Workscreen
wscr)
                           WorkscreenStorage -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put WorkscreenStorage
newWorkscreenStorage

viewWorkscreen' :: Workscreen -> WindowSet -> WindowSet
viewWorkscreen' :: Workscreen -> WindowSet -> WindowSet
viewWorkscreen' (Workscreen Int
_ [WorkspaceId]
ws) = \WindowSet
s -> (WindowSet -> (ScreenId, WorkspaceId) -> WindowSet)
-> WindowSet -> [(ScreenId, WorkspaceId)] -> WindowSet
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl WindowSet -> (ScreenId, WorkspaceId) -> WindowSet
wsToSc' WindowSet
s ([ScreenId] -> [WorkspaceId] -> [(ScreenId, WorkspaceId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ScreenId
0..] [WorkspaceId]
ws)
  where wsToSc' :: WindowSet -> (ScreenId, WorkspaceId) -> WindowSet
wsToSc' WindowSet
s (ScreenId
scr,WorkspaceId
wsId) = ScreenId -> WorkspaceId -> WindowSet -> WindowSet
greedyViewOnScreen ScreenId
scr WorkspaceId
wsId WindowSet
s

shiftWs :: [WorkspaceId] -> [WorkspaceId]
shiftWs :: [WorkspaceId] -> [WorkspaceId]
shiftWs [WorkspaceId]
a = Int -> [WorkspaceId] -> [WorkspaceId]
forall a. Int -> [a] -> [a]
drop Int
1 [WorkspaceId]
a [WorkspaceId] -> [WorkspaceId] -> [WorkspaceId]
forall a. [a] -> [a] -> [a]
++ Int -> [WorkspaceId] -> [WorkspaceId]
forall a. Int -> [a] -> [a]
take Int
1 [WorkspaceId]
a

-- | Shift a window on the first workspace of workscreen
-- @WorkscreenId@.
shiftToWorkscreen :: WorkscreenId -> X ()
shiftToWorkscreen :: Int -> X ()
shiftToWorkscreen Int
wscrId = do (WorkscreenStorage Int
_ [Workscreen]
a) <- X WorkscreenStorage
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
                              let ws :: WorkspaceId
ws = [WorkspaceId] -> WorkspaceId
forall a. [a] -> a
head ([WorkspaceId] -> WorkspaceId)
-> (Workscreen -> [WorkspaceId]) -> Workscreen -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workscreen -> [WorkspaceId]
workspaces (Workscreen -> WorkspaceId) -> Workscreen -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ [Workscreen]
a [Workscreen] -> Int -> Workscreen
forall a. [a] -> Int -> a
!! Int
wscrId
                              (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> WindowSet -> WindowSet
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
W.shift WorkspaceId
ws