summaryrefslogtreecommitdiffstats
path: root/lib/DynamicPerScreenWorkspaces.hs
blob: 66bbf119e23d2e975d22823120abda46b8cc7bee (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
{-# LANGUAGE DeriveDataTypeable #-}

module DynamicPerScreenWorkspaces ( screenWorkspaceStorage
                                  , WorkspaceScreens
                                  , DynamicWorkspaceConfig(..)
                                  , dynamicRescreenHook
                                  , create
                                  , cleanup
                                  , focusWindow
                                  , view
                                  , viewOn
                                  , viewOnCurrent
                                  ) where

import XMonad hiding (hide)
import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))

import Control.Arrow ((&&&))
import Control.Monad
import qualified Data.Map as M
import Data.Maybe

import Storage


data DynamicWorkspaceStoreData = DWSD (M.Map Int ScreenId)
                                 deriving (Typeable, Show, Read)
instance StoreData DynamicWorkspaceStoreData

screenWorkspaceStorage :: (LayoutClass l a) => l a -> ModifiedLayout (Storage DynamicWorkspaceStoreData) l a
screenWorkspaceStorage = storage (DWSD M.empty)


type WorkspaceScreens = Int -> Int -> ScreenId

data DynamicWorkspaceConfig = DynamicWorkspaceConfig
                              { defaultWorkspaceScreen  :: !WorkspaceScreens
                              , workspaceTag            :: !(Int -> WorkspaceId)
                              }

defaultScreenWorkspaces :: DynamicWorkspaceConfig -> Int -> ScreenId -> [Int]
defaultScreenWorkspaces conf n s = filter ((== s) . defaultWorkspaceScreen conf n) [0..]


dynamicRescreenHook :: DynamicWorkspaceConfig -> [ScreenDetail] -> X ()
dynamicRescreenHook conf sds = do
  layout <- asks $ layoutHook . config
  windows $ cleanup' . \wset -> let (as,bs) = splitAt (length sds) $ map W.workspace (W.current wset:W.visible wset)
                         
                                    mkWS i = let tag = workspaceTag conf i
                                             in W.Workspace tag layout Nothing
                                    
                                    mkScreen sid (Just ws) sd = W.Screen ws sid sd
                                    mkScreen sid Nothing sd = W.Screen (mkWS $ nextEmpty' conf (length sds) sid wset) sid sd
                                    
                                    (s:ss) = zipWith3 mkScreen (map S [0..]) (map Just as ++ repeat Nothing) sds
                                in wset {W.current = s, W.visible = ss, W.hidden = bs ++ W.hidden wset}

workspaceScreen :: DynamicWorkspaceConfig -> Int -> X ScreenId
workspaceScreen conf i = do
  wset <- gets windowset
  d <- getStoreData
  
  let defaultScreen = defaultWorkspaceScreen conf (length $ W.screens wset) i
  return $ case d of
    Just (DWSD wsscreens) -> do
       case (M.lookup i wsscreens) of
         Just s  -> s
         Nothing -> defaultScreen
    _ ->
      defaultScreen

hide :: DynamicWorkspaceConfig -> Int -> WindowSet -> X WindowSet
hide conf i wset = gets (W.screens . windowset) >>= foldM (flip hideOn) wset
  where
    hideOn s | (workspaceTag conf i) == (W.tag $ W.workspace s) = viewNextEmpty conf (W.screen s)
    hideOn _ = return

cleanup' :: WindowSet -> WindowSet
cleanup' wset = wset { W.hidden = hidden' }
  where
    hidden' = filter (isJust . W.stack) $ W.hidden wset

viewOn' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
viewOn' conf sid i wset = do
  let tag = workspaceTag conf i
  case W.tagMember tag wset of
    False -> viewEmpty conf sid i wset
    True -> do
      wset' <- hide conf i wset
      let mws = W.lookupWorkspace sid wset'
      
      return $ case mws of
        Just ws -> W.view tag . W.view ws $ wset'
        Nothing -> wset'

create' :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
create' conf sid i wset = do
  layout <- asks $ layoutHook . config
  let tag = workspaceTag conf i
      workspace = W.Workspace tag layout Nothing
  
  return $ if W.tagMember tag wset then wset else wset { W.hidden = workspace:(W.hidden wset) }

viewEmpty :: DynamicWorkspaceConfig -> ScreenId -> Int -> WindowSet -> X WindowSet
viewEmpty conf sid i = create' conf sid i >=> viewOn' conf sid i

nextEmpty' ::DynamicWorkspaceConfig -> Int -> ScreenId -> WindowSet -> Int
nextEmpty' conf n sid wset = fst $ head $ dropWhile ((`W.tagMember` wset) . snd) $ map (id &&& workspaceTag conf) $ defaultScreenWorkspaces conf n sid

nextEmpty ::  DynamicWorkspaceConfig -> ScreenId -> WindowSet -> Int
nextEmpty conf sid wset = nextEmpty' conf (length $ W.screens wset) sid wset

viewNextEmpty :: DynamicWorkspaceConfig -> ScreenId -> WindowSet -> X WindowSet
viewNextEmpty conf sid wset = viewEmpty conf sid (nextEmpty conf sid wset) wset

windows' :: (WindowSet -> X WindowSet) -> X ()
windows' f = do
  wset <- gets windowset
  wset' <- f wset
  windows . const $ wset'

create :: DynamicWorkspaceConfig -> Int -> X ()
create conf i = do
  sid <- workspaceScreen conf i
  windows' $ create' conf sid i

cleanup :: X ()
cleanup = windows cleanup'

focusWindow :: DynamicWorkspaceConfig -> Window -> X ()
focusWindow conf w = do
  wset <- gets windowset
  let mws = W.findTag w wset
  whenJust mws $ \ws -> do
    let i = head $ filter ((== ws) . workspaceTag conf) [0..]
    sid <- workspaceScreen conf i
    windows' $ liftM (cleanup' . W.focusWindow w) . viewOn' conf sid i

view :: DynamicWorkspaceConfig -> Int -> X ()
view conf i = do
  sid <- workspaceScreen conf i
  windows' $ liftM cleanup' . viewOn' conf sid i

viewOn :: DynamicWorkspaceConfig -> ScreenId -> Int -> X ()
viewOn conf sid i = do
  updateStoreData $ \(DWSD m) -> DWSD $ M.insert i sid m
  windows' $ liftM cleanup' . viewOn' conf sid i

viewOnCurrent :: DynamicWorkspaceConfig -> Int -> X ()
viewOnCurrent conf i = do
  sid <- gets (W.screen . W.current . windowset)
  viewOn conf sid i