    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.LinkWorkspaces
    -- 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.
    --
    -----------------------------------------------------------------------------

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

    import XMonad
    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\/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
    -- "XMonad.Doc.Extending#Editing_key_bindings".

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

    defaultMessageConf :: MessageConfig
    defaultMessageConf = MessageConfig { messageFunction = noMessageFn
                         , background = "#000000"
                         , alertedForeground = "#ff7701"
                         , foreground = "#00ff00" }

    noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
    noMessageFn _ _ _ _ = return () :: X ()

    -- | Stuff for linking workspaces
    data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)
    instance ExtensionClass WorkspaceMap
        where initialValue = WorkspaceMap M.empty
              extensionType = PersistentExtension

    switchWS :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> X ()
    switchWS f m ws = switchWS' f m ws 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' switchFn message workspace stopAtScreen = do
      ws <- gets windowset
      nScreens <- countScreens
      let now = W.screen (W.current ws)
      let next = ((now + 1) `mod` nScreens)
      switchFn workspace
      case stopAtScreen of
        Nothing -> sTM now next (Just now)
        Just sId -> if sId == next then return () else sTM now next (Just sId)
      where sTM = switchToMatching (switchWS' switchFn message) message 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 f message t now next stopAtScreen = do
        WorkspaceMap matchings <- XS.get :: X WorkspaceMap
        case (M.lookup t matchings) of
            Nothing -> return () :: X()
            Just newWorkspace -> do
                onScreen' (f newWorkspace stopAtScreen) FocusCurrent next
                messageFunction message now (foreground message) (background message) ("Switching to: " ++ (t ++ " and " ++ newWorkspace))

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

    -- | Insert a mapping between t1 and t2 and display a message
    setMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X ()
    setMatching message t1 t2 matchings = do
       ws <- gets windowset
       let now = W.screen (W.current 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' message t1 t2 matchings = do
       ws <- gets windowset
       let now = W.screen (W.current 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 message = do
       ws <- gets windowset
       let now = W.screen (W.current 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 workspace = do
        WorkspaceMap matchings <- 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 message = withWindowSet $ \ws -> toggleLinkWorkspaces' (W.screen (W.current ws)) message

    toggleLinkWorkspaces' :: ScreenId -> MessageConfig -> X ()
    toggleLinkWorkspaces' first message = do
        ws <- gets windowset
        nScreens <- countScreens
        let now = W.screen (W.current ws)
        let next = (now + 1) `mod` nScreens
        if next == first then return () else do -- this is also the case if there is only one screen
            case (W.lookupWorkspace next ws) of
                Nothing -> return ()
                Just name -> toggleMatching message (W.currentTag ws) (name)
            onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next