-----------------------------------------------------------------------------
-- |
-- Module     :  XMonad.Actions.Workscreen
-- 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.
-----------------------------------------------------------------------------
{-# LANGUAGE DeriveDataTypeable #-}

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,Typeable)
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,Typeable)
instance ExtensionClass WorkscreenStorage where
  initialValue :: WorkscreenStorage
initialValue = Int -> [Workscreen] -> WorkscreenStorage
WorkscreenStorage 0 []

-- | Helper to group workspaces. Multiply workspace by screens number.
expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
expandWorkspace nscr :: Int
nscr ws :: [WorkspaceId]
ws = [[WorkspaceId]] -> [WorkspaceId]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[WorkspaceId]] -> [WorkspaceId])
-> [[WorkspaceId]] -> [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ (WorkspaceId -> [WorkspaceId]) -> [WorkspaceId] -> [[WorkspaceId]]
forall a b. (a -> b) -> [a] -> [b]
map WorkspaceId -> [WorkspaceId]
expandId [WorkspaceId]
ws
  where expandId :: WorkspaceId -> [WorkspaceId]
expandId wsId :: WorkspaceId
wsId = let t :: WorkspaceId
t = WorkspaceId
wsId WorkspaceId -> ShowS
forall a. [a] -> [a] -> [a]
++ "_"
                        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 ) [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 n :: Int
n ws :: [WorkspaceId]
ws = ((Int, [WorkspaceId]) -> Workscreen)
-> [(Int, [WorkspaceId])] -> [Workscreen]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Int
a,b :: [WorkspaceId]
b) -> Int -> [WorkspaceId] -> Workscreen
Workscreen Int
a [WorkspaceId]
b) ([(Int, [WorkspaceId])] -> [Workscreen])
-> [(Int, [WorkspaceId])] -> [Workscreen]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[WorkspaceId]] -> [(Int, [WorkspaceId])]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] (Int -> [WorkspaceId] -> [[WorkspaceId]]
fromWorkspace' Int
n [WorkspaceId]
ws)
fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
fromWorkspace' _ [] = []
fromWorkspace' n :: Int
n ws :: [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 wscrn :: [Workscreen]
wscrn = WorkscreenStorage -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (Int -> [Workscreen] -> WorkscreenStorage
WorkscreenStorage 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 wscrId :: Int
wscrId = do (WorkscreenStorage c :: Int
c a :: [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
                               (x :: [Workscreen]
x,_:ys :: [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 _ ws :: [WorkspaceId]
ws) = \s :: 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 [0..] [WorkspaceId]
ws)
  where wsToSc' :: WindowSet -> (ScreenId, WorkspaceId) -> WindowSet
wsToSc' s :: WindowSet
s (scr :: ScreenId
scr,wsId :: WorkspaceId
wsId) = ScreenId -> WorkspaceId -> WindowSet -> WindowSet
greedyViewOnScreen ScreenId
scr WorkspaceId
wsId WindowSet
s

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

-- | Shift a window on the first workspace of workscreen
-- @WorkscreenId@.
shiftToWorkscreen :: WorkscreenId -> X ()
shiftToWorkscreen :: Int -> X ()
shiftToWorkscreen wscrId :: Int
wscrId = do (WorkscreenStorage _ a :: [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