{-# 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 <mislavzanic3@gmail.com>
-- 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
  { Profile -> WorkspaceId
profileId :: !ProfileId     -- ^ Profile name.
  , Profile -> [WorkspaceId]
profileWS :: ![WorkspaceId] -- ^ A list of workspaces contained within a profile.
  }

--------------------------------------------------------------------------------
-- | Internal profile state.
data ProfileState = ProfileState
  { ProfileState -> ProfileMap
profilesMap :: !ProfileMap
  , ProfileState -> Maybe Profile
current     :: !(Maybe Profile)
  , ProfileState -> Maybe WorkspaceId
previous    :: !(Maybe ProfileId)
  }

--------------------------------------------------------------------------------
-- | User config for profiles.
data ProfileConfig = ProfileConfig
  { ProfileConfig -> [WorkspaceId]
workspaceExcludes :: ![WorkspaceId] -- ^ A list of workspaces to exclude from the @profileHistoryHook@.
  , ProfileConfig -> [Profile]
profiles          :: ![Profile]     -- ^ A list of user-defined profiles.
  , ProfileConfig -> WorkspaceId
startingProfile   :: !ProfileId     -- ^ Profile shown on startup.
  }

--------------------------------------------------------------------------------
instance Default ProfileConfig where
  def :: ProfileConfig
def            = ProfileConfig { workspaceExcludes :: [WorkspaceId]
workspaceExcludes = []
                                 , profiles :: [Profile]
profiles          = []
                                 , startingProfile :: WorkspaceId
startingProfile   = WorkspaceId
""
                                 }

--------------------------------------------------------------------------------
instance ExtensionClass ProfileState where
  initialValue :: ProfileState
initialValue = ProfileMap -> Maybe Profile -> Maybe WorkspaceId -> ProfileState
ProfileState forall k a. Map k a
Map.empty forall a. Maybe a
Nothing forall a. Maybe a
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
  { ProfileHistory -> Map WorkspaceId [(ScreenId, WorkspaceId)]
history :: Map ProfileId [(ScreenId, WorkspaceId)]
  }
  deriving (ReadPrec [ProfileHistory]
ReadPrec ProfileHistory
Int -> ReadS ProfileHistory
ReadS [ProfileHistory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProfileHistory]
$creadListPrec :: ReadPrec [ProfileHistory]
readPrec :: ReadPrec ProfileHistory
$creadPrec :: ReadPrec ProfileHistory
readList :: ReadS [ProfileHistory]
$creadList :: ReadS [ProfileHistory]
readsPrec :: Int -> ReadS ProfileHistory
$creadsPrec :: Int -> ReadS ProfileHistory
Read, Int -> ProfileHistory -> ShowS
[ProfileHistory] -> ShowS
ProfileHistory -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [ProfileHistory] -> ShowS
$cshowList :: [ProfileHistory] -> ShowS
show :: ProfileHistory -> WorkspaceId
$cshow :: ProfileHistory -> WorkspaceId
showsPrec :: Int -> ProfileHistory -> ShowS
$cshowsPrec :: Int -> ProfileHistory -> ShowS
Show)
  deriving ProfileHistory -> ()
forall a. (a -> ()) -> NFData a
rnf :: ProfileHistory -> ()
$crnf :: ProfileHistory -> ()
NFData via Map ProfileId [(Int, WorkspaceId)]

--------------------------------------------------------------------------------
instance ExtensionClass ProfileHistory where
  extensionType :: ProfileHistory -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
  initialValue :: ProfileHistory
initialValue = Map WorkspaceId [(ScreenId, WorkspaceId)] -> ProfileHistory
ProfileHistory forall k a. Map k a
Map.empty

--------------------------------------------------------------------------------
newtype ProfilePrompt = ProfilePrompt String

--------------------------------------------------------------------------------
instance XPrompt ProfilePrompt where
  showXPrompt :: ProfilePrompt -> WorkspaceId
showXPrompt (ProfilePrompt WorkspaceId
x) = WorkspaceId
x

--------------------------------------------------------------------------------
defaultProfile :: Profile
defaultProfile :: Profile
defaultProfile = Profile
defaultProfile

--------------------------------------------------------------------------------
-- | Returns current profile.
currentProfile :: X ProfileId
currentProfile :: X WorkspaceId
currentProfile = Profile -> WorkspaceId
profileId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProfileState -> Maybe Profile
current forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get

--------------------------------------------------------------------------------
-- | Returns previous profile.
previousProfile :: X (Maybe ProfileId)
previousProfile :: X (Maybe WorkspaceId)
previousProfile = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> Maybe WorkspaceId
previous

--------------------------------------------------------------------------------
-- | Returns the history of viewed workspaces per profile.
profileHistory :: X (Map ProfileId [(ScreenId, WorkspaceId)])
profileHistory :: X (Map WorkspaceId [(ScreenId, WorkspaceId)])
profileHistory = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileHistory -> Map WorkspaceId [(ScreenId, WorkspaceId)]
history

--------------------------------------------------------------------------------
profileMap :: X ProfileMap
profileMap :: X ProfileMap
profileMap = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> ProfileMap
profilesMap

--------------------------------------------------------------------------------
-- | Returns ids of all profiles.
profileIds :: X [ProfileId]
profileIds :: X [WorkspaceId]
profileIds = forall k a. Map k a -> [k]
Map.keys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> ProfileMap
profilesMap

--------------------------------------------------------------------------------
currentProfileWorkspaces :: X [WorkspaceId]
currentProfileWorkspaces :: X [WorkspaceId]
currentProfileWorkspaces = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> Maybe Profile
current forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Profile -> [WorkspaceId]
profileWS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Profile
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 :: forall (a :: * -> *). ProfileConfig -> XConfig a -> XConfig a
addProfiles ProfileConfig
profConf XConfig a
conf = forall (l :: * -> *). X () -> XConfig l -> XConfig l
addAfterRescreenHook X ()
hook forall a b. (a -> b) -> a -> b
$ XConfig a
conf
  { startupHook :: X ()
startupHook = X ()
profileStartupHook' forall a. Semigroup a => a -> a -> a
<> forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig a
conf
  }
 where
   profileStartupHook' :: X()
   profileStartupHook' :: X ()
profileStartupHook' = [Profile] -> WorkspaceId -> X ()
profilesStartupHook (ProfileConfig -> [Profile]
profiles ProfileConfig
profConf) (ProfileConfig -> WorkspaceId
startingProfile ProfileConfig
profConf)
   hook :: X ()
hook = X WorkspaceId
currentProfile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
switchWSOnScreens

--------------------------------------------------------------------------------
-- | Hooks profiles into XMonad and enables Profile history logging.
addProfilesWithHistory :: ProfileConfig -> XConfig a -> XConfig a
addProfilesWithHistory :: forall (a :: * -> *). ProfileConfig -> XConfig a -> XConfig a
addProfilesWithHistory ProfileConfig
profConf XConfig a
conf = XConfig a
conf'
  { logHook :: X ()
logHook = [WorkspaceId] -> X ()
profileHistoryHookExclude (ProfileConfig -> [WorkspaceId]
workspaceExcludes ProfileConfig
profConf) forall a. Semigroup a => a -> a -> a
<> forall (l :: * -> *). XConfig l -> X ()
logHook XConfig a
conf
  }
  where
   conf' :: XConfig a
conf' = forall (a :: * -> *). ProfileConfig -> XConfig a -> XConfig a
addProfiles ProfileConfig
profConf XConfig a
conf

--------------------------------------------------------------------------------
profileHistoryHookExclude :: [WorkspaceId] -> X()
profileHistoryHookExclude :: [WorkspaceId] -> X ()
profileHistoryHookExclude [WorkspaceId]
ews = do
  Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cur <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
  [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
  [WorkspaceId]
pws <- X [WorkspaceId]
currentProfileWorkspaces
  WorkspaceId
p <- X WorkspaceId
currentProfile

  WorkspaceId -> [(ScreenId, WorkspaceId)] -> X ()
updateHist WorkspaceId
p forall a b. (a -> b) -> a -> b
$ forall {b} {l} {a} {sid} {sd}. [Screen b l a sid sd] -> [(sid, b)]
workspaceScreenPairs forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {l} {a} {sid} {sd}.
Foldable t =>
t WorkspaceId
-> [Screen WorkspaceId l a sid sd]
-> [Screen WorkspaceId l a sid sd]
filterWS [WorkspaceId]
pws forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curforall a. a -> [a] -> [a]
:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis
  where
    workspaceScreenPairs :: [Screen b l a sid sd] -> [(sid, b)]
workspaceScreenPairs [Screen b l a sid sd]
wins = forall a b. [a] -> [b] -> [(a, b)]
zip (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Screen b l a sid sd]
wins) (forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Screen b l a sid sd]
wins)
    filterWS :: t WorkspaceId
-> [Screen WorkspaceId l a sid sd]
-> [Screen WorkspaceId l a sid sd]
filterWS t WorkspaceId
pws = forall a. (a -> Bool) -> [a] -> [a]
filter ((\WorkspaceId
wid -> (WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t WorkspaceId
pws) Bool -> Bool -> Bool
&& (WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [WorkspaceId]
ews)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace)

--------------------------------------------------------------------------------
updateHist :: ProfileId -> [(ScreenId, WorkspaceId)] -> X()
updateHist :: WorkspaceId -> [(ScreenId, WorkspaceId)] -> X ()
updateHist WorkspaceId
pid [(ScreenId, WorkspaceId)]
xs = WorkspaceId -> X [WorkspaceId]
profileWorkspaces WorkspaceId
pid forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WorkspaceId] -> ProfileHistory -> ProfileHistory
update
  where
    update :: [WorkspaceId] -> ProfileHistory -> ProfileHistory
update [WorkspaceId]
pws ProfileHistory
hs = forall a. NFData a => a -> a
force forall a b. (a -> b) -> a -> b
$ ProfileHistory
hs { history :: Map WorkspaceId [(ScreenId, WorkspaceId)]
history = [WorkspaceId]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
doUpdate [WorkspaceId]
pws forall a b. (a -> b) -> a -> b
$ ProfileHistory -> Map WorkspaceId [(ScreenId, WorkspaceId)]
history ProfileHistory
hs }

    doUpdate :: [WorkspaceId]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
doUpdate [WorkspaceId]
pws Map WorkspaceId [(ScreenId, WorkspaceId)]
hist = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Map WorkspaceId [(ScreenId, WorkspaceId)]
acc (ScreenId
sid, WorkspaceId
wid) -> forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (forall {f :: * -> *}.
Applicative f =>
[WorkspaceId]
-> ScreenId
-> WorkspaceId
-> Maybe [(ScreenId, WorkspaceId)]
-> f [(ScreenId, WorkspaceId)]
f [WorkspaceId]
pws ScreenId
sid WorkspaceId
wid) WorkspaceId
pid Map WorkspaceId [(ScreenId, WorkspaceId)]
acc) Map WorkspaceId [(ScreenId, WorkspaceId)]
hist [(ScreenId, WorkspaceId)]
xs

    f :: [WorkspaceId]
-> ScreenId
-> WorkspaceId
-> Maybe [(ScreenId, WorkspaceId)]
-> f [(ScreenId, WorkspaceId)]
f [WorkspaceId]
pws ScreenId
sid WorkspaceId
wid Maybe [(ScreenId, WorkspaceId)]
val = case Maybe [(ScreenId, WorkspaceId)]
val of
      Maybe [(ScreenId, WorkspaceId)]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [(ScreenId
sid, WorkspaceId
wid)]
      Just [(ScreenId, WorkspaceId)]
hs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ let new :: (ScreenId, WorkspaceId)
new = (ScreenId
sid, WorkspaceId
wid) in (ScreenId, WorkspaceId)
newforall a. a -> [a] -> [a]
:[WorkspaceId]
-> (ScreenId, WorkspaceId)
-> [(ScreenId, WorkspaceId)]
-> [(ScreenId, WorkspaceId)]
filterWS [WorkspaceId]
pws (ScreenId, WorkspaceId)
new [(ScreenId, WorkspaceId)]
hs

    filterWS :: [WorkspaceId] -> (ScreenId, WorkspaceId) -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
    filterWS :: [WorkspaceId]
-> (ScreenId, WorkspaceId)
-> [(ScreenId, WorkspaceId)]
-> [(ScreenId, WorkspaceId)]
filterWS [WorkspaceId]
pws (ScreenId, WorkspaceId)
new = forall a. (a -> Bool) -> [a] -> [a]
filter (\(ScreenId, WorkspaceId)
x -> forall a b. (a, b) -> b
snd (ScreenId, WorkspaceId)
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
pws Bool -> Bool -> Bool
&& (ScreenId, WorkspaceId)
x forall a. Eq a => a -> a -> Bool
/= (ScreenId, WorkspaceId)
new)

--------------------------------------------------------------------------------
-- | Adds profiles to ProfileState and sets current profile using .

profilesStartupHook :: [Profile] -> ProfileId -> X ()
profilesStartupHook :: [Profile] -> WorkspaceId -> X ()
profilesStartupHook [Profile]
ps WorkspaceId
pid = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ProfileState -> ProfileState
go forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WorkspaceId -> X ()
switchWSOnScreens WorkspaceId
pid
  where
    go :: ProfileState -> ProfileState
    go :: ProfileState -> ProfileState
go ProfileState
s = ProfileState
s {profilesMap :: ProfileMap
profilesMap = ProfileMap -> ProfileMap
update forall a b. (a -> b) -> a -> b
$ ProfileState -> ProfileMap
profilesMap ProfileState
s, current :: Maybe Profile
current = ProfileMap -> Maybe Profile
setCurrentProfile forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Profile -> (WorkspaceId, Profile)
entry [Profile]
ps}

    update :: ProfileMap -> ProfileMap
    update :: ProfileMap -> ProfileMap
update = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Profile -> (WorkspaceId, Profile)
entry [Profile]
ps)

    entry :: Profile -> (ProfileId, Profile)
    entry :: Profile -> (WorkspaceId, Profile)
entry Profile
p = (Profile -> WorkspaceId
profileId Profile
p, Profile
p)

    setCurrentProfile :: ProfileMap -> Maybe Profile
    setCurrentProfile :: ProfileMap -> Maybe Profile
setCurrentProfile ProfileMap
s = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid ProfileMap
s of
      Maybe Profile
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid []
      Just Profile
pn -> forall a. a -> Maybe a
Just Profile
pn

--------------------------------------------------------------------------------
setPrevious :: ProfileId -> X()
setPrevious :: WorkspaceId -> X ()
setPrevious WorkspaceId
name = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ProfileState -> ProfileState
update
  where
    update :: ProfileState -> ProfileState
update ProfileState
ps = ProfileState
ps { previous :: Maybe WorkspaceId
previous = ProfileState -> Maybe WorkspaceId
doUpdate ProfileState
ps }
    doUpdate :: ProfileState -> Maybe WorkspaceId
doUpdate ProfileState
ps = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
name forall a b. (a -> b) -> a -> b
$ ProfileState -> ProfileMap
profilesMap ProfileState
ps of
      Maybe Profile
Nothing -> ProfileState -> Maybe WorkspaceId
previous ProfileState
ps
      Just Profile
p -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Profile -> WorkspaceId
profileId Profile
p

--------------------------------------------------------------------------------
setProfile :: ProfileId -> X ()
setProfile :: WorkspaceId -> X ()
setProfile WorkspaceId
p = X WorkspaceId
currentProfile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
setPrevious forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WorkspaceId -> X ()
setProfile' WorkspaceId
p

--------------------------------------------------------------------------------
setProfile' :: ProfileId -> X ()
setProfile' :: WorkspaceId -> X ()
setProfile' WorkspaceId
name = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ProfileState -> ProfileState
update
  where
    update :: ProfileState -> ProfileState
update ProfileState
ps = ProfileState
ps { current :: Maybe Profile
current = ProfileState -> Maybe Profile
doUpdate ProfileState
ps }
    doUpdate :: ProfileState -> Maybe Profile
doUpdate ProfileState
ps = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
name forall a b. (a -> b) -> a -> b
$ ProfileState -> ProfileMap
profilesMap ProfileState
ps of
      Maybe Profile
Nothing -> ProfileState -> Maybe Profile
current ProfileState
ps
      Just Profile
p -> forall a. a -> Maybe a
Just Profile
p

--------------------------------------------------------------------------------
-- | Switch to a profile.
switchToProfile :: ProfileId -> X()
switchToProfile :: WorkspaceId -> X ()
switchToProfile WorkspaceId
pid = WorkspaceId -> X ()
setProfile WorkspaceId
pid forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WorkspaceId -> X ()
switchWSOnScreens WorkspaceId
pid

--------------------------------------------------------------------------------
-- | Returns the workspace ids associated with a profile id.
profileWorkspaces :: ProfileId -> X [WorkspaceId]
profileWorkspaces :: WorkspaceId -> X [WorkspaceId]
profileWorkspaces WorkspaceId
pid = X ProfileMap
profileMap forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}. Monad m => ProfileMap -> m [WorkspaceId]
findPWs
  where
    findPWs :: ProfileMap -> m [WorkspaceId]
findPWs ProfileMap
pm = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> [WorkspaceId]
profileWS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid ProfileMap
pm

--------------------------------------------------------------------------------
-- | Prompt for adding a workspace id to a profile.
addWSToProfilePrompt :: XPConfig -> X()
addWSToProfilePrompt :: XPConfig -> X ()
addWSToProfilePrompt XPConfig
c = do
  [WorkspaceId]
ps <- X [WorkspaceId]
profileIds
  forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Add ws to profile:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
ps) WorkspaceId -> X ()
f
  where
   f :: String -> X()
   f :: WorkspaceId -> X ()
f WorkspaceId
p = do
     [WorkspaceId]
vis <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
     WorkspaceId
cur <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
     [WorkspaceId]
hid <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
     let
       arr :: [WorkspaceId]
arr = WorkspaceId
curforall a. a -> [a] -> [a]
:([WorkspaceId]
vis forall a. Semigroup a => a -> a -> a
<> [WorkspaceId]
hid)
       in forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Ws to add to profile:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
arr) (WorkspaceId -> WorkspaceId -> X ()
`addWSToProfile` WorkspaceId
p)

--------------------------------------------------------------------------------
-- | Prompt for switching profiles.
switchProfilePrompt :: XPConfig -> X()
switchProfilePrompt :: XPConfig -> X ()
switchProfilePrompt XPConfig
c = do
  [WorkspaceId]
ps <- X [WorkspaceId]
profileIds
  forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Profile: ") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
ps) WorkspaceId -> X ()
switchToProfile
     
--------------------------------------------------------------------------------
-- | Prompt for switching workspaces.
switchProfileWSPrompt :: XPConfig -> X ()
switchProfileWSPrompt :: XPConfig -> X ()
switchProfileWSPrompt XPConfig
c = [WorkspaceId] -> X ()
mkPrompt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X [WorkspaceId]
currentProfileWorkspaces
  where
    mkPrompt :: [WorkspaceId] -> X ()
mkPrompt [WorkspaceId]
pws = forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Switch to workspace:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
pws) WorkspaceId -> X ()
mbygoto 
    mbygoto :: WorkspaceId -> X ()
mbygoto WorkspaceId
wid = do
      [WorkspaceId]
pw <- WorkspaceId -> X [WorkspaceId]
profileWorkspaces forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X WorkspaceId
currentProfile
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [WorkspaceId]
pw) ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.greedyView forall a b. (a -> b) -> a -> b
$ WorkspaceId
wid)

--------------------------------------------------------------------------------
-- | Prompt for shifting windows to a different workspace.
shiftProfileWSPrompt :: XPConfig -> X ()
shiftProfileWSPrompt :: XPConfig -> X ()
shiftProfileWSPrompt XPConfig
c = [WorkspaceId] -> X ()
mkPrompt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X [WorkspaceId]
currentProfileWorkspaces
  where
    mkPrompt :: [WorkspaceId] -> X ()
mkPrompt [WorkspaceId]
pws = forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Send window to workspace:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
pws) WorkspaceId -> X ()
mbyshift
    mbyshift :: WorkspaceId -> X ()
mbyshift WorkspaceId
wid = do
      [WorkspaceId]
pw <- WorkspaceId -> X [WorkspaceId]
profileWorkspaces forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X WorkspaceId
currentProfile
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [WorkspaceId]
pw) ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift forall a b. (a -> b) -> a -> b
$ WorkspaceId
wid)

--------------------------------------------------------------------------------
addWSToProfile :: WorkspaceId -> ProfileId -> X()
addWSToProfile :: WorkspaceId -> WorkspaceId -> X ()
addWSToProfile WorkspaceId
wid WorkspaceId
pid = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ProfileState -> ProfileState
go
  where
   go :: ProfileState -> ProfileState
   go :: ProfileState -> ProfileState
go ProfileState
ps = ProfileState
ps {profilesMap :: ProfileMap
profilesMap = ProfileMap -> ProfileMap
update forall a b. (a -> b) -> a -> b
$ ProfileState -> ProfileMap
profilesMap ProfileState
ps, current :: Maybe Profile
current = Profile -> Maybe Profile
update' forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile forall a b. (a -> b) -> a -> b
$ ProfileState -> Maybe Profile
current ProfileState
ps}

   update :: ProfileMap -> ProfileMap
   update :: ProfileMap -> ProfileMap
update ProfileMap
mp = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid ProfileMap
mp of
     Maybe Profile
Nothing -> ProfileMap
mp
     Just Profile
p  -> if WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Profile -> [WorkspaceId]
profileWS Profile
p then ProfileMap
mp else forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust Profile -> Profile
f WorkspaceId
pid ProfileMap
mp

   f :: Profile -> Profile
   f :: Profile -> Profile
f Profile
p = WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid (WorkspaceId
wid forall a. a -> [a] -> [a]
: Profile -> [WorkspaceId]
profileWS Profile
p)

   update' :: Profile -> Maybe Profile
   update' :: Profile -> Maybe Profile
update' Profile
cp = if Profile -> WorkspaceId
profileId Profile
cp forall a. Eq a => a -> a -> Bool
== WorkspaceId
pid Bool -> Bool -> Bool
&& WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Profile -> [WorkspaceId]
profileWS Profile
cp then forall a. a -> Maybe a
Just (WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid forall a b. (a -> b) -> a -> b
$ WorkspaceId
widforall a. a -> [a] -> [a]
:Profile -> [WorkspaceId]
profileWS Profile
cp) else forall a. a -> Maybe a
Just Profile
cp

--------------------------------------------------------------------------------
-- | Prompt for removing a workspace from a profile.
removeWSFromProfilePrompt :: XPConfig -> X()
removeWSFromProfilePrompt :: XPConfig -> X ()
removeWSFromProfilePrompt XPConfig
c = do
  [WorkspaceId]
ps <- X [WorkspaceId]
profileIds
  forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Remove ws from profile:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
ps) WorkspaceId -> X ()
f
  where
   f :: String -> X()
   f :: WorkspaceId -> X ()
f WorkspaceId
p = do
     [WorkspaceId]
arr <- WorkspaceId -> X [WorkspaceId]
profileWorkspaces WorkspaceId
p
     forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Ws to remove from profile:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
arr) forall a b. (a -> b) -> a -> b
$
       \WorkspaceId
ws -> do
         WorkspaceId
cp <- X WorkspaceId
currentProfile
         WorkspaceId
ws WorkspaceId -> WorkspaceId -> X ()
`removeWSFromProfile` WorkspaceId
p 
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WorkspaceId
cp forall a. Eq a => a -> a -> Bool
== WorkspaceId
p) forall a b. (a -> b) -> a -> b
$ X WorkspaceId
currentProfile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
switchWSOnScreens

--------------------------------------------------------------------------------
removeWSFromProfile :: WorkspaceId -> ProfileId -> X()
removeWSFromProfile :: WorkspaceId -> WorkspaceId -> X ()
removeWSFromProfile WorkspaceId
wid WorkspaceId
pid = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ProfileState -> ProfileState
go
  where
   go :: ProfileState -> ProfileState
   go :: ProfileState -> ProfileState
go ProfileState
ps = ProfileState
ps {profilesMap :: ProfileMap
profilesMap = ProfileMap -> ProfileMap
update forall a b. (a -> b) -> a -> b
$ ProfileState -> ProfileMap
profilesMap ProfileState
ps, current :: Maybe Profile
current = Profile -> Maybe Profile
update' forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile forall a b. (a -> b) -> a -> b
$ ProfileState -> Maybe Profile
current ProfileState
ps}

   update :: ProfileMap -> ProfileMap
   update :: ProfileMap -> ProfileMap
update ProfileMap
mp = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid ProfileMap
mp of
     Maybe Profile
Nothing -> ProfileMap
mp
     Just Profile
p  -> if WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Profile -> [WorkspaceId]
profileWS Profile
p then forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust Profile -> Profile
f WorkspaceId
pid ProfileMap
mp else ProfileMap
mp

   f :: Profile -> Profile
   f :: Profile -> Profile
f Profile
p = WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid (forall a. Eq a => a -> [a] -> [a]
delete WorkspaceId
wid forall a b. (a -> b) -> a -> b
$ Profile -> [WorkspaceId]
profileWS Profile
p)

   update' :: Profile -> Maybe Profile
   update' :: Profile -> Maybe Profile
update' Profile
cp = if Profile -> WorkspaceId
profileId Profile
cp forall a. Eq a => a -> a -> Bool
== WorkspaceId
pid Bool -> Bool -> Bool
&& WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Profile -> [WorkspaceId]
profileWS Profile
cp then forall a. a -> Maybe a
Just (WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete WorkspaceId
wid forall a b. (a -> b) -> a -> b
$ Profile -> [WorkspaceId]
profileWS Profile
cp) else forall a. a -> Maybe a
Just Profile
cp

--------------------------------------------------------------------------------
-- | Pretty printer for a bar. Prints workspace ids of current profile.
excludeWSPP :: PP -> X PP
excludeWSPP :: PP -> X PP
excludeWSPP PP
pp = forall {t :: * -> *}. Foldable t => t WorkspaceId -> PP
modifyPP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [WorkspaceId]
currentProfileWorkspaces
  where
    modifyPP :: t WorkspaceId -> PP
modifyPP t WorkspaceId
pws = PP
pp { ppRename :: WorkspaceId
-> Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
ppRename = PP
-> WorkspaceId
-> Workspace WorkspaceId (Layout Window) Window
-> WorkspaceId
ppRename PP
pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}. Foldable t => t WorkspaceId -> ShowS
printTag t WorkspaceId
pws }
    printTag :: t WorkspaceId -> ShowS
printTag t WorkspaceId
pws WorkspaceId
tag = if WorkspaceId
tag forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t WorkspaceId
pws then WorkspaceId
tag else WorkspaceId
""

--------------------------------------------------------------------------------
-- | For cycling through workspaces associated with the current.
wsFilter :: WSType
wsFilter :: WSType
wsFilter = X (Workspace WorkspaceId (Layout Window) Window -> Bool) -> WSType
WSIs forall a b. (a -> b) -> a -> b
$ X [WorkspaceId]
currentProfileWorkspaces forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[WorkspaceId]
ws -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
ws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> i
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 :: WorkspaceId -> X ()
switchWSOnScreens WorkspaceId
pid = do
  Map WorkspaceId [(ScreenId, WorkspaceId)]
hist <- X (Map WorkspaceId [(ScreenId, WorkspaceId)])
profileHistory
  [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
  Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cur <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
  [WorkspaceId]
pws <- X ProfileMap
profileMap forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Profile -> [WorkspaceId]
profileWS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid)
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid Map WorkspaceId [(ScreenId, WorkspaceId)]
hist of
    Maybe [(ScreenId, WorkspaceId)]
Nothing -> [(ScreenId, WorkspaceId)] -> X ()
switchScreens forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curforall a. a -> [a] -> [a]
:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis)) [WorkspaceId]
pws
    Just [(ScreenId, WorkspaceId)]
xs -> forall {i} {l} {a} {sd}.
[(ScreenId, WorkspaceId)]
-> [Screen i l a ScreenId sd] -> [WorkspaceId] -> X ()
compareAndSwitch ([ScreenId]
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
f (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curforall a. a -> [a] -> [a]
:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis) [(ScreenId, WorkspaceId)]
xs) (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curforall a. a -> [a] -> [a]
:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis) [WorkspaceId]
pws
  where
    f :: [ScreenId] -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
    f :: [ScreenId]
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
f [ScreenId]
sids = forall k v. (Ord k, Ord v) => [(k, v)] -> [(v, k)]
reorderUniq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Ord k, Ord v) => [(k, v)] -> [(v, k)]
reorderUniq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScreenId]
sids) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

    reorderUniq :: (Ord k, Ord v) => [(k,v)] -> [(v,k)]
    reorderUniq :: forall k v. (Ord k, Ord v) => [(k, v)] -> [(v, k)]
reorderUniq = forall a b. (a -> b) -> [a] -> [b]
map (\(k
x,v
y) -> (v
y,k
x)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Ord k, Ord v) => [(k, v)] -> [(k, v)]
uniq

    uniq :: (Ord k, Ord v) => [(k,v)] -> [(k,v)]
    uniq :: forall k v. (Ord k, Ord v) => [(k, v)] -> [(k, v)]
uniq = forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

    viewWS :: (t -> t -> WindowSet -> WindowSet) -> t -> t -> X ()
viewWS t -> t -> WindowSet -> WindowSet
fview t
sid t
wid = (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ t -> t -> WindowSet -> WindowSet
fview t
sid t
wid

    switchScreens :: [(ScreenId, WorkspaceId)] -> X ()
switchScreens = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall {t} {t}.
(t -> t -> WindowSet -> WindowSet) -> t -> t -> X ()
viewWS ScreenId -> WorkspaceId -> WindowSet -> WindowSet
greedyViewOnScreen)

    compareAndSwitch :: [(ScreenId, WorkspaceId)]
-> [Screen i l a ScreenId sd] -> [WorkspaceId] -> X ()
compareAndSwitch [(ScreenId, WorkspaceId)]
hist [Screen i l a ScreenId sd]
wins [WorkspaceId]
pws | forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ScreenId, WorkspaceId)]
hist forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [Screen i l a ScreenId sd]
wins = [(ScreenId, WorkspaceId)] -> X ()
switchScreens forall a b. (a -> b) -> a -> b
$ [(ScreenId, WorkspaceId)]
hist forall a. Semigroup a => a -> a -> a
<> forall {a} {b} {i} {l} {a} {sd}.
(Eq a, Eq b) =>
[(a, b)] -> [Screen i l a a sd] -> [b] -> [(a, b)]
populateScreens [(ScreenId, WorkspaceId)]
hist [Screen i l a ScreenId sd]
wins [WorkspaceId]
pws
                                   | Bool
otherwise                 = [(ScreenId, WorkspaceId)] -> X ()
switchScreens [(ScreenId, WorkspaceId)]
hist

    populateScreens :: [(a, b)] -> [Screen i l a a sd] -> [b] -> [(a, b)]
populateScreens [(a, b)]
hist [Screen i l a a sd]
wins [b]
pws = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(a, b)]
hist) forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Screen i l a a sd]
wins) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, b)]
hist) [b]
pws)

--------------------------------------------------------------------------------
chooseAction :: (String -> X ()) -> X ()
chooseAction :: (WorkspaceId -> X ()) -> X ()
chooseAction WorkspaceId -> X ()
f = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> Maybe Profile
current forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Profile -> WorkspaceId
profileId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
f

--------------------------------------------------------------------------------
-- | Create keybindings per profile.
bindOn :: [(String, X ())] -> X ()
bindOn :: [(WorkspaceId, X ())] -> X ()
bindOn [(WorkspaceId, X ())]
bindings = (WorkspaceId -> X ()) -> X ()
chooseAction WorkspaceId -> X ()
chooser
  where
    chooser :: WorkspaceId -> X ()
chooser WorkspaceId
profile = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup WorkspaceId
profile [(WorkspaceId, X ())]
bindings of
        Just X ()
action -> X ()
action
        Maybe (X ())
Nothing -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup WorkspaceId
"" [(WorkspaceId, X ())]
bindings of
            Just X ()
action -> X ()
action
            Maybe (X ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
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 :: ShowS -> ShowS -> X (Maybe WorkspaceId)
profileLogger ShowS
formatFocused ShowS
formatUnfocused = do
  [Workspace WorkspaceId (Layout Window) Window]
hws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
  WorkspaceId
p <- X WorkspaceId
currentProfile
  [WorkspaceId]
hm <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(WorkspaceId
p', [(ScreenId, WorkspaceId)]
xs) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall {b} {l} {a}. [Workspace b l a] -> [b]
htags [Workspace WorkspaceId (Layout Window) Window]
hws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(ScreenId, WorkspaceId)]
xs Bool -> Bool -> Bool
|| WorkspaceId
p' forall a. Eq a => a -> a -> Bool
== WorkspaceId
p)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (Map WorkspaceId [(ScreenId, WorkspaceId)])
profileHistory
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\WorkspaceId
a WorkspaceId
b -> WorkspaceId
a forall a. [a] -> [a] -> [a]
++ WorkspaceId
" " forall a. [a] -> [a] -> [a]
++ WorkspaceId
b) WorkspaceId
"" forall a b. (a -> b) -> a -> b
$ WorkspaceId -> ShowS
format WorkspaceId
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WorkspaceId]
hm
  where
    format :: WorkspaceId -> ShowS
format WorkspaceId
p WorkspaceId
a = if WorkspaceId
a forall a. Eq a => a -> a -> Bool
== WorkspaceId
p then ShowS
formatFocused WorkspaceId
a else ShowS
formatUnfocused WorkspaceId
a
    htags :: [Workspace b l a] -> [b]
htags [Workspace b l a]
wins = forall i l a. Workspace i l a -> i
W.tag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) [Workspace b l a]
wins

--------------------------------------------------------------------------------
-- | @XWindowMap@ of all windows contained in a profile.
allProfileWindows :: XWindowMap
allProfileWindows :: XWindowMap
allProfileWindows = WindowBringerConfig -> XWindowMap
allProfileWindows' forall a. Default a => a
def

--------------------------------------------------------------------------------
allProfileWindows' :: WindowBringerConfig -> XWindowMap
allProfileWindows' :: WindowBringerConfig -> XWindowMap
allProfileWindows' WindowBringerConfig{ windowTitler :: WindowBringerConfig
-> Workspace WorkspaceId (Layout Window) Window
-> Window
-> X WorkspaceId
windowTitler = Workspace WorkspaceId (Layout Window) Window
-> Window -> X WorkspaceId
titler, windowFilter :: WindowBringerConfig -> Window -> X Bool
windowFilter = Window -> X Bool
include } = do
  [WorkspaceId]
pws <- X [WorkspaceId]
currentProfileWorkspaces
  WindowSet
windowSet <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Workspace WorkspaceId (Layout Window) Window
-> X [(WorkspaceId, Window)]
keyValuePairs (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
pws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> i
W.tag) forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.workspaces WindowSet
windowSet)
   where keyValuePairs :: Workspace WorkspaceId (Layout Window) Window
-> X [(WorkspaceId, Window)]
keyValuePairs Workspace WorkspaceId (Layout Window) Window
ws = let wins :: [Window]
wins = forall a. Maybe (Stack a) -> [a]
W.integrate' (forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack Workspace WorkspaceId (Layout Window) Window
ws)
                           in forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Workspace WorkspaceId (Layout Window) Window
-> Window -> X (WorkspaceId, Window)
keyValuePair Workspace WorkspaceId (Layout Window) Window
ws) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Window -> X Bool
include [Window]
wins
         keyValuePair :: Workspace WorkspaceId (Layout Window) Window
-> Window -> X (WorkspaceId, Window)
keyValuePair Workspace WorkspaceId (Layout Window) Window
ws Window
w = (, Window
w) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workspace WorkspaceId (Layout Window) Window
-> Window -> X WorkspaceId
titler Workspace WorkspaceId (Layout Window) Window
ws Window
w