blob: fd5f99d6a1f0e4e5afcd86fa5648446c2ff3db77 (
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
|
{-# LANGUAGE LambdaCase #-}
module Main (main) where
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Graphics.X11.EWMH (getCurrentDesktop, getDesktopNames, setDesktopNames)
import Graphics.X11.Extra (withDefaultDisplay)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy.Char8 as LBS8
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import System.Environment (getArgs)
main :: IO ()
main =
getArgs >>= \case
[] -> getWorkspaces
"get" : [] -> getWorkspaces
"add" : names -> addWorkspaces names
"remove" : names -> removeWorkspaces names
"rename" : name : [] -> renameCurrentWorkspace name
"rename" : args | not (null args) && length args `mod` 2 == 0 ->
renameWorkspaces renames
where
renames = Map.fromList (pairUp args)
pairUp = \case
(x:y:xs) -> (x,y) : pairUp xs
_ -> []
"set" : names -> setWorkspaces names
x -> error $ "bad command: " <> show x
getWorkspaces :: IO ()
getWorkspaces =
LBS8.putStrLn =<< Aeson.encode <$> withDefaultDisplay getDesktopNames
addWorkspaces :: [String] -> IO ()
addWorkspaces names =
withDefaultDisplay $ \dpy -> do
names' <-
(<>names) .
fromMaybe [] <$> getDesktopNames dpy
setDesktopNames names' dpy
removeWorkspaces :: [String] -> IO ()
removeWorkspaces names =
withDefaultDisplay $ \dpy -> do
names' <-
filter (not . flip Set.member (Set.fromList names)) .
fromMaybe [] <$> getDesktopNames dpy
setDesktopNames names' dpy
renameCurrentWorkspace :: String -> IO ()
renameCurrentWorkspace name =
withDefaultDisplay $ \dpy -> do
i <- maybe 0 fromIntegral <$> getCurrentDesktop dpy
names <- fromMaybe [] <$> getDesktopNames dpy
let names' = take i names <> [name] <> drop (i + 1) names
setDesktopNames names' dpy
renameWorkspaces :: Map String String-> IO ()
renameWorkspaces renames = do
withDefaultDisplay $ \dpy -> do
names' <-
map (\name -> fromMaybe name (Map.lookup name renames)) .
fromMaybe [] <$> getDesktopNames dpy
setDesktopNames names' dpy
setWorkspaces :: [String] -> IO ()
setWorkspaces = withDefaultDisplay . setDesktopNames
|
