    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.LinkWorkspaces
    -- Description : Bindings to add and delete links between workspaces.
    -- Copyright   :  (c) Jan-David Quesel <quesel@gmail.org>
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  none
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- Provides bindings to add and delete links between workspaces. It is aimed
    -- at providing useful links between workspaces in a multihead setup. Linked
    -- workspaces are view at the same time.
    --
    -----------------------------------------------------------------------------

    module XMonad.Actions.LinkWorkspaces (
                                             -- * Usage
                                             -- $usage
                                            switchWS,
                                            removeAllMatchings,
                                            unMatch,
                                            toggleLinkWorkspaces,
                                            defaultMessageConf,
                                            MessageConfig(..)
                                           ) where

    import XMonad
    import XMonad.Prelude (for_)
    import qualified XMonad.StackSet as W
    import XMonad.Layout.IndependentScreens(countScreens)
    import qualified XMonad.Util.ExtensibleState as XS (get, put)
    import XMonad.Actions.OnScreen(Focus(FocusCurrent), onScreen')
    import qualified Data.Map as M
        ( insert, delete, Map, lookup, empty, filter )

    -- $usage
    -- You can use this module with the following in your @xmonad.hs@ file:
    --
    -- > import XMonad.Actions.LinkWorkspaces
    --
    -- and add a function to print messages like
    --
    -- > message_command (S screen) = " dzen2 -p 1 -w 300 -xs " ++ show (screen + 1)
    -- > message_color_func c1 c2 msg = dzenColor c1 c2 msg
    -- > message screen c1 c2 msg = spawn $ "echo '" ++ (message_color_func c1 c2 msg) ++ "' | " ++ message_command screen
    --
    -- alternatively you can use the noMessages function as the argument
    --
    -- Then add keybindings like the following:
    --
    -- > ,((modm, xK_p), toggleLinkWorkspaces message)
    -- > ,((modm .|. shiftMask, xK_p), removeAllMatchings message)
    --
    -- >   [ ((modm .|. m, k), a i)
    -- >       | (a, m) <- [(switchWS (\y -> windows $ view y) message, 0),(switchWS (\x -> windows $ shift x . view x) message, shiftMask)]
    -- >       , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]]
    --
    -- For detailed instructions on editing your key bindings, see
    -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

    data MessageConfig = MessageConfig {  MessageConfig
    -> ScreenId -> WorkspaceId -> WorkspaceId -> WorkspaceId -> X ()
    messageFunction :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
                        , MessageConfig -> WorkspaceId
    foreground :: [Char]
                        , MessageConfig -> WorkspaceId
    alertedForeground :: [Char]
                        , MessageConfig -> WorkspaceId
    background :: [Char]
                       }

    defaultMessageConf :: MessageConfig
    defaultMessageConf :: MessageConfig
    defaultMessageConf = MessageConfig { messageFunction :: ScreenId -> WorkspaceId -> WorkspaceId -> WorkspaceId -> X ()
    messageFunction = ScreenId -> WorkspaceId -> WorkspaceId -> WorkspaceId -> X ()
    noMessageFn
                         , background :: WorkspaceId
    background = WorkspaceId
    "#000000"
                         , alertedForeground :: WorkspaceId
    alertedForeground = WorkspaceId
    "#ff7701"
                         , foreground :: WorkspaceId
    foreground = WorkspaceId
    "#00ff00" }

    noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
    noMessageFn :: ScreenId -> WorkspaceId -> WorkspaceId -> WorkspaceId -> X ()
    noMessageFn ScreenId
    _ WorkspaceId
    _ WorkspaceId
    _ WorkspaceId
    _ = () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () :: X ()

    -- | Stuff for linking workspaces
    newtype WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (ReadPrec [WorkspaceMap]
    ReadPrec WorkspaceMap
    Int -> ReadS WorkspaceMap
    ReadS [WorkspaceMap]
    (Int -> ReadS WorkspaceMap)
    -> ReadS [WorkspaceMap]
    -> ReadPrec WorkspaceMap
    -> ReadPrec [WorkspaceMap]
    -> Read WorkspaceMap
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    $creadsPrec :: Int -> ReadS WorkspaceMap
    readsPrec :: Int -> ReadS WorkspaceMap
    $creadList :: ReadS [WorkspaceMap]
    readList :: ReadS [WorkspaceMap]
    $creadPrec :: ReadPrec WorkspaceMap
    readPrec :: ReadPrec WorkspaceMap
    $creadListPrec :: ReadPrec [WorkspaceMap]
    readListPrec :: ReadPrec [WorkspaceMap]
    Read, Int -> WorkspaceMap -> ShowS
    [WorkspaceMap] -> ShowS
    WorkspaceMap -> WorkspaceId
    (Int -> WorkspaceMap -> ShowS)
    -> (WorkspaceMap -> WorkspaceId)
    -> ([WorkspaceMap] -> ShowS)
    -> Show WorkspaceMap
    forall a.
    (Int -> a -> ShowS)
    -> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> WorkspaceMap -> ShowS
    showsPrec :: Int -> WorkspaceMap -> ShowS
    $cshow :: WorkspaceMap -> WorkspaceId
    show :: WorkspaceMap -> WorkspaceId
    $cshowList :: [WorkspaceMap] -> ShowS
    showList :: [WorkspaceMap] -> ShowS
    Show)
    instance ExtensionClass WorkspaceMap
        where initialValue :: WorkspaceMap
    initialValue = Map WorkspaceId WorkspaceId -> WorkspaceMap
    WorkspaceMap Map WorkspaceId WorkspaceId
    forall k a. Map k a
    M.empty
              extensionType :: WorkspaceMap -> StateExtension
    extensionType = WorkspaceMap -> StateExtension
    forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
    PersistentExtension

    switchWS :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> X ()
    switchWS :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> X ()
    switchWS WorkspaceId -> X ()
    f MessageConfig
    m WorkspaceId
    ws = (WorkspaceId -> X ())
    -> MessageConfig -> WorkspaceId -> Maybe ScreenId -> X ()
    switchWS' WorkspaceId -> X ()
    f MessageConfig
    m WorkspaceId
    ws Maybe ScreenId
    forall a. Maybe a
    Nothing

    -- | Switch to the given workspace in a non greedy way, stop if we reached the first screen
    -- | we already did switching on
    switchWS' :: (WorkspaceId -> X ()) -> MessageConfig  -> WorkspaceId -> Maybe ScreenId -> X ()
    switchWS' :: (WorkspaceId -> X ())
    -> MessageConfig -> WorkspaceId -> Maybe ScreenId -> X ()
    switchWS' WorkspaceId -> X ()
    switchFn MessageConfig
    message WorkspaceId
    workspace Maybe ScreenId
    stopAtScreen = do
      ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
      nScreens <- countScreens
      let now = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId
    forall i l a sid sd. Screen i l a sid sd -> sid
    W.screen (WindowSet
    -> 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 WindowSet
    ws)
      let next = (ScreenId
    now ScreenId -> ScreenId -> ScreenId
    forall a. Num a => a -> a -> a
    + ScreenId
    1) ScreenId -> ScreenId -> ScreenId
    forall a. Integral a => a -> a -> a
    `mod` ScreenId
    nScreens
      switchFn workspace
      case stopAtScreen of
        Maybe ScreenId
    Nothing -> ScreenId -> ScreenId -> Maybe ScreenId -> X ()
    sTM ScreenId
    now ScreenId
    next (ScreenId -> Maybe ScreenId
    forall a. a -> Maybe a
    Just ScreenId
    now)
        Just ScreenId
    sId -> if ScreenId
    sId ScreenId -> ScreenId -> Bool
    forall a. Eq a => a -> a -> Bool
    == ScreenId
    next then () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () else ScreenId -> ScreenId -> Maybe ScreenId -> X ()
    sTM ScreenId
    now ScreenId
    next (ScreenId -> Maybe ScreenId
    forall a. a -> Maybe a
    Just ScreenId
    sId)
      where sTM :: ScreenId -> ScreenId -> Maybe ScreenId -> X ()
    sTM = (WorkspaceId -> Maybe ScreenId -> X ())
    -> MessageConfig
    -> WorkspaceId
    -> ScreenId
    -> ScreenId
    -> Maybe ScreenId
    -> X ()
    switchToMatching ((WorkspaceId -> X ())
    -> MessageConfig -> WorkspaceId -> Maybe ScreenId -> X ()
    switchWS' WorkspaceId -> X ()
    switchFn MessageConfig
    message) MessageConfig
    message WorkspaceId
    workspace

    -- | Switch to the workspace that matches the current one, executing switches for that workspace as well.
    -- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again.
    switchToMatching :: (WorkspaceId -> Maybe ScreenId -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId
        -> ScreenId -> Maybe ScreenId -> X ()
    switchToMatching :: (WorkspaceId -> Maybe ScreenId -> X ())
    -> MessageConfig
    -> WorkspaceId
    -> ScreenId
    -> ScreenId
    -> Maybe ScreenId
    -> X ()
    switchToMatching WorkspaceId -> Maybe ScreenId -> X ()
    f MessageConfig
    message WorkspaceId
    t ScreenId
    now ScreenId
    next Maybe ScreenId
    stopAtScreen = do
        WorkspaceMap matchings <- X WorkspaceMap
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get :: X WorkspaceMap
        case M.lookup t matchings of
            Maybe WorkspaceId
    Nothing -> () -> X ()
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return () :: X()
            Just WorkspaceId
    newWorkspace -> do
                X () -> Focus -> ScreenId -> X ()
    onScreen' (WorkspaceId -> Maybe ScreenId -> X ()
    f WorkspaceId
    newWorkspace Maybe ScreenId
    stopAtScreen) Focus
    FocusCurrent ScreenId
    next
                MessageConfig
    -> ScreenId -> WorkspaceId -> WorkspaceId -> WorkspaceId -> X ()
    messageFunction MessageConfig
    message ScreenId
    now (MessageConfig -> WorkspaceId
    foreground MessageConfig
    message) (MessageConfig -> WorkspaceId
    background MessageConfig
    message) (WorkspaceId
    "Switching to: " WorkspaceId -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ (WorkspaceId
    t WorkspaceId -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ WorkspaceId
    " and " WorkspaceId -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ WorkspaceId
    newWorkspace))

    -- | Insert a mapping between t1 and t2 or remove it was already present
    toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X ()
    toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X ()
    toggleMatching MessageConfig
    message WorkspaceId
    t1 WorkspaceId
    t2 = do
        WorkspaceMap matchings <- X WorkspaceMap
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get :: X WorkspaceMap
        case M.lookup t1 matchings of
            Maybe WorkspaceId
    Nothing -> MessageConfig
    -> WorkspaceId
    -> WorkspaceId
    -> Map WorkspaceId WorkspaceId
    -> X ()
    setMatching MessageConfig
    message WorkspaceId
    t1 WorkspaceId
    t2 Map WorkspaceId WorkspaceId
    matchings
            Just WorkspaceId
    t -> if WorkspaceId
    t WorkspaceId -> WorkspaceId -> Bool
    forall a. Eq a => a -> a -> Bool
    == WorkspaceId
    t2 then MessageConfig
    -> WorkspaceId
    -> WorkspaceId
    -> Map WorkspaceId WorkspaceId
    -> X ()
    removeMatching' MessageConfig
    message WorkspaceId
    t1 WorkspaceId
    t2 Map WorkspaceId WorkspaceId
    matchings else MessageConfig
    -> WorkspaceId
    -> WorkspaceId
    -> Map WorkspaceId WorkspaceId
    -> X ()
    setMatching MessageConfig
    message WorkspaceId
    t1 WorkspaceId
    t2 Map WorkspaceId WorkspaceId
    matchings
        return ()

    -- | Insert a mapping between t1 and t2 and display a message
    setMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X ()
    setMatching :: MessageConfig
    -> WorkspaceId
    -> WorkspaceId
    -> Map WorkspaceId WorkspaceId
    -> X ()
    setMatching MessageConfig
    message WorkspaceId
    t1 WorkspaceId
    t2 Map WorkspaceId WorkspaceId
    matchings = do
       ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
       let now = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId
    forall i l a sid sd. Screen i l a sid sd -> sid
    W.screen (WindowSet
    -> 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 WindowSet
    ws)
       XS.put $ WorkspaceMap $ M.insert t1 t2 matchings
       messageFunction message now (foreground message) (background message) ("Linked: " ++ (t1 ++ " " ++ t2))

    -- currently this function is called manually this means that if workspaces
    -- were deleted, some links stay in the RAM even though they are not used
    -- anymore... because of the small amount of memory used for those there is no
    -- special cleanup so far
    removeMatching' :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X ()
    removeMatching' :: MessageConfig
    -> WorkspaceId
    -> WorkspaceId
    -> Map WorkspaceId WorkspaceId
    -> X ()
    removeMatching' MessageConfig
    message WorkspaceId
    t1 WorkspaceId
    t2 Map WorkspaceId WorkspaceId
    matchings = do
       ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
       let now = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId
    forall i l a sid sd. Screen i l a sid sd -> sid
    W.screen (WindowSet
    -> 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 WindowSet
    ws)
       XS.put $ WorkspaceMap $ M.delete t1 matchings
       messageFunction message now (alertedForeground message) (background message) ("Unlinked: " ++ t1 ++ " " ++ t2)

    -- | Remove all maps between workspaces
    removeAllMatchings :: MessageConfig -> X ()
    removeAllMatchings :: MessageConfig -> X ()
    removeAllMatchings MessageConfig
    message = do
       ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
       let now = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId
    forall i l a sid sd. Screen i l a sid sd -> sid
    W.screen (WindowSet
    -> 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 WindowSet
    ws)
       XS.put $ WorkspaceMap M.empty
       messageFunction message now (alertedForeground message) (background message) "All links removed!"

    -- | remove all matching regarding a given workspace
    unMatch :: WorkspaceId -> X ()
    unMatch :: WorkspaceId -> X ()
    unMatch WorkspaceId
    workspace = do
        WorkspaceMap matchings <- X WorkspaceMap
    forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
    XS.get :: X WorkspaceMap
        XS.put $ WorkspaceMap $ M.delete workspace (M.filter (/= workspace) matchings)

    -- | Toggle the currently displayed workspaces as matching. Starting from the one with focus
    -- | a linked list of workspaces is created that will later be iterated by switchToMatching.
    toggleLinkWorkspaces :: MessageConfig -> X ()
    toggleLinkWorkspaces :: MessageConfig -> X ()
    toggleLinkWorkspaces MessageConfig
    message = (WindowSet -> X ()) -> X ()
    forall a. (WindowSet -> X a) -> X a
    withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \WindowSet
    ws -> ScreenId -> MessageConfig -> X ()
    toggleLinkWorkspaces' (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId
    forall i l a sid sd. Screen i l a sid sd -> sid
    W.screen (WindowSet
    -> 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 WindowSet
    ws)) MessageConfig
    message

    toggleLinkWorkspaces' :: ScreenId -> MessageConfig -> X ()
    toggleLinkWorkspaces' :: ScreenId -> MessageConfig -> X ()
    toggleLinkWorkspaces' ScreenId
    first MessageConfig
    message = do
        ws <- (XState -> WindowSet) -> X WindowSet
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets XState -> WindowSet
    windowset
        nScreens <- countScreens
        let now = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId
    forall i l a sid sd. Screen i l a sid sd -> sid
    W.screen (WindowSet
    -> 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 WindowSet
    ws)
        let next = (ScreenId
    now ScreenId -> ScreenId -> ScreenId
    forall a. Num a => a -> a -> a
    + ScreenId
    1) ScreenId -> ScreenId -> ScreenId
    forall a. Integral a => a -> a -> a
    `mod` ScreenId
    nScreens
        if next == first then return () else do -- this is also the case if there is only one screen
            for_ (W.lookupWorkspace next ws)
                 (toggleMatching message (W.currentTag ws))
            onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next