-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.WindowNames
-- Copyright   :  (c) 2015 Phil Lindberg <plindbe2@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Phil Lindberg <plindbe2@gmail.com>
-- Stability   :  experimental
-- Portability :  unportable
--
-- A library to automatically put named windows into the DynamicLog.  It
-- provides a modification of 'XMonad.Hooks.DynamicLog.dynamicLogWithPP' and
-- some helper functions.
--
-----------------------------------------------------------------------------

module XMonad.Actions.WindowNames (
        -- * Usage
        -- $usage

        -- * Modified dynamic log functions
          dynamicLogStringMap
        , dynamicLogWithPPMap
        -- * Helper functions
        , evalLookup
        , filterShortNames
        -- * Stack and StackSet functions
        , getTagStack
        , getWindowNames
        , integrateM
        -- * Pretty-printer functions
        , pprWindowSetMap
        -- * To Do
        -- $todo
    ) where

import Codec.Binary.UTF8.String (encodeString)
import Control.Monad (mapM, MonadPlus(mplus))
import Data.List (intercalate)
import Data.Maybe (listToMaybe, catMaybes, fromMaybe, isJust)
import XMonad
import XMonad.Hooks.DynamicLog (PP(..))
import XMonad.Hooks.UrgencyHook (readUrgents)
import XMonad.Util.NamedWindows (getName)
import XMonad.Util.WorkspaceCompare (WorkspaceSort)

import qualified Data.Map as M
import qualified XMonad.StackSet as W


-- $usage
-- You can add this to your @~\/.xmonad\/xmonad.hs@:
--
-- >    import Data.List (isSuffixOf)
-- >    import System.IO
-- >    import WindowNames
-- >    import XMonad
-- >    import XMonad.Hooks.DynamicLog
-- >    import XMonad.Util.Run(spawnPipe)
--
-- A simple example is a follows (the example uses xmobar but feel free to
-- substitute dzen or anything else):
--
-- > myShortNames :: [(String -> Bool, String -> String)]
-- > myShortNames = [ (("Pentadactyl" `isSuffixOf`), const "ff"  )
-- >                , ((=="Library"),                const "ffdl")
-- >                , (const True,                   take 4      ) -- catch all
-- >                ]
-- >
-- > main = do
-- >     h <- spawnPipe "xmobar -options -foo -bar"
-- >     xmonad $ myXmonadConfig h
-- >
-- > myXmonadConfig h = defaultConfig {
-- >   ...
-- >   logHook = dynamicLogWithPPMap (getWindowNames (foc . filt) filt filt) xmobarPP { ppOutput = hPutStrLn h }
-- >   ...
-- > }
-- >  where foc  = wrap "<fn=1>" "</fn>" -- xmobar font 1 (additionalFonts!!0)
-- >        filt = filterShortNames myShortNames
--
-- This works nicely with named tmux sessions or screens.  You can use it in
-- conjunction with other dynamicLog string modifiers.

-- $todo
-- * Incorporate with 'XMonad.Actions.TagWindows'
-- * Efficiency (ExtensionClass?)
-- * Make sure it works with the newest XMonad

-- | Helper function used by 'filterShortNames' which run the first function in
--   the tuple on the value.  If it evalutes to true, the output of the second
--   function if returned.
evalLookup :: MonadPlus m => a -> [(a -> Bool, a -> b)] -> m b
evalLookup n ((f,g):xs) | f n       = return (g n) `mplus` evalLookup n xs
                        | otherwise = evalLookup n xs

-- | Example filter short name function.
filterShortNames :: [(String -> Bool, String -> String)] -> String -> String
filterShortNames filterList s = fromMaybe "" $ evalLookup s filterList

-- | Get a Map of window tag to strings in the format "wsId:w1,w2,...,wN" where
--   w1,...,wn represent the names of windows according to
--   'XMonad.Util.NamedWindows.getName' after being run through the respective
--   focus, up, and down functions
getWindowNames :: (String -> String)                     -- ^ Function to apply to the focused window's name.
               -> (String -> String)                     -- ^ Function to apply to the up windows' names.
               -> (String -> String)                     -- ^ Function to apply to the down windows' names.
               -> W.StackSet WorkspaceId l Window sid sd -- ^ Stack set
               -> X (M.Map WorkspaceId String)
getWindowNames f u d w = fmap M.fromList $ mapM returnNameStr $ getTagStack w
  where joinWinNames x _ = fmap (((x ++ ":") ++) . intercalate "," . filter (not . null)) .
                           integrateM (nameFunc f) (nameFunc u) (nameFunc d)

        returnNameStr (x, y) = maybe (return x) (joinWinNames x y) y >>= \z -> return (x, z)
        nameFunc f = fmap (f . show) . getName

-- | Run a monadic function on 'XMonad.StackSet.Stack' components.
integrateM :: Monad m =>
              (a -> m b) -- ^ Monadic function to run on focused components.
           -> (a -> m b) -- ^ Monadic function to run on up components.
           -> (a -> m b) -- ^ Monadic function to run on down components.
           -> W.Stack a  -- ^ Current StackSet
           -> m [b]
integrateM f u d (W.Stack x l r) = do
    r2 <- mapM u r
    x2 <- f x
    l2 <- mapM d l
    return $ reverse l2 ++ x2 : r2

-- | Get a list of tag and maybe Stack.
getTagStack :: W.StackSet t l a sid sd -> [(t, Maybe (W.Stack a))]
getTagStack w = [ (i, a) | W.Workspace i _ a <- (W.workspace . W.current) w : map W.workspace (W.visible w) ++ W.hidden w ]

-- | Modified 'XMonad.Hooks.DynamicLog.dynamicLogWithPP' which takes an
--   additional WindowSet to Map of WorkspaceId to String.
dynamicLogWithPPMap :: (WindowSet -> X (M.Map WorkspaceId String)) -> PP -> X ()
dynamicLogWithPPMap wsIdMap pp = dynamicLogStringMap wsIdMap pp >>= io . ppOutput pp

-- | Modifed 'XMonad.Hooks.DynamicLog.dynamicLogString' which takes an
--   additional WindowSet to Map of WorkspaceId to String.
dynamicLogStringMap :: (WindowSet -> X (M.Map WorkspaceId String)) -> PP -> X String
dynamicLogStringMap wsIdMap pp = do
    winset <- gets windowset
    urgents <- readUrgents
    sort' <- ppSort pp

    -- layout description
    let ld = description . W.layout . W.workspace . W.current $ winset

    -- workspace list
    ws <- pprWindowSetMap wsIdMap sort' urgents pp winset

    -- window title
    wt <- maybe (return "") (fmap show . getName) . W.peek $ winset

    -- run extra loggers, ignoring any that generate errors.
    extras <- mapM (`catchX` return Nothing) $ ppExtras pp

    return $ encodeString . sepBy (ppSep pp) . ppOrder pp $
                        [ ws
                        , ppLayout pp ld
                        , ppTitle  pp $ ppTitleSanitize pp wt
                        ]
                        ++ catMaybes extras

-- | Format the workspace information
pprWindowSetMap :: (WindowSet -> X (M.Map WorkspaceId String)) -- ^ Map of WorkspaceId to a string to be displayed.
                -> WorkspaceSort                               -- ^ A workspace sorting function
                -> [Window]                                    -- ^ A list of urgent windows
                -> PP                                          -- ^ pretty-printer format
                -> WindowSet                                   -- ^ current WindowSet
                -> X String
pprWindowSetMap wsIdFunc sort' urgents pp s = do
            wsIdMap <- wsIdFunc s
            return $ sepBy (ppWsSep pp) . map (fmt wsIdMap) . sort' $ map W.workspace (W.current s : W.visible s) ++ W.hidden s
   where this     = W.currentTag s
         visibles = map (W.tag . W.workspace) (W.visible s)

         fmt wsIdMap w = printer pp (fromMaybe "" $ M.lookup (W.tag w) wsIdMap)
          where printer | any (\x -> maybe False (== W.tag w) (W.findTag x s)) urgents  = ppUrgent
                        | W.tag w == this                                               = ppCurrent
                        | W.tag w `elem` visibles                                       = ppVisible
                        | isJust (W.stack w)                                            = 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 = intercalate sep . filter (not . null)