{-# LANGUAGE ViewPatterns #-}

-----------------------------------------------------------------------------
-- |
-- 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 XMonad.Prelude
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.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
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.


data Workscreen = Workscreen{Workscreen -> Int
workscreenId::Int,Workscreen -> [WorkspaceId]
workspaces::[WorkspaceId]} deriving (Int -> Workscreen -> ShowS
[Workscreen] -> ShowS
Workscreen -> WorkspaceId
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
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 = 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 forall a. [a] -> [a] -> [a]
++ WorkspaceId
"_"
                        in forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
(++) WorkspaceId
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = forall a. Int -> [a] -> [a]
take Int
n [WorkspaceId]
ws forall a. a -> [a] -> [a]
: Int -> [WorkspaceId] -> [[WorkspaceId]]
fromWorkspace' Int
n (forall a. Int -> [a] -> [a]
drop Int
n [WorkspaceId]
ws)

-- | Initial configuration of workscreens
configWorkscreen :: [Workscreen] -> X ()
configWorkscreen :: [Workscreen] -> X ()
configWorkscreen [Workscreen]
wscrn = 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) <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
                           let wscr :: Workscreen
wscr = if Int
wscrId forall a. Eq a => a -> a -> Bool
== Int
c
                                          then Int -> [WorkspaceId] -> Workscreen
Workscreen Int
wscrId forall a b. (a -> b) -> a -> b
$ [WorkspaceId] -> [WorkspaceId]
shiftWs (Workscreen -> [WorkspaceId]
workspaces forall a b. (a -> b) -> a -> b
$ [Workscreen]
a forall a. [a] -> Int -> a
!! Int
wscrId)
                                          else [Workscreen]
a forall a. [a] -> Int -> a
!! Int
wscrId
                               ([Workscreen]
x, forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> Workscreen
_ :| [Workscreen]
ys) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
wscrId [Workscreen]
a
                               newWorkscreenStorage :: WorkscreenStorage
newWorkscreenStorage = Int -> [Workscreen] -> WorkscreenStorage
WorkscreenStorage Int
wscrId ([Workscreen]
x forall a. [a] -> [a] -> [a]
++ [Workscreen
wscr] forall a. [a] -> [a] -> [a]
++ [Workscreen]
ys)
                           (WindowSet -> WindowSet) -> X ()
windows (Workscreen -> WindowSet -> WindowSet
viewWorkscreen' Workscreen
wscr)
                           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 -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl WindowSet -> (ScreenId, WorkspaceId) -> WindowSet
wsToSc' WindowSet
s (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 = forall a. Int -> [a] -> [a]
drop Int
1 [WorkspaceId]
a forall a. [a] -> [a] -> [a]
++ 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) <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
                              case Workscreen -> [WorkspaceId]
workspaces ([Workscreen]
a forall a. [a] -> Int -> a
!! Int
wscrId) of
                                []      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                                (WorkspaceId
w : [WorkspaceId]
_) -> (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ 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
w