content: {-# LANGUAGE DeriveDataTypeable #-}
  
  ----------------------------------------------------------------------
  -- |
  -- Module      : XMonad.Actions.GroupNavigation
  -- Copyright   : (c) nzeh@cs.dal.ca
  -- License     : BSD3-style (see LICENSE)
  --
  -- Maintainer  : nzeh@cs.dal.ca
  -- Stability   : unstable
  -- Portability : unportable
  --
  -- Provides methods for cycling through groups of windows across
  -- workspaces, ignoring windows that do not belong to this group.  A
  -- group consists of all windows matching a user-provided boolean
  -- query.
  --
  -- Also provides a method for jumping back to the most recently used
  -- window in any given group.
  --
  ----------------------------------------------------------------------
  
  module XMonad.Actions.GroupNavigation ( -- * Usage
                                          -- $usage
                                          Direction (..)
                                        , nextMatch
                                        , nextMatchOrDo
                                        , withNextMatchOrDo
                                        , nextMatchWithThis
                                        , nextMatched
                                        , historyHook
                                        ) where
  
  import Control.Monad.Reader
  import Data.Foldable as Fold
  import Data.Map as Map
  import Data.Sequence as Seq
  import Data.Set as Set
  import Graphics.X11.Types
  import Prelude hiding (concatMap, drop, elem, filter, null, reverse)
  import XMonad.Core
  import XMonad.ManageHook
  import XMonad.Operations (windows, withFocused)
  import qualified XMonad.StackSet as SS
  import qualified XMonad.Util.ExtensibleState as XS
  
  {- $usage
  
  Import the module into your @~\/.xmonad\/xmonad.hs@:
  
  > import XMonad.Actions.GroupNavigation
  
  To support cycling forward and backward through all xterm windows, add
  something like this to your keybindings:
  
  > , ((modm              , xK_t), nextMatch Forward  (className =? "XTerm"))
  > , ((modm .|. shiftMask, xK_t), nextMatch Backward (className =? "XTerm"))
  
  These key combinations do nothing if there is no xterm window open.
  If you rather want to open a new xterm window if there is no open
  xterm window, use 'nextMatchOrDo' instead:
  
  > , ((modm              , xK_t), nextMatchOrDo Forward  (className =? "XTerm") (spawn "xterm"))
  > , ((modm .|. shiftMask, xK_t), nextMatchOrDo Backward (className =? "XTerm") (spawn "xterm"))
  
  You can use 'nextMatchWithThis' with an arbitrary query to cycle
  through all windows for which this query returns the same value as the
  current window.  For example, to cycle through all windows in the same
  window class as the current window use:
  
  > , ((modm , xK_f), nextMatchWithThis Forward  className)
  > , ((modm , xK_b), nextMatchWithThis Backward className)
  
  Finally, you can define keybindings to jump to the most recent window
  matching a certain Boolean query.  To do this, you need to add
  'historyHook' to your logHook:
  
  > main = xmonad $ def { logHook = historyHook }
  
  Then the following keybindings, for example, allow you to return to
  the most recent xterm or emacs window or to simply to the most recent
  window:
  
  > , ((modm .|. controlMask, xK_e),         nextMatch History (className =? "Emacs"))
  > , ((modm .|. controlMask, xK_t),         nextMatch History (className =? "XTerm"))
  > , ((modm                , xK_BackSpace), nextMatch History (return True))
  
  Again, you can use 'nextMatchOrDo' instead of 'nextMatch' if you want
  to execute an action if no window matching the query exists. -}
  
  --- Basic cyclic navigation based on queries -------------------------
  
  -- | The direction in which to look for the next match
  data Direction = Forward  -- ^ Forward from current window or workspace
                 | Backward -- ^ Backward from current window or workspace
                 | History  -- ^ Backward in history
  
  -- | Focuses the next window for which the given query produces the
  -- same result as the currently focused window.  Does nothing if there
  -- is no focused window (i.e., the current workspace is empty).
  nextMatchWithThis :: Eq a => Direction -> Query a -> X ()
  nextMatchWithThis dir qry = withFocused $ \win -> do
    prop <- runQuery qry win
    nextMatch dir (qry =? prop)
  
  -- | Focuses the next window that matches the given boolean query.
  -- Does nothing if there is no such window.  This is the same as
  -- 'nextMatchOrDo' with alternate action @return ()@.
  nextMatch :: Direction -> Query Bool -> X ()
  nextMatch dir qry = nextMatchOrDo dir qry (return ())
  
  -- | Focuses the next window that matches the given boolean query.  If
  -- there is no such window, perform the given action instead.
  nextMatchOrDo :: Direction -> Query Bool -> X () -> X ()
  nextMatchOrDo dir qry act = orderedWindowList dir
                              >>= focusNextMatchOrDo qry act
  
  withNextMatchOrDo :: Direction -> Query Bool -> (Window -> X()) -> X () -> X ()
  withNextMatchOrDo dir qry mf f = orderedWindowList dir
                              >>= onNextMatchOrDo qry mf f
  nextMatched :: Direction -> Query Bool -> X (Maybe Window)
  nextMatched dir qry = orderedWindowList dir >>= findM (runQuery qry)
  
  -- Produces the action to perform depending on whether there's a
  -- matching window
  focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X ()
  focusNextMatchOrDo qry act = onNextMatchOrDo qry (windows . SS.focusWindow) act
  
  onNextMatchOrDo qry mf f = findM (runQuery qry)
                               >=> maybe f mf
  
  -- Returns the list of windows ordered by workspace as specified in
  -- ~/.xmonad/xmonad.hs
  orderedWindowList :: Direction -> X (Seq Window)
  orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get
  orderedWindowList dir     = withWindowSet $ \ss -> do
    wsids <- asks (Seq.fromList . workspaces . config)
    let wspcs = orderedWorkspaceList ss wsids
        wins  = dirfun dir
                $ Fold.foldl' (><) Seq.empty
                $ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs
        cur   = SS.peek ss
    return $ maybe wins (rotfun wins) cur
    where
      dirfun Backward = Seq.reverse
      dirfun _        = id
      rotfun wins x   = rotate $ rotateTo (== x) wins
  
  -- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs
  orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace
  orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
      where
        wspcs      = SS.workspaces ss
        wspcsMap   = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs
        wspcs'     = fmap (\wsid -> wspcsMap ! wsid) wsids
        isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)
  
  --- History navigation, requires a layout modifier -------------------
  
  -- The state extension that holds the history information
  data HistoryDB = HistoryDB (Maybe Window) -- currently focused window
                             (Seq Window)   -- previously focused windows
                 deriving (Read, Show, Typeable)
  
  instance ExtensionClass HistoryDB where
  
      initialValue  = HistoryDB Nothing Seq.empty
      extensionType = PersistentExtension
  
  -- | Action that needs to be executed as a logHook to maintain the
  -- focus history of all windows as the WindowSet changes.
  historyHook :: X ()
  historyHook = XS.get >>= updateHistory >>= XS.put
  
  -- Updates the history in response to a WindowSet change
  updateHistory :: HistoryDB -> X HistoryDB
  updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do
    let newcur   = SS.peek ss
        wins     = Set.fromList $ SS.allWindows ss
        newhist  = flt (flip Set.member wins) (ins oldcur oldhist)
    return $ HistoryDB newcur (del newcur newhist)
    where
      ins x xs = maybe xs (<| xs) x
      del x xs = maybe xs (\x' -> flt (/= x') xs) x
  
  --- Two replacements for Seq.filter and Seq.breakl available only in
  --- containers-0.3.0.0, which only ships with ghc 6.12.  Once we
  --- decide to no longer support ghc < 6.12, these should be replaced
  --- with Seq.filter and Seq.breakl.
  
  flt :: (a -> Bool) -> Seq a -> Seq a
  flt p = Fold.foldl (\xs x -> if p x then xs |> x else xs) Seq.empty
  
  brkl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
  brkl p xs = flip Seq.splitAt xs
              $ snd
              $ Fold.foldr (\x (i, j) -> if p x then (i-1, i-1) else (i-1, j)) (l, l) xs
    where
      l = Seq.length xs
  
  --- Some sequence helpers --------------------------------------------
  
  -- Rotates the sequence by one position
  rotate :: Seq a -> Seq a
  rotate xs = rotate' (viewl xs)
    where
      rotate' EmptyL      = Seq.empty
      rotate' (x' :< xs') = xs' |> x'
  
  -- Rotates the sequence until an element matching the given condition
  -- is at the beginning of the sequence.
  rotateTo :: (a -> Bool) -> Seq a -> Seq a
  rotateTo cond xs = let (lxs, rxs) = brkl cond xs in rxs >< lxs
  
  --- A monadic find ---------------------------------------------------
  
  -- Applies the given action to every sequence element in turn until
  -- the first element is found for which the action returns true.  The
  -- remaining elements in the sequence are ignored.
  findM :: Monad m => (a -> m Bool) -> Seq a -> m (Maybe a)
  findM cond xs = findM' cond (viewl xs)
    where
      findM' _   EmptyL      = return Nothing
      findM' qry (x' :< xs') = do
        isMatch <- qry x'
        if isMatch
          then return (Just x')
          else findM qry xs'
  