{-# 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