------------------------------------------------------------------------------
-- |
-- Module      :  Pager
-- Copyright   :  (c) Mads N Noe 2009
-- Maintainer  :  mntnoe (@) gmail.com
-- License     :  as-is
--
-- A pager for DynamicLog showing a symbol for each window on each workspace.
--
------------------------------------------------------------------------------

module Pager (
    -- * Usage
    -- $usage

    labeledPager
  ) where

-- XMonad modules
import XMonad
import Data.Maybe ( isJust, fromMaybe )
import qualified Data.Map as M
import Data.Map ( (!) )
import Data.List
import qualified XMonad.StackSet as W
import XMonad.Hooks.DynamicLog
import XMonad.Hooks.UrgencyHook

-- My modules
import Util

-- $usage
--
-- The simplest way to use this module is to add something like this in your
-- @~\/.xmonad\/xmonad.hs@.  Note that you need to patch your xmonad source to
-- allow support for user modules (see my @xmonad.hs@).
--
-- > import XMonad.Hooks.DynamicLog
-- > import Pager
-- >
-- > main = xmonad $ defaultConfig {
-- >    ...
-- >    logHook = myDynamicLog
-- >    ...
-- >  }
-- >
-- > myDynamicLog :: PP
-- > myDynamicLog = defaultPP
-- >     { ppOrder           = order
-- >     , ppExtras          = [ labeledPager myDynamicLog windowLabelMap ]
-- >     }
-- >   where
-- >     order (_:l:t:ws:_) = ws:l:t:[]
-- >     order xs           = ["Error in order list: " ++ show xs]
--
-- You also need a way to assign symbols to your windows. Here is a simple
-- example using single letter symbols, but you also use dzen icons.
--
-- > -- | Map windows to symbols for the pager.  Symbols for floating windows are in
-- > --   lower case.
-- > windowLabelMap :: [(String, Query Bool)]
-- > windowLabelMap =
-- >     map whenFloat tiledWindows ++ tiledWindows
-- >     ++
-- >     map whenFloat generalQueries ++ generalQueries
-- >   where
-- >
-- >     whenFloat (l, q) = (map toLower l, isFloat <&&> q)
-- >
-- >     tiledWindows =
-- >         [ ("V", className =? "Gvim")
-- >         , ("E", className =? "Emacs")
-- >         , ("W", className =? "Firefox")
-- >         ]
-- >
-- >     generalQueries =
-- >         [ ("T", appName =? "xterm")
-- >         , ("X", return True) -- catchall
-- >         ]

-- | The 'DynamicLog' logger to add to 'ppExtras' using the given pretty
--   printer and window label map.
labeledPager :: PP -> [(String, Query Bool)] -> X (Maybe String)
labeledPager pp lm = do
    s       <- gets windowset
    urgents <- readUrgents
    sort'   <- ppSort pp
    wl      <- queryWindows s lm
    return $ Just $ pprWindowSet' sort' urgents wl pp s

-- | like 'pprWindowSet', but append to each workspace the outcome of
--   'printWindows'.
pprWindowSet' :: ([W.Workspace String l Window] -> [W.Workspace String l Window])
                                                   -- ^ sorting function
              -> [Window]                          -- ^ urgent windows
              -> M.Map Window String               -- ^ window to symbol map
              -> PP                                -- ^ pretty-Printer
              -> W.StackSet String l Window sid sd -- ^ stack set
              -> String
pprWindowSet' sort' urgents wl pp s 
    = sepBy (ppWsSep pp) . map fmt . sort' $
            map W.workspace (W.current s : W.visible s) ++ W.hidden s
   where this     = W.tag (W.workspace (W.current s))
         visibles = map (W.tag . W.workspace) (W.visible s)

         fmt ws = printer pp (W.tag ws ++ printWindows wl (W.integrate' $ W.stack ws))
          where printer | W.tag ws == this         = ppCurrent
                        | W.tag ws `elem` visibles = ppVisible
                        | any (\x -> maybe False (== W.tag ws) (W.findTag x s)) urgents  
                                                   = \ppC -> ppUrgent ppC . ppHidden ppC
                        | isJust (W.stack ws)      = ppHidden
                        | otherwise                = ppHiddenNoWindows

-- | Output a list of strings, ignoring empty ones and separating the
--   rest with the given separator.
sepBy :: String   -- ^ separator
      -> [String] -- ^ fields to output
      -> String
sepBy sep = concat . intersperse sep . filter (not . null)

-- | Print a concatenated string of symbols for a list of windows.
printWindows :: M.Map Window String -- ^ window to symbol map
             -> [Window]            -- ^ windows on the workspace
             -> String
printWindows wl ws = pad $ concat $ map (\w -> fromMaybe "" $ M.lookup w wl) ws
  where
    pad "" = ""
    pad xs = ":"++xs

-- | Query each window in the 'WindowSet' and assign a symbol to it in a map.
queryWindows :: WindowSet -> [(String, Query Bool)] -> X (M.Map Window String)
queryWindows ws lm = do
    mapM (qw lm) (W.allWindows ws) >>= return . M.fromList
  where
    qw :: [(String, Query Bool)] -> Window -> X (Window, String)
    qw [] w           = return (w, "?")
    qw ((l, q):lqs) w = runQuery q w >>= if_ (return (w, l)) (qw lqs w)