{-# LANGUAGE ViewPatterns #-}
module XMonad.Actions.Workscreen (
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
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 []
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]
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)
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)
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
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