{-# 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
                                      , nextMatchWithThis
                                      , 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 $ defaultConfig { 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

-- Produces the action to perform depending on whether there's a
-- matching window
focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X ()
focusNextMatchOrDo qry act = findM (runQuery qry)
                             >=> maybe act (windows . SS.focusWindow)

-- 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'