content: {-# LANGUAGE DeriveDataTypeable #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Actions.DynamicWorkspaceOrder
  -- Copyright   :  (c) Brent Yorgey 2009
  -- License     :  BSD-style (see LICENSE)
  --
  -- Maintainer  :  <byorgey@gmail.com>
  -- Stability   :  experimental
  -- Portability :  unportable
  --
  -- Remember a dynamically updateable ordering on workspaces, together
  -- with tools for using this ordering with "XMonad.Actions.CycleWS"
  -- and "XMonad.Hooks.DynamicLog".
  --
  -----------------------------------------------------------------------------
  
  module XMonad.Actions.DynamicWorkspaceOrder
      ( -- * Usage
        -- $usage
  
        getWsCompareByOrder
      , getSortByOrder
      , swapWith
  
      , moveTo
      , moveToGreedy
      , shiftTo
  
      , withNthWorkspace
  
      ) where
  
  import XMonad
  import qualified XMonad.StackSet as W
  import qualified XMonad.Util.ExtensibleState as XS
  
  import XMonad.Util.WorkspaceCompare (WorkspaceCompare, WorkspaceSort, mkWsSort)
  import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo)
  
  import qualified Data.Map as M
  import qualified Data.Set as S
  import Data.Maybe (fromJust, fromMaybe)
  import Data.Ord (comparing)
  
  -- $usage
  -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
  --
  -- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO
  --
  -- Then add keybindings to swap the order of workspaces (these
  -- examples use "XMonad.Util.EZConfig" emacs-style keybindings):
  --
  -- >        , ("M-C-<R>",   DO.swapWith Next NonEmptyWS)
  -- >        , ("M-C-<L>",   DO.swapWith Prev NonEmptyWS)
  --
  -- See "XMonad.Actions.CycleWS" for information on the possible
  -- arguments to 'swapWith'.
  --
  -- However, by itself this will do nothing; 'swapWith' does not change
  -- the actual workspaces in any way.  It simply keeps track of an
  -- auxiliary ordering on workspaces.  Anything which cares about the
  -- order of workspaces must be updated to use the auxiliary ordering.
  --
  -- To change the order in which workspaces are displayed by
  -- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your
  -- 'XMonad.Hooks.DynamicLog.ppSort' field, for example:
  --
  -- >   ... dynamicLogWithPP $ byorgeyPP {
  -- >     ...
  -- >     , ppSort = DO.getSortByOrder
  -- >     ...
  -- >   }
  --
  -- To use workspace cycling commands like those from
  -- "XMonad.Actions.CycleWS", use the versions of 'moveTo',
  -- 'moveToGreedy', and 'shiftTo' exported by this module.  For example:
  --
  -- >     , ("M-S-<R>",   DO.shiftTo Next HiddenNonEmptyWS)
  -- >     , ("M-S-<L>",   DO.shiftTo Prev HiddenNonEmptyWS)
  -- >     , ("M-<R>",     DO.moveTo Next HiddenNonEmptyWS)
  -- >     , ("M-<L>",     DO.moveTo Prev HiddenNonEmptyWS)
  --
  -- For slight variations on these, use the source for examples and
  -- tweak as desired.
  
  -- | Extensible state storage for the workspace order.
  data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
    deriving (Typeable, Read, Show)
  
  instance ExtensionClass WSOrderStorage where
    initialValue = WSO Nothing
    extensionType = PersistentExtension
  
  -- | Lift a Map function to a function on WSOrderStorage.
  withWSO :: (M.Map WorkspaceId Int -> M.Map WorkspaceId Int)
             -> (WSOrderStorage -> WSOrderStorage)
  withWSO f = WSO . fmap f . unWSO
  
  -- | Update the ordering storage: initialize if it doesn't yet exist;
  -- add newly created workspaces at the end as necessary.
  updateOrder :: X ()
  updateOrder = do
    WSO mm <- XS.get
    case mm of
      Nothing -> do
        -- initialize using ordering of workspaces from the user's config
        ws <- asks (workspaces . config)
        XS.put . WSO . Just . M.fromList $ zip ws [0..]
      Just m -> do
        -- check for new workspaces and add them at the end
        curWs <- gets (S.fromList . map W.tag . W.workspaces . windowset)
        let mappedWs  = M.keysSet m
            newWs     = curWs `S.difference` mappedWs
            nextIndex = 1 + maximum (-1 : M.elems m)
            newWsIxs  = zip (S.toAscList newWs) [nextIndex..]
        XS.modify . withWSO . M.union . M.fromList $ newWsIxs
  
  -- | A comparison function which orders workspaces according to the
  -- stored dynamic ordering.
  getWsCompareByOrder :: X WorkspaceCompare
  getWsCompareByOrder = do
    updateOrder
    -- after the call to updateOrder we are guaranteed that the dynamic
    -- workspace order is initialized and contains all existing
    -- workspaces.
    WSO (Just m) <- XS.get
    return $ comparing (fromMaybe 1000 . flip M.lookup m)
  
  -- | Sort workspaces according to the stored dynamic ordering.
  getSortByOrder :: X WorkspaceSort
  getSortByOrder = mkWsSort getWsCompareByOrder
  
  -- | Swap the current workspace with another workspace in the stored
  -- dynamic order.
  swapWith :: Direction1D -> WSType -> X ()
  swapWith dir which = findWorkspace getSortByOrder dir which 1 >>= swapWithCurrent
  
  -- | Swap the given workspace with the current one.
  swapWithCurrent :: WorkspaceId -> X ()
  swapWithCurrent w = do
    cur <- gets (W.currentTag . windowset)
    swapOrder w cur
  
  -- | Swap the two given workspaces in the dynamic order.
  swapOrder :: WorkspaceId -> WorkspaceId -> X ()
  swapOrder w1 w2 = do
    io $ print (w1,w2)
    WSO (Just m) <- XS.get
    let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2]
    XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
    windows id  -- force a status bar update
  
  -- | View the next workspace of the given type in the given direction,
  -- where \"next\" is determined using the dynamic workspace order.
  moveTo :: Direction1D -> WSType -> X ()
  moveTo dir t = doTo dir t getSortByOrder (windows . W.view)
  
  -- | Same as 'moveTo', but using 'greedyView' instead of 'view'.
  moveToGreedy :: Direction1D -> WSType -> X ()
  moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)
  
  -- | Shift the currently focused window to the next workspace of the
  -- given type in the given direction, using the dynamic workspace order.
  shiftTo :: Direction1D -> WSType -> X ()
  shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
  
  -- | Do something with the nth workspace in the dynamic order.  The
  --   callback is given the workspace's tag as well as the 'WindowSet'
  --   of the workspace itself.
  withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
  withNthWorkspace job wnum = do
    sort <- getSortByOrder
    ws <- gets (map W.tag . sort . W.workspaces . windowset)
    case drop wnum ws of
      (w:_) -> windows $ job w
      []    -> return ()