diff --git a/CHANGES.md b/CHANGES.md index 0bfce0d0..289cf90b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,6 +5,11 @@ ### Breaking Changes ### New Modules + + * `XMonad.Actions.Profiles`. + + - Group workspaces by similarity. Usefull when one has lots + of workspaces and uses only a couple per unit of work. ### Bug Fixes and Minor Changes diff --git a/XMonad/Actions/Profiles.hs b/XMonad/Actions/Profiles.hs new file mode 100644 index 00000000..9d49b0e7 --- /dev/null +++ b/XMonad/Actions/Profiles.hs @@ -0,0 +1,545 @@ +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE DerivingVia #-} + + +-------------------------------------------------------------------------------- +-- | +-- Module : XMonad.Actions.Profiles +-- Description : Group your workspaces by similarity. +-- Copyright : (c) Mislav Zanic +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Mislav Zanic +-- Stability : experimental +-- Portability : unportable +-- +-------------------------------------------------------------------------------- + +module XMonad.Actions.Profiles + ( -- * Overview + -- $overview + + -- * Usage + -- $usage + + -- * Types + ProfileId + , Profile(..) + , ProfileConfig(..) + + -- * Hooks + , addProfiles + , addProfilesWithHistory + + -- * Switching profiles + , switchToProfile + + -- * Workspace navigation and keybindings + , wsFilter + , bindOn + + -- * Loggers and pretty printers + , excludeWSPP + , profileLogger + + -- * Prompts + , switchProfilePrompt + , addWSToProfilePrompt + , removeWSFromProfilePrompt + , switchProfileWSPrompt + , shiftProfileWSPrompt + + -- * Utilities + , currentProfile + , profileIds + , previousProfile + , profileHistory + , allProfileWindows + , profileWorkspaces + )where + +-------------------------------------------------------------------------------- +import Data.Map.Strict (Map) +import Data.List +import qualified Data.Map.Strict as Map + +import Control.DeepSeq + +import XMonad +import XMonad.Prelude +import qualified XMonad.StackSet as W + +import XMonad.Actions.CycleWS + +import qualified XMonad.Util.ExtensibleState as XS +import XMonad.Util.Loggers (Logger) +import XMonad.Prompt.Window (XWindowMap) +import XMonad.Actions.WindowBringer (WindowBringerConfig(..)) +import XMonad.Actions.OnScreen (greedyViewOnScreen) +import XMonad.Hooks.Rescreen (addAfterRescreenHook) +import XMonad.Hooks.DynamicLog (PP(ppRename)) +import XMonad.Prompt + +-------------------------------------------------------------------------------- +-- $overview +-- This module allows you to group your workspaces into 'Profile's based on certain similarities. +-- The idea is to expand upon the philosophy set by "XMonad.Actions.TopicSpace" +-- which states that you can look at a topic/workspace as a +-- single unit of work instead of multiple related units of work. +-- This comes in handy if you have lots of workspaces with windows open and need only to +-- work with a few of them at a time. With 'Profile's, you can focus on those few workspaces that +-- require your attention by not displaying, or allowing you to switch to the rest of the workspaces. +-- The best example is having a profile for development and a profile for leisure activities. + +-------------------------------------------------------------------------------- +-- $usage +-- To use @Profiles@ you need to add it to your XMonad configuration +-- and configure your profiles. +-- +-- First you'll need to handle the imports. +-- +-- > import XMonad.Actions.Profiles +-- > import XMonad.Util.EZConfig -- for keybindings +-- > import qualified XMonad.StackSet as W +-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO -- for workspace navigation +-- +-- Next you'll need to define your profiles. +-- +-- > myStartingProfile :: ProfileId +-- > myStartingProfile = "Work" +-- > +-- > myProfiles :: [Profile] +-- > myProfiles = +-- > [ Profile { profileId = "Home" +-- > , profileWS = [ "www" +-- > , "rss" +-- > , "vid" +-- > , "vms" +-- > , "writing" +-- > , "notes" +-- > ] +-- > } +-- > , Profile { profileId = "Work" +-- > , profileWS = [ "www" +-- > , "slack" +-- > , "dev" +-- > , "k8s" +-- > , "notes" +-- > ] +-- > } +-- > ] +-- +-- So, while using @Home@ 'Profile', you'll only be able to see, navigate to and +-- do actions with @["www", "rss", "vid", "vms", "writing", "notes"]@ workspaces. +-- +-- You may also need to define some keybindings. Since @M-1@ .. @M-9@ are +-- sensible keybindings for switching workspaces, you'll need to use +-- 'bindOn' to have different keybindings per profile. +-- Here, we'll use "XMonad.Util.EZConfig" syntax: +-- +-- > myKeys :: [(String, X())] +-- > myKeys = +-- > [ ("M-p", switchProfilePrompt xpConfig) +-- > , ("M-g", switchProfileWSPrompt xpConfig) +-- > , ("M1-j", DO.moveTo Next wsFilter) +-- > , ("M1-k", DO.moveTo Prev wsFilter) +-- > ] +-- > <> +-- > [ ("M-" ++ m ++ k, bindOn $ map (\x -> (fst x, f $ snd x)) i) +-- > | (i, k) <- map (\(x:xs) -> (map fst (x:xs), snd x)) $ sortGroupBy snd tupleList +-- > , (f, m) <- [(mby $ windows . W.greedyView, ""), (mby $ windows . W.shift, "S-")] +-- > ] +-- > where +-- > mby f wid = if wid == "" then return () else f wid +-- > sortGroupBy f = groupBy (\ x y -> f x == f y) . sortBy (\x y -> compare (f x) (f y)) +-- > tupleList = concatMap (\p -> zip (map (\wid -> (profileId p, wid)) (profileWS p <> repeat "")) (map show [1..9 :: Int])) myProfiles +-- +-- After that, you'll need to hook @Profiles@ into your XMonad config: +-- +-- > main = xmonad $ addProfiles def { profiles = myProfiles +-- > , startingProfile = myStartingProfile +-- > } +-- > $ def `additionalKeysP` myKeys +-- + +-------------------------------------------------------------------------------- +type ProfileId = String +type ProfileMap = Map ProfileId Profile + +-------------------------------------------------------------------------------- +-- | Profile representation. +data Profile = Profile + { profileId :: !ProfileId -- ^ Profile name. + , profileWS :: ![WorkspaceId] -- ^ A list of workspaces contained within a profile. + } + +-------------------------------------------------------------------------------- +-- | Internal profile state. +data ProfileState = ProfileState + { profilesMap :: !ProfileMap + , current :: !(Maybe Profile) + , previous :: !(Maybe ProfileId) + } + +-------------------------------------------------------------------------------- +-- | User config for profiles. +data ProfileConfig = ProfileConfig + { workspaceExcludes :: ![WorkspaceId] -- ^ A list of workspaces to exclude from the @profileHistoryHook@. + , profiles :: ![Profile] -- ^ A list of user-defined profiles. + , startingProfile :: !ProfileId -- ^ Profile shown on startup. + } + +-------------------------------------------------------------------------------- +instance Default ProfileConfig where + def = ProfileConfig { workspaceExcludes = [] + , profiles = [] + , startingProfile = "" + } + +-------------------------------------------------------------------------------- +instance ExtensionClass ProfileState where + initialValue = ProfileState Map.empty Nothing Nothing + +-------------------------------------------------------------------------------- +-- Internal type for history tracking. +-- Main problem with @XMonad.Hooks.HistoryHook@ is that it isn't profile aware. +-- Because of that, when switching to a previous workspace, you might switch to +-- a workspace +newtype ProfileHistory = ProfileHistory + { history :: Map ProfileId [(ScreenId, WorkspaceId)] + } + deriving (Read, Show) + deriving NFData via Map ProfileId [(Int, WorkspaceId)] + +-------------------------------------------------------------------------------- +instance ExtensionClass ProfileHistory where + extensionType = PersistentExtension + initialValue = ProfileHistory Map.empty + +-------------------------------------------------------------------------------- +newtype ProfilePrompt = ProfilePrompt String + +-------------------------------------------------------------------------------- +instance XPrompt ProfilePrompt where + showXPrompt (ProfilePrompt x) = x + +-------------------------------------------------------------------------------- +defaultProfile :: Profile +defaultProfile = defaultProfile + +-------------------------------------------------------------------------------- +-- | Returns current profile. +currentProfile :: X ProfileId +currentProfile = profileId . fromMaybe defaultProfile . current <$> XS.get + +-------------------------------------------------------------------------------- +-- | Returns previous profile. +previousProfile :: X (Maybe ProfileId) +previousProfile = XS.gets previous + +-------------------------------------------------------------------------------- +-- | Returns the history of viewed workspaces per profile. +profileHistory :: X (Map ProfileId [(ScreenId, WorkspaceId)]) +profileHistory = XS.gets history + +-------------------------------------------------------------------------------- +profileMap :: X ProfileMap +profileMap = XS.gets profilesMap + +-------------------------------------------------------------------------------- +-- | Returns ids of all profiles. +profileIds :: X [ProfileId] +profileIds = Map.keys <$> XS.gets profilesMap + +-------------------------------------------------------------------------------- +currentProfileWorkspaces :: X [WorkspaceId] +currentProfileWorkspaces = XS.gets current <&> profileWS . fromMaybe defaultProfile + +-------------------------------------------------------------------------------- +-- | Hook profiles into XMonad. This function adds a startup hook that +-- sets up ProfileState. Also adds an afterRescreenHook for viewing correct +-- workspaces when adding new screens. +addProfiles :: ProfileConfig -> XConfig a -> XConfig a +addProfiles profConf conf = addAfterRescreenHook hook $ conf + { startupHook = profileStartupHook' <> startupHook conf + } + where + profileStartupHook' :: X() + profileStartupHook' = profilesStartupHook (profiles profConf) (startingProfile profConf) + hook = currentProfile >>= switchWSOnScreens + +-------------------------------------------------------------------------------- +-- | Hooks profiles into XMonad and enables Profile history logging. +addProfilesWithHistory :: ProfileConfig -> XConfig a -> XConfig a +addProfilesWithHistory profConf conf = conf' + { logHook = profileHistoryHookExclude (workspaceExcludes profConf) <> logHook conf + } + where + conf' = addProfiles profConf conf + +-------------------------------------------------------------------------------- +profileHistoryHookExclude :: [WorkspaceId] -> X() +profileHistoryHookExclude ews = do + cur <- gets $ W.current . windowset + vis <- gets $ W.visible . windowset + pws <- currentProfileWorkspaces + p <- currentProfile + + updateHist p $ workspaceScreenPairs $ filterWS pws $ cur:vis + where + workspaceScreenPairs wins = zip (W.screen <$> wins) (W.tag . W.workspace <$> wins) + filterWS pws = filter ((\wid -> (wid `elem` pws) && (wid `notElem` ews)) . W.tag . W.workspace) + +-------------------------------------------------------------------------------- +updateHist :: ProfileId -> [(ScreenId, WorkspaceId)] -> X() +updateHist pid xs = profileWorkspaces pid >>= XS.modify' . update + where + update pws hs = force $ hs { history = doUpdate pws $ history hs } + + doUpdate pws hist = foldl (\acc (sid, wid) -> Map.alter (f pws sid wid) pid acc) hist xs + + f pws sid wid val = case val of + Nothing -> pure [(sid, wid)] + Just hs -> pure $ let new = (sid, wid) in new:filterWS pws new hs + + filterWS :: [WorkspaceId] -> (ScreenId, WorkspaceId) -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)] + filterWS pws new = filter (\x -> snd x `elem` pws && x /= new) + +-------------------------------------------------------------------------------- +-- | Adds profiles to ProfileState and sets current profile using . + +profilesStartupHook :: [Profile] -> ProfileId -> X () +profilesStartupHook ps pid = XS.modify go >> switchWSOnScreens pid + where + go :: ProfileState -> ProfileState + go s = s {profilesMap = update $ profilesMap s, current = setCurrentProfile $ Map.fromList $ map entry ps} + + update :: ProfileMap -> ProfileMap + update = Map.union (Map.fromList $ map entry ps) + + entry :: Profile -> (ProfileId, Profile) + entry p = (profileId p, p) + + setCurrentProfile :: ProfileMap -> Maybe Profile + setCurrentProfile s = case Map.lookup pid s of + Nothing -> Just $ Profile pid [] + Just pn -> Just pn + +-------------------------------------------------------------------------------- +setPrevious :: ProfileId -> X() +setPrevious name = XS.modify update + where + update ps = ps { previous = doUpdate ps } + doUpdate ps = case Map.lookup name $ profilesMap ps of + Nothing -> previous ps + Just p -> Just $ profileId p + +-------------------------------------------------------------------------------- +setProfile :: ProfileId -> X () +setProfile p = currentProfile >>= setPrevious >> setProfile' p + +-------------------------------------------------------------------------------- +setProfile' :: ProfileId -> X () +setProfile' name = XS.modify update + where + update ps = ps { current = doUpdate ps } + doUpdate ps = case Map.lookup name $ profilesMap ps of + Nothing -> current ps + Just p -> Just p + +-------------------------------------------------------------------------------- +-- | Switch to a profile. +switchToProfile :: ProfileId -> X() +switchToProfile pid = setProfile pid >> switchWSOnScreens pid + +-------------------------------------------------------------------------------- +-- | Returns the workspace ids associated with a profile id. +profileWorkspaces :: ProfileId -> X [WorkspaceId] +profileWorkspaces pid = profileMap >>= findPWs + where + findPWs pm = return . profileWS . fromMaybe defaultProfile $ Map.lookup pid pm + +-------------------------------------------------------------------------------- +-- | Prompt for adding a workspace id to a profile. +addWSToProfilePrompt :: XPConfig -> X() +addWSToProfilePrompt c = do + ps <- profileIds + mkXPrompt (ProfilePrompt "Add ws to profile:") c (mkComplFunFromList' c ps) f + where + f :: String -> X() + f p = do + vis <- gets $ fmap (W.tag . W.workspace) . W.visible . windowset + cur <- gets $ W.tag . W.workspace . W.current . windowset + hid <- gets $ fmap W.tag . W.hidden . windowset + let + arr = cur:(vis <> hid) + in mkXPrompt (ProfilePrompt "Ws to add to profile:") c (mkComplFunFromList' c arr) (`addWSToProfile` p) + +-------------------------------------------------------------------------------- +-- | Prompt for switching profiles. +switchProfilePrompt :: XPConfig -> X() +switchProfilePrompt c = do + ps <- profileIds + mkXPrompt (ProfilePrompt "Profile: ") c (mkComplFunFromList' c ps) switchToProfile + +-------------------------------------------------------------------------------- +-- | Prompt for switching workspaces. +switchProfileWSPrompt :: XPConfig -> X () +switchProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces + where + mkPrompt pws = mkXPrompt (ProfilePrompt "Switch to workspace:") c (mkComplFunFromList' c pws) mbygoto + mbygoto wid = do + pw <- profileWorkspaces =<< currentProfile + unless (wid `notElem` pw) (windows . W.greedyView $ wid) + +-------------------------------------------------------------------------------- +-- | Prompt for shifting windows to a different workspace. +shiftProfileWSPrompt :: XPConfig -> X () +shiftProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces + where + mkPrompt pws = mkXPrompt (ProfilePrompt "Send window to workspace:") c (mkComplFunFromList' c pws) mbyshift + mbyshift wid = do + pw <- profileWorkspaces =<< currentProfile + unless (wid `notElem` pw) (windows . W.shift $ wid) + +-------------------------------------------------------------------------------- +addWSToProfile :: WorkspaceId -> ProfileId -> X() +addWSToProfile wid pid = XS.modify go + where + go :: ProfileState -> ProfileState + go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps} + + update :: ProfileMap -> ProfileMap + update mp = case Map.lookup pid mp of + Nothing -> mp + Just p -> if wid `elem` profileWS p then mp else Map.adjust f pid mp + + f :: Profile -> Profile + f p = Profile pid (wid : profileWS p) + + update' :: Profile -> Maybe Profile + update' cp = if profileId cp == pid && wid `notElem` profileWS cp then Just (Profile pid $ wid:profileWS cp) else Just cp + +-------------------------------------------------------------------------------- +-- | Prompt for removing a workspace from a profile. +removeWSFromProfilePrompt :: XPConfig -> X() +removeWSFromProfilePrompt c = do + ps <- profileIds + mkXPrompt (ProfilePrompt "Remove ws from profile:") c (mkComplFunFromList' c ps) f + where + f :: String -> X() + f p = do + arr <- profileWorkspaces p + mkXPrompt (ProfilePrompt "Ws to remove from profile:") c (mkComplFunFromList' c arr) $ + \ws -> do + cp <- currentProfile + ws `removeWSFromProfile` p + when (cp == p) $ currentProfile >>= switchWSOnScreens + +-------------------------------------------------------------------------------- +removeWSFromProfile :: WorkspaceId -> ProfileId -> X() +removeWSFromProfile wid pid = XS.modify go + where + go :: ProfileState -> ProfileState + go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps} + + update :: ProfileMap -> ProfileMap + update mp = case Map.lookup pid mp of + Nothing -> mp + Just p -> if wid `elem` profileWS p then Map.adjust f pid mp else mp + + f :: Profile -> Profile + f p = Profile pid (delete wid $ profileWS p) + + update' :: Profile -> Maybe Profile + update' cp = if profileId cp == pid && wid `elem` profileWS cp then Just (Profile pid $ delete wid $ profileWS cp) else Just cp + +-------------------------------------------------------------------------------- +-- | Pretty printer for a bar. Prints workspace ids of current profile. +excludeWSPP :: PP -> X PP +excludeWSPP pp = modifyPP <$> currentProfileWorkspaces + where + modifyPP pws = pp { ppRename = ppRename pp . printTag pws } + printTag pws tag = if tag `elem` pws then tag else "" + +-------------------------------------------------------------------------------- +-- | For cycling through workspaces associated with the current. +wsFilter :: WSType +wsFilter = WSIs $ currentProfileWorkspaces >>= (\ws -> return $ (`elem` ws) . W.tag) + +-------------------------------------------------------------------------------- +-- Takes care of placing correct workspaces on their respective screens. +-- It does this by reducing the history of a Profile until it gets an array of length +-- equal to the number of screens with pairs that have unique workspace ids. +switchWSOnScreens :: ProfileId -> X() +switchWSOnScreens pid = do + hist <- profileHistory + vis <- gets $ W.visible . windowset + cur <- gets $ W.current . windowset + pws <- profileMap <&> (profileWS . fromMaybe (Profile pid []) . Map.lookup pid) + case Map.lookup pid hist of + Nothing -> switchScreens $ zip (W.screen <$> (cur:vis)) pws + Just xs -> compareAndSwitch (f (W.screen <$> cur:vis) xs) (cur:vis) pws + where + f :: [ScreenId] -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)] + f sids = reorderUniq . reorderUniq . reverse . filter ((`elem` sids) . fst) + + reorderUniq :: (Ord k, Ord v) => [(k,v)] -> [(v,k)] + reorderUniq = map (\(x,y) -> (y,x)) . uniq + + uniq :: (Ord k, Ord v) => [(k,v)] -> [(k,v)] + uniq = Map.toList . Map.fromList + + viewWS fview sid wid = windows $ fview sid wid + + switchScreens = mapM_ (uncurry $ viewWS greedyViewOnScreen) + + compareAndSwitch hist wins pws | length hist < length wins = switchScreens $ hist <> populateScreens hist wins pws + | otherwise = switchScreens hist + + populateScreens hist wins pws = zip (filter (`notElem` map fst hist) $ W.screen <$> wins) (filter (`notElem` map snd hist) pws) + +-------------------------------------------------------------------------------- +chooseAction :: (String -> X ()) -> X () +chooseAction f = XS.gets current <&> (profileId . fromMaybe defaultProfile) >>= f + +-------------------------------------------------------------------------------- +-- | Create keybindings per profile. +bindOn :: [(String, X ())] -> X () +bindOn bindings = chooseAction chooser + where + chooser profile = case lookup profile bindings of + Just action -> action + Nothing -> case lookup "" bindings of + Just action -> action + Nothing -> return () + +-------------------------------------------------------------------------------- +-- | Loggs currentProfile and all profiles with hidden workspaces +-- (workspaces that aren't shown on a screen but have windows). +profileLogger :: (String -> String) -> (String -> String) -> Logger +profileLogger formatFocused formatUnfocused = do + hws <- gets $ W.hidden . windowset + p <- currentProfile + hm <- map fst + . filter (\(p', xs) -> any ((`elem` htags hws) . snd) xs || p' == p) + . Map.toList <$> profileHistory + return $ Just $ foldl (\a b -> a ++ " " ++ b) "" $ format p <$> hm + where + format p a = if a == p then formatFocused a else formatUnfocused a + htags wins = W.tag <$> filter (isJust . W.stack) wins + +-------------------------------------------------------------------------------- +-- | @XWindowMap@ of all windows contained in a profile. +allProfileWindows :: XWindowMap +allProfileWindows = allProfileWindows' def + +-------------------------------------------------------------------------------- +allProfileWindows' :: WindowBringerConfig -> XWindowMap +allProfileWindows' WindowBringerConfig{ windowTitler = titler, windowFilter = include } = do + pws <- currentProfileWorkspaces + windowSet <- gets windowset + Map.fromList . concat <$> mapM keyValuePairs (filter ((`elem` pws) . W.tag) $ W.workspaces windowSet) + where keyValuePairs ws = let wins = W.integrate' (W.stack ws) + in mapM (keyValuePair ws) =<< filterM include wins + keyValuePair ws w = (, w) <$> titler ws w diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index cbb0916a..7db7c8fd 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -130,6 +130,7 @@ library XMonad.Actions.PhysicalScreens XMonad.Actions.Plane XMonad.Actions.Prefix + XMonad.Actions.Profiles XMonad.Actions.Promote XMonad.Actions.RandomBackground XMonad.Actions.RepeatAction