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

--------------------------------------------------------------------------------
instance ExtensionClass ProfileHistory where
  extensionType :: ProfileHistory -> StateExtension
extensionType = ProfileHistory -> StateExtension
forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
  initialValue :: ProfileHistory
initialValue = Map WorkspaceId [(ScreenId, WorkspaceId)] -> ProfileHistory
ProfileHistory Map WorkspaceId [(ScreenId, WorkspaceId)]
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 (Profile -> WorkspaceId)
-> (ProfileState -> Profile) -> ProfileState -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> Maybe Profile -> Profile
forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile (Maybe Profile -> Profile)
-> (ProfileState -> Maybe Profile) -> ProfileState -> Profile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProfileState -> Maybe Profile
current (ProfileState -> WorkspaceId) -> X ProfileState -> X WorkspaceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X ProfileState
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get

--------------------------------------------------------------------------------
-- | Returns previous profile.
previousProfile :: X (Maybe ProfileId)
previousProfile :: X (Maybe WorkspaceId)
previousProfile = (ProfileState -> Maybe WorkspaceId) -> X (Maybe WorkspaceId)
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 = (ProfileHistory -> Map WorkspaceId [(ScreenId, WorkspaceId)])
-> X (Map WorkspaceId [(ScreenId, WorkspaceId)])
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 = (ProfileState -> ProfileMap) -> X 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 = ProfileMap -> [WorkspaceId]
forall k a. Map k a -> [k]
Map.keys (ProfileMap -> [WorkspaceId]) -> X ProfileMap -> X [WorkspaceId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProfileState -> ProfileMap) -> X ProfileMap
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> ProfileMap
profilesMap

--------------------------------------------------------------------------------
currentProfileWorkspaces :: X [WorkspaceId]
currentProfileWorkspaces :: X [WorkspaceId]
currentProfileWorkspaces = (ProfileState -> Maybe Profile) -> X (Maybe Profile)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> Maybe Profile
current X (Maybe Profile)
-> (Maybe Profile -> [WorkspaceId]) -> X [WorkspaceId]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Profile -> [WorkspaceId]
profileWS (Profile -> [WorkspaceId])
-> (Maybe Profile -> Profile) -> Maybe Profile -> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> Maybe Profile -> Profile
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 = X () -> XConfig a -> XConfig a
forall (l :: * -> *). X () -> XConfig l -> XConfig l
addAfterRescreenHook X ()
hook (XConfig a -> XConfig a) -> XConfig a -> XConfig a
forall a b. (a -> b) -> a -> b
$ XConfig a
conf
  { startupHook = profileStartupHook' <> startupHook 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 X WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
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 = profileHistoryHookExclude (workspaceExcludes profConf) <> logHook conf
  }
  where
   conf' :: XConfig a
conf' = ProfileConfig -> XConfig a -> XConfig a
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 <- (XState
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState
  -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X (Screen
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> (XState
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
  [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis <- (XState
 -> [Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> X [Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState
  -> [Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
 -> X [Screen
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> (XState
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> X [Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
  [WorkspaceId]
pws <- X [WorkspaceId]
currentProfileWorkspaces
  WorkspaceId
p <- X WorkspaceId
currentProfile

  WorkspaceId -> [(ScreenId, WorkspaceId)] -> X ()
updateHist WorkspaceId
p ([(ScreenId, WorkspaceId)] -> X ())
-> [(ScreenId, WorkspaceId)] -> X ()
forall a b. (a -> b) -> a -> b
$ [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [(ScreenId, WorkspaceId)]
forall {b} {l} {a} {sid} {sd}. [Screen b l a sid sd] -> [(sid, b)]
workspaceScreenPairs ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [(ScreenId, WorkspaceId)])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [(ScreenId, WorkspaceId)]
forall a b. (a -> b) -> a -> b
$ [WorkspaceId]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
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 ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curScreen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall 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 = [sid] -> [b] -> [(sid, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Screen b l a sid sd -> sid
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen (Screen b l a sid sd -> sid) -> [Screen b l a sid sd] -> [sid]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Screen b l a sid sd]
wins) (Workspace b l a -> b
forall i l a. Workspace i l a -> i
W.tag (Workspace b l a -> b)
-> (Screen b l a sid sd -> Workspace b l a)
-> Screen b l a sid sd
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen b l a sid sd -> Workspace b l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen b l a sid sd -> b) -> [Screen b l a sid sd] -> [b]
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 = (Screen WorkspaceId l a sid sd -> Bool)
-> [Screen WorkspaceId l a sid sd]
-> [Screen WorkspaceId l a sid sd]
forall a. (a -> Bool) -> [a] -> [a]
filter ((\WorkspaceId
wid -> (WorkspaceId
wid WorkspaceId -> t WorkspaceId -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t WorkspaceId
pws) Bool -> Bool -> Bool
&& (WorkspaceId
wid WorkspaceId -> [WorkspaceId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [WorkspaceId]
ews)) (WorkspaceId -> Bool)
-> (Screen WorkspaceId l a sid sd -> WorkspaceId)
-> Screen WorkspaceId l a sid sd
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceId l a -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId l a -> WorkspaceId)
-> (Screen WorkspaceId l a sid sd -> Workspace WorkspaceId l a)
-> Screen WorkspaceId l a sid sd
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId l a sid sd -> Workspace WorkspaceId l a
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 X [WorkspaceId] -> ([WorkspaceId] -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ProfileHistory -> ProfileHistory) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify' ((ProfileHistory -> ProfileHistory) -> X ())
-> ([WorkspaceId] -> ProfileHistory -> ProfileHistory)
-> [WorkspaceId]
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WorkspaceId] -> ProfileHistory -> ProfileHistory
update
  where
    update :: [WorkspaceId] -> ProfileHistory -> ProfileHistory
update [WorkspaceId]
pws ProfileHistory
hs = ProfileHistory -> ProfileHistory
forall a. NFData a => a -> a
force (ProfileHistory -> ProfileHistory)
-> ProfileHistory -> ProfileHistory
forall a b. (a -> b) -> a -> b
$ ProfileHistory
hs { history = doUpdate pws $ history hs }

    doUpdate :: [WorkspaceId]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
doUpdate [WorkspaceId]
pws Map WorkspaceId [(ScreenId, WorkspaceId)]
hist = (Map WorkspaceId [(ScreenId, WorkspaceId)]
 -> (ScreenId, WorkspaceId)
 -> Map WorkspaceId [(ScreenId, WorkspaceId)])
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
-> [(ScreenId, WorkspaceId)]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Map WorkspaceId [(ScreenId, WorkspaceId)]
acc (ScreenId
sid, WorkspaceId
wid) -> (Maybe [(ScreenId, WorkspaceId)]
 -> Maybe [(ScreenId, WorkspaceId)])
-> WorkspaceId
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter ([WorkspaceId]
-> ScreenId
-> WorkspaceId
-> Maybe [(ScreenId, WorkspaceId)]
-> Maybe [(ScreenId, WorkspaceId)]
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 -> [(ScreenId, WorkspaceId)] -> f [(ScreenId, WorkspaceId)]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(ScreenId
sid, WorkspaceId
wid)]
      Just [(ScreenId, WorkspaceId)]
hs -> [(ScreenId, WorkspaceId)] -> f [(ScreenId, WorkspaceId)]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(ScreenId, WorkspaceId)] -> f [(ScreenId, WorkspaceId)])
-> [(ScreenId, WorkspaceId)] -> f [(ScreenId, WorkspaceId)]
forall a b. (a -> b) -> a -> b
$ let new :: (ScreenId, WorkspaceId)
new = (ScreenId
sid, WorkspaceId
wid) in (ScreenId, WorkspaceId)
new(ScreenId, WorkspaceId)
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
forall 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 = ((ScreenId, WorkspaceId) -> Bool)
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ScreenId, WorkspaceId)
x -> (ScreenId, WorkspaceId) -> WorkspaceId
forall a b. (a, b) -> b
snd (ScreenId, WorkspaceId)
x WorkspaceId -> [WorkspaceId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
pws Bool -> Bool -> Bool
&& (ScreenId, WorkspaceId)
x (ScreenId, WorkspaceId) -> (ScreenId, WorkspaceId) -> Bool
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 = (ProfileState -> ProfileState) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ProfileState -> ProfileState
go X () -> X () -> X ()
forall a b. X a -> X b -> X b
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 = update $ profilesMap s, current = setCurrentProfile $ Map.fromList $ map entry ps}

    update :: ProfileMap -> ProfileMap
    update :: ProfileMap -> ProfileMap
update = ProfileMap -> ProfileMap -> ProfileMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ([(WorkspaceId, Profile)] -> ProfileMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(WorkspaceId, Profile)] -> ProfileMap)
-> [(WorkspaceId, Profile)] -> ProfileMap
forall a b. (a -> b) -> a -> b
$ (Profile -> (WorkspaceId, Profile))
-> [Profile] -> [(WorkspaceId, Profile)]
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 WorkspaceId -> ProfileMap -> Maybe Profile
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid ProfileMap
s of
      Maybe Profile
Nothing -> Profile -> Maybe Profile
forall a. a -> Maybe a
Just (Profile -> Maybe Profile) -> Profile -> Maybe Profile
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid []
      Just Profile
pn -> Profile -> Maybe Profile
forall a. a -> Maybe a
Just Profile
pn

--------------------------------------------------------------------------------
setPrevious :: ProfileId -> X()
setPrevious :: WorkspaceId -> X ()
setPrevious WorkspaceId
name = (ProfileState -> ProfileState) -> X ()
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 = doUpdate ps }
    doUpdate :: ProfileState -> Maybe WorkspaceId
doUpdate ProfileState
ps = case WorkspaceId -> ProfileMap -> Maybe Profile
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
name (ProfileMap -> Maybe Profile) -> ProfileMap -> Maybe Profile
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 -> WorkspaceId -> Maybe WorkspaceId
forall a. a -> Maybe a
Just (WorkspaceId -> Maybe WorkspaceId)
-> WorkspaceId -> Maybe WorkspaceId
forall a b. (a -> b) -> a -> b
$ Profile -> WorkspaceId
profileId Profile
p

--------------------------------------------------------------------------------
setProfile :: ProfileId -> X ()
setProfile :: WorkspaceId -> X ()
setProfile WorkspaceId
p = X WorkspaceId
currentProfile X WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
setPrevious X () -> X () -> X ()
forall a b. X a -> X b -> X b
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 = (ProfileState -> ProfileState) -> X ()
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 = doUpdate ps }
    doUpdate :: ProfileState -> Maybe Profile
doUpdate ProfileState
ps = case WorkspaceId -> ProfileMap -> Maybe Profile
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
name (ProfileMap -> Maybe Profile) -> ProfileMap -> Maybe Profile
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 -> Profile -> Maybe Profile
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 X () -> X () -> X ()
forall a b. X a -> X b -> X b
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 X ProfileMap -> (ProfileMap -> X [WorkspaceId]) -> X [WorkspaceId]
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProfileMap -> X [WorkspaceId]
forall {m :: * -> *}. Monad m => ProfileMap -> m [WorkspaceId]
findPWs
  where
    findPWs :: ProfileMap -> m [WorkspaceId]
findPWs ProfileMap
pm = [WorkspaceId] -> m [WorkspaceId]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([WorkspaceId] -> m [WorkspaceId])
-> (Maybe Profile -> [WorkspaceId])
-> Maybe Profile
-> m [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> [WorkspaceId]
profileWS (Profile -> [WorkspaceId])
-> (Maybe Profile -> Profile) -> Maybe Profile -> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> Maybe Profile -> Profile
forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile (Maybe Profile -> m [WorkspaceId])
-> Maybe Profile -> m [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> ProfileMap -> Maybe Profile
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
  ProfilePrompt
-> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
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 <- (XState -> [WorkspaceId]) -> X [WorkspaceId]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [WorkspaceId]) -> X [WorkspaceId])
-> (XState -> [WorkspaceId]) -> X [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Workspace WorkspaceId (Layout Window) Window)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [WorkspaceId])
-> (XState
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> XState
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
     WorkspaceId
cur <- (XState -> WorkspaceId) -> X WorkspaceId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> WorkspaceId) -> X WorkspaceId)
-> (XState -> WorkspaceId) -> X WorkspaceId
forall a b. (a -> b) -> a -> b
$ Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (XState -> Workspace WorkspaceId (Layout Window) Window)
-> XState
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> (XState
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Workspace WorkspaceId (Layout Window) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
     [WorkspaceId]
hid <- (XState -> [WorkspaceId]) -> X [WorkspaceId]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [WorkspaceId]) -> X [WorkspaceId])
-> (XState -> [WorkspaceId]) -> X [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> [Workspace WorkspaceId (Layout Window) Window] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag ([Workspace WorkspaceId (Layout Window) Window] -> [WorkspaceId])
-> (XState -> [Workspace WorkspaceId (Layout Window) Window])
-> XState
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Workspace WorkspaceId (Layout Window) Window]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [Workspace WorkspaceId (Layout Window) Window])
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace WorkspaceId (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
     let
       arr :: [WorkspaceId]
arr = WorkspaceId
curWorkspaceId -> [WorkspaceId] -> [WorkspaceId]
forall a. a -> [a] -> [a]
:([WorkspaceId]
vis [WorkspaceId] -> [WorkspaceId] -> [WorkspaceId]
forall a. Semigroup a => a -> a -> a
<> [WorkspaceId]
hid)
       in ProfilePrompt
-> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
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
  ProfilePrompt
-> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
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 ([WorkspaceId] -> X ()) -> X [WorkspaceId] -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X [WorkspaceId]
currentProfileWorkspaces
  where
    mkPrompt :: [WorkspaceId] -> X ()
mkPrompt [WorkspaceId]
pws = ProfilePrompt
-> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
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 (WorkspaceId -> X [WorkspaceId])
-> X WorkspaceId -> X [WorkspaceId]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X WorkspaceId
currentProfile
      Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WorkspaceId
wid WorkspaceId -> [WorkspaceId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [WorkspaceId]
pw) ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (WorkspaceId
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceId
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
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 (WorkspaceId -> X ()) -> WorkspaceId -> X ()
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 ([WorkspaceId] -> X ()) -> X [WorkspaceId] -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X [WorkspaceId]
currentProfileWorkspaces
  where
    mkPrompt :: [WorkspaceId] -> X ()
mkPrompt [WorkspaceId]
pws = ProfilePrompt
-> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
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 (WorkspaceId -> X [WorkspaceId])
-> X WorkspaceId -> X [WorkspaceId]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X WorkspaceId
currentProfile
      Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WorkspaceId
wid WorkspaceId -> [WorkspaceId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [WorkspaceId]
pw) ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (WorkspaceId
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceId
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
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 (WorkspaceId -> X ()) -> WorkspaceId -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId
wid)

--------------------------------------------------------------------------------
addWSToProfile :: WorkspaceId -> ProfileId -> X()
addWSToProfile :: WorkspaceId -> WorkspaceId -> X ()
addWSToProfile WorkspaceId
wid WorkspaceId
pid = (ProfileState -> ProfileState) -> X ()
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 = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}

   update :: ProfileMap -> ProfileMap
   update :: ProfileMap -> ProfileMap
update ProfileMap
mp = case WorkspaceId -> ProfileMap -> Maybe Profile
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 WorkspaceId -> [WorkspaceId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Profile -> [WorkspaceId]
profileWS Profile
p then ProfileMap
mp else (Profile -> Profile) -> WorkspaceId -> ProfileMap -> ProfileMap
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 WorkspaceId -> [WorkspaceId] -> [WorkspaceId]
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 WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
== WorkspaceId
pid Bool -> Bool -> Bool
&& WorkspaceId
wid WorkspaceId -> [WorkspaceId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Profile -> [WorkspaceId]
profileWS Profile
cp then Profile -> Maybe Profile
forall a. a -> Maybe a
Just (WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid ([WorkspaceId] -> Profile) -> [WorkspaceId] -> Profile
forall a b. (a -> b) -> a -> b
$ WorkspaceId
widWorkspaceId -> [WorkspaceId] -> [WorkspaceId]
forall a. a -> [a] -> [a]
:Profile -> [WorkspaceId]
profileWS Profile
cp) else Profile -> Maybe Profile
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
  ProfilePrompt
-> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
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
     ProfilePrompt
-> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
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) ((WorkspaceId -> X ()) -> X ()) -> (WorkspaceId -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$
       \WorkspaceId
ws -> do
         WorkspaceId
cp <- X WorkspaceId
currentProfile
         WorkspaceId
ws WorkspaceId -> WorkspaceId -> X ()
`removeWSFromProfile` WorkspaceId
p 
         Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WorkspaceId
cp WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
== WorkspaceId
p) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ X WorkspaceId
currentProfile X WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
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 = (ProfileState -> ProfileState) -> X ()
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 = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}

   update :: ProfileMap -> ProfileMap
   update :: ProfileMap -> ProfileMap
update ProfileMap
mp = case WorkspaceId -> ProfileMap -> Maybe Profile
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 WorkspaceId -> [WorkspaceId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Profile -> [WorkspaceId]
profileWS Profile
p then (Profile -> Profile) -> WorkspaceId -> ProfileMap -> ProfileMap
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 (WorkspaceId -> [WorkspaceId] -> [WorkspaceId]
forall a. Eq a => a -> [a] -> [a]
delete WorkspaceId
wid ([WorkspaceId] -> [WorkspaceId]) -> [WorkspaceId] -> [WorkspaceId]
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 WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
== WorkspaceId
pid Bool -> Bool -> Bool
&& WorkspaceId
wid WorkspaceId -> [WorkspaceId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Profile -> [WorkspaceId]
profileWS Profile
cp then Profile -> Maybe Profile
forall a. a -> Maybe a
Just (WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid ([WorkspaceId] -> Profile) -> [WorkspaceId] -> Profile
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> [WorkspaceId] -> [WorkspaceId]
forall a. Eq a => a -> [a] -> [a]
delete WorkspaceId
wid ([WorkspaceId] -> [WorkspaceId]) -> [WorkspaceId] -> [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ Profile -> [WorkspaceId]
profileWS Profile
cp) else Profile -> Maybe Profile
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 = [WorkspaceId] -> PP
forall {t :: * -> *}. Foldable t => t WorkspaceId -> PP
modifyPP ([WorkspaceId] -> PP) -> X [WorkspaceId] -> X PP
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 = ppRename pp . printTag pws }
    printTag :: t WorkspaceId -> ShowS
printTag t WorkspaceId
pws WorkspaceId
tag = if WorkspaceId
tag WorkspaceId -> t WorkspaceId -> Bool
forall a. Eq a => a -> t a -> Bool
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 (X (Workspace WorkspaceId (Layout Window) Window -> Bool)
 -> WSType)
-> X (Workspace WorkspaceId (Layout Window) Window -> Bool)
-> WSType
forall a b. (a -> b) -> a -> b
$ X [WorkspaceId]
currentProfileWorkspaces X [WorkspaceId]
-> ([WorkspaceId]
    -> X (Workspace WorkspaceId (Layout Window) Window -> Bool))
-> X (Workspace WorkspaceId (Layout Window) Window -> Bool)
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[WorkspaceId]
ws -> (Workspace WorkspaceId (Layout Window) Window -> Bool)
-> X (Workspace WorkspaceId (Layout Window) Window -> Bool)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Workspace WorkspaceId (Layout Window) Window -> Bool)
 -> X (Workspace WorkspaceId (Layout Window) Window -> Bool))
-> (Workspace WorkspaceId (Layout Window) Window -> Bool)
-> X (Workspace WorkspaceId (Layout Window) Window -> Bool)
forall a b. (a -> b) -> a -> b
$ (WorkspaceId -> [WorkspaceId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
ws) (WorkspaceId -> Bool)
-> (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> Workspace WorkspaceId (Layout Window) Window
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
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 <- (XState
 -> [Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> X [Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState
  -> [Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
 -> X [Screen
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> (XState
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> X [Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
  Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cur <- (XState
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState
  -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X (Screen
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> (XState
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
  [WorkspaceId]
pws <- X ProfileMap
profileMap X ProfileMap -> (ProfileMap -> [WorkspaceId]) -> X [WorkspaceId]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Profile -> [WorkspaceId]
profileWS (Profile -> [WorkspaceId])
-> (ProfileMap -> Profile) -> ProfileMap -> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> Maybe Profile -> Profile
forall a. a -> Maybe a -> a
fromMaybe (WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid []) (Maybe Profile -> Profile)
-> (ProfileMap -> Maybe Profile) -> ProfileMap -> Profile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> ProfileMap -> Maybe Profile
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid)
  case WorkspaceId
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
-> Maybe [(ScreenId, WorkspaceId)]
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 ([(ScreenId, WorkspaceId)] -> X ())
-> [(ScreenId, WorkspaceId)] -> X ()
forall a b. (a -> b) -> a -> b
$ [ScreenId] -> [WorkspaceId] -> [(ScreenId, WorkspaceId)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> ScreenId)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [ScreenId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curScreen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis)) [WorkspaceId]
pws
    Just [(ScreenId, WorkspaceId)]
xs -> [(ScreenId, WorkspaceId)]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [WorkspaceId]
-> X ()
forall {i} {l} {a} {sd}.
[(ScreenId, WorkspaceId)]
-> [Screen i l a ScreenId sd] -> [WorkspaceId] -> X ()
compareAndSwitch ([ScreenId]
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
f (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> ScreenId)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [ScreenId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curScreen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis) [(ScreenId, WorkspaceId)]
xs) (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curScreen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall 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 = [(WorkspaceId, ScreenId)] -> [(ScreenId, WorkspaceId)]
forall k v. (Ord k, Ord v) => [(k, v)] -> [(v, k)]
reorderUniq ([(WorkspaceId, ScreenId)] -> [(ScreenId, WorkspaceId)])
-> ([(ScreenId, WorkspaceId)] -> [(WorkspaceId, ScreenId)])
-> [(ScreenId, WorkspaceId)]
-> [(ScreenId, WorkspaceId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ScreenId, WorkspaceId)] -> [(WorkspaceId, ScreenId)]
forall k v. (Ord k, Ord v) => [(k, v)] -> [(v, k)]
reorderUniq ([(ScreenId, WorkspaceId)] -> [(WorkspaceId, ScreenId)])
-> ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)])
-> [(ScreenId, WorkspaceId)]
-> [(WorkspaceId, ScreenId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
forall a. [a] -> [a]
reverse ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)])
-> ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)])
-> [(ScreenId, WorkspaceId)]
-> [(ScreenId, WorkspaceId)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ScreenId, WorkspaceId) -> Bool)
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ScreenId -> [ScreenId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScreenId]
sids) (ScreenId -> Bool)
-> ((ScreenId, WorkspaceId) -> ScreenId)
-> (ScreenId, WorkspaceId)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, WorkspaceId) -> ScreenId
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 = ((k, v) -> (v, k)) -> [(k, v)] -> [(v, k)]
forall a b. (a -> b) -> [a] -> [b]
map (\(k
x,v
y) -> (v
y,k
x)) ([(k, v)] -> [(v, k)])
-> ([(k, v)] -> [(k, v)]) -> [(k, v)] -> [(v, k)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, v)] -> [(k, v)]
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 = Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map k v -> [(k, v)])
-> ([(k, v)] -> Map k v) -> [(k, v)] -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

    viewWS :: (t
 -> t
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> t -> t -> X ()
viewWS t
-> t
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
fview t
sid t
wid = (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ t
-> t
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
fview t
sid t
wid

    switchScreens :: [(ScreenId, WorkspaceId)] -> X ()
switchScreens = ((ScreenId, WorkspaceId) -> X ())
-> [(ScreenId, WorkspaceId)] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ScreenId -> WorkspaceId -> X ())
-> (ScreenId, WorkspaceId) -> X ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ScreenId -> WorkspaceId -> X ())
 -> (ScreenId, WorkspaceId) -> X ())
-> (ScreenId -> WorkspaceId -> X ())
-> (ScreenId, WorkspaceId)
-> X ()
forall a b. (a -> b) -> a -> b
$ (ScreenId
 -> WorkspaceId
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> ScreenId -> WorkspaceId -> X ()
forall {t} {t}.
(t
 -> t
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> t -> t -> X ()
viewWS ScreenId
-> WorkspaceId
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
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 | [(ScreenId, WorkspaceId)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ScreenId, WorkspaceId)]
hist Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Screen i l a ScreenId sd] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Screen i l a ScreenId sd]
wins = [(ScreenId, WorkspaceId)] -> X ()
switchScreens ([(ScreenId, WorkspaceId)] -> X ())
-> [(ScreenId, WorkspaceId)] -> X ()
forall a b. (a -> b) -> a -> b
$ [(ScreenId, WorkspaceId)]
hist [(ScreenId, WorkspaceId)]
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
forall a. Semigroup a => a -> a -> a
<> [(ScreenId, WorkspaceId)]
-> [Screen i l a ScreenId sd]
-> [WorkspaceId]
-> [(ScreenId, WorkspaceId)]
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 = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((a, b) -> a) -> [(a, b)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> a
forall a b. (a, b) -> a
fst [(a, b)]
hist) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ Screen i l a a sd -> a
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen (Screen i l a a sd -> a) -> [Screen i l a a sd] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Screen i l a a sd]
wins) ((b -> Bool) -> [b] -> [b]
forall a. (a -> Bool) -> [a] -> [a]
filter (b -> [b] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd [(a, b)]
hist) [b]
pws)

--------------------------------------------------------------------------------
chooseAction :: (String -> X ()) -> X ()
chooseAction :: (WorkspaceId -> X ()) -> X ()
chooseAction WorkspaceId -> X ()
f = (ProfileState -> Maybe Profile) -> X (Maybe Profile)
forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> Maybe Profile
current X (Maybe Profile)
-> (Maybe Profile -> WorkspaceId) -> X WorkspaceId
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Profile -> WorkspaceId
profileId (Profile -> WorkspaceId)
-> (Maybe Profile -> Profile) -> Maybe Profile -> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> Maybe Profile -> Profile
forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile) X WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
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 WorkspaceId -> [(WorkspaceId, X ())] -> Maybe (X ())
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 WorkspaceId -> [(WorkspaceId, X ())] -> Maybe (X ())
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup WorkspaceId
"" [(WorkspaceId, X ())]
bindings of
            Just X ()
action -> X ()
action
            Maybe (X ())
Nothing -> () -> X ()
forall a. a -> X a
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 <- (XState -> [Workspace WorkspaceId (Layout Window) Window])
-> X [Workspace WorkspaceId (Layout Window) Window]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [Workspace WorkspaceId (Layout Window) Window])
 -> X [Workspace WorkspaceId (Layout Window) Window])
-> (XState -> [Workspace WorkspaceId (Layout Window) Window])
-> X [Workspace WorkspaceId (Layout Window) Window]
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Workspace WorkspaceId (Layout Window) Window]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [Workspace WorkspaceId (Layout Window) Window])
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace WorkspaceId (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
  WorkspaceId
p <- X WorkspaceId
currentProfile
  [WorkspaceId]
hm <- ((WorkspaceId, [(ScreenId, WorkspaceId)]) -> WorkspaceId)
-> [(WorkspaceId, [(ScreenId, WorkspaceId)])] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map (WorkspaceId, [(ScreenId, WorkspaceId)]) -> WorkspaceId
forall a b. (a, b) -> a
fst
      ([(WorkspaceId, [(ScreenId, WorkspaceId)])] -> [WorkspaceId])
-> (Map WorkspaceId [(ScreenId, WorkspaceId)]
    -> [(WorkspaceId, [(ScreenId, WorkspaceId)])])
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((WorkspaceId, [(ScreenId, WorkspaceId)]) -> Bool)
-> [(WorkspaceId, [(ScreenId, WorkspaceId)])]
-> [(WorkspaceId, [(ScreenId, WorkspaceId)])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(WorkspaceId
p', [(ScreenId, WorkspaceId)]
xs) -> ((ScreenId, WorkspaceId) -> Bool)
-> [(ScreenId, WorkspaceId)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((WorkspaceId -> [WorkspaceId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Workspace WorkspaceId (Layout Window) Window] -> [WorkspaceId]
forall {b} {l} {a}. [Workspace b l a] -> [b]
htags [Workspace WorkspaceId (Layout Window) Window]
hws) (WorkspaceId -> Bool)
-> ((ScreenId, WorkspaceId) -> WorkspaceId)
-> (ScreenId, WorkspaceId)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScreenId, WorkspaceId) -> WorkspaceId
forall a b. (a, b) -> b
snd) [(ScreenId, WorkspaceId)]
xs Bool -> Bool -> Bool
|| WorkspaceId
p' WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
== WorkspaceId
p)
      ([(WorkspaceId, [(ScreenId, WorkspaceId)])]
 -> [(WorkspaceId, [(ScreenId, WorkspaceId)])])
-> (Map WorkspaceId [(ScreenId, WorkspaceId)]
    -> [(WorkspaceId, [(ScreenId, WorkspaceId)])])
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
-> [(WorkspaceId, [(ScreenId, WorkspaceId)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WorkspaceId [(ScreenId, WorkspaceId)]
-> [(WorkspaceId, [(ScreenId, WorkspaceId)])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map WorkspaceId [(ScreenId, WorkspaceId)] -> [WorkspaceId])
-> X (Map WorkspaceId [(ScreenId, WorkspaceId)]) -> X [WorkspaceId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (Map WorkspaceId [(ScreenId, WorkspaceId)])
profileHistory
  Maybe WorkspaceId -> X (Maybe WorkspaceId)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WorkspaceId -> X (Maybe WorkspaceId))
-> Maybe WorkspaceId -> X (Maybe WorkspaceId)
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> Maybe WorkspaceId
forall a. a -> Maybe a
Just (WorkspaceId -> Maybe WorkspaceId)
-> WorkspaceId -> Maybe WorkspaceId
forall a b. (a -> b) -> a -> b
$ (WorkspaceId -> ShowS)
-> WorkspaceId -> [WorkspaceId] -> WorkspaceId
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\WorkspaceId
a WorkspaceId
b -> WorkspaceId
a WorkspaceId -> ShowS
forall a. [a] -> [a] -> [a]
++ WorkspaceId
" " WorkspaceId -> ShowS
forall a. [a] -> [a] -> [a]
++ WorkspaceId
b) WorkspaceId
"" ([WorkspaceId] -> WorkspaceId) -> [WorkspaceId] -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> ShowS
format WorkspaceId
p ShowS -> [WorkspaceId] -> [WorkspaceId]
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 WorkspaceId -> WorkspaceId -> Bool
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 = Workspace b l a -> b
forall i l a. Workspace i l a -> i
W.tag (Workspace b l a -> b) -> [Workspace b l a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Workspace b l a -> Bool) -> [Workspace b l a] -> [Workspace b l a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Stack a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Stack a) -> Bool)
-> (Workspace b l a -> Maybe (Stack a)) -> Workspace b l a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace b l a -> Maybe (Stack a)
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' WindowBringerConfig
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
  StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowSet <- (XState
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (StackSet
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset
  [(WorkspaceId, Window)] -> Map WorkspaceId Window
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(WorkspaceId, Window)] -> Map WorkspaceId Window)
-> ([[(WorkspaceId, Window)]] -> [(WorkspaceId, Window)])
-> [[(WorkspaceId, Window)]]
-> Map WorkspaceId Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(WorkspaceId, Window)]] -> [(WorkspaceId, Window)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(WorkspaceId, Window)]] -> Map WorkspaceId Window)
-> X [[(WorkspaceId, Window)]] -> XWindowMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Workspace WorkspaceId (Layout Window) Window
 -> X [(WorkspaceId, Window)])
-> [Workspace WorkspaceId (Layout Window) Window]
-> X [[(WorkspaceId, Window)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Workspace WorkspaceId (Layout Window) Window
-> X [(WorkspaceId, Window)]
keyValuePairs ((Workspace WorkspaceId (Layout Window) Window -> Bool)
-> [Workspace WorkspaceId (Layout Window) Window]
-> [Workspace WorkspaceId (Layout Window) Window]
forall a. (a -> Bool) -> [a] -> [a]
filter ((WorkspaceId -> [WorkspaceId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
pws) (WorkspaceId -> Bool)
-> (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> Workspace WorkspaceId (Layout Window) Window
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag) ([Workspace WorkspaceId (Layout Window) Window]
 -> [Workspace WorkspaceId (Layout Window) Window])
-> [Workspace WorkspaceId (Layout Window) Window]
-> [Workspace WorkspaceId (Layout Window) Window]
forall a b. (a -> b) -> a -> b
$ StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Workspace WorkspaceId (Layout Window) Window]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.workspaces StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowSet)
   where keyValuePairs :: Workspace WorkspaceId (Layout Window) Window
-> X [(WorkspaceId, Window)]
keyValuePairs Workspace WorkspaceId (Layout Window) Window
ws = let wins :: [Window]
wins = Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Workspace WorkspaceId (Layout Window) Window
-> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack Workspace WorkspaceId (Layout Window) Window
ws)
                           in (Window -> X (WorkspaceId, Window))
-> [Window] -> X [(WorkspaceId, Window)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Workspace WorkspaceId (Layout Window) Window
-> Window -> X (WorkspaceId, Window)
keyValuePair Workspace WorkspaceId (Layout Window) Window
ws) ([Window] -> X [(WorkspaceId, Window)])
-> X [Window] -> X [(WorkspaceId, Window)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Window -> X Bool) -> [Window] -> X [Window]
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) (WorkspaceId -> (WorkspaceId, Window))
-> X WorkspaceId -> X (WorkspaceId, Window)
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