{-# LANGUAGE LambdaCase #-}
module Main (main) where

import Data.List (elemIndex)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Graphics.X11.EWMH (getCurrentDesktop, getDesktopNames, setDesktopNames, switchToDesktop)
import Graphics.X11.Extra (withDefaultDisplay)
import System.Environment (getArgs)
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


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
      "switch" : name : [] -> switchToWorkspace name
      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

switchToWorkspace :: String -> IO ()
switchToWorkspace name =
    withDefaultDisplay $ \dpy -> do
      names <- fromMaybe [] <$> getDesktopNames dpy
      let Just i = name `elemIndex` names
      switchToDesktop dpy (fromIntegral i)