{-# LANGUAGE CPP #-}
module Xmobar.Plugins.Mail(Mail(..),MailX(..)) where
import Xmobar.Run.Exec
#ifdef INOTIFY
import Xmobar.Plugins.Monitors.Common (parseOptsWith)
import Xmobar.System.Utils (expandHome, changeLoop)
import Control.Monad
import Control.Concurrent.STM
import System.Directory
import System.FilePath
import System.INotify
import System.Console.GetOpt
import Data.List (isPrefixOf)
import Data.Set (Set)
import qualified Data.Set as S
#if MIN_VERSION_hinotify(0,3,10)
import qualified Data.ByteString.Char8 as BS (ByteString, pack, unpack)
unpack :: BS.ByteString -> String
unpack = BS.unpack
pack :: String -> BS.ByteString
pack = BS.pack
#else
unpack :: String -> String
unpack = id
pack :: String -> String
pack = id
#endif
#else
import System.IO
#endif
data MOptions = MOptions
{ oDir :: FilePath
, oPrefix :: String
, oSuffix :: String
}
defaults :: MOptions
defaults = MOptions {oDir = "", oPrefix = "", oSuffix = ""}
options :: [OptDescr (MOptions -> MOptions)]
options =
[ Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") ""
, Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") ""
, Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") ""
]
data Mail = Mail [(String, FilePath)] String
deriving (Read, Show)
data MailX = MailX [(String, FilePath, String)] [String] String
deriving (Read, Show)
instance Exec Mail where
alias (Mail _ a) = a
start (Mail ms a) = start (MailX (map (\(n,p) -> (n,p,"")) ms) [] a)
instance Exec MailX where
alias (MailX _ _ a) = a
#ifndef INOTIFY
start _ _ =
hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify,"
++ " but the Mail plugin requires it."
#else
start (MailX ms args _) cb = do
vs <- mapM (const $ newTVarIO S.empty) ms
opts <- parseOptsWith options defaults args
let prefix = oPrefix opts
suffix = oSuffix opts
dir = oDir opts
ps = map (\(_,p,_) -> if null dir then p else dir </> p) ms
rs = map (</> "new") ps
ev = [Move, MoveIn, MoveOut, Create, Delete]
ds <- mapM expandHome rs
i <- initINotify
zipWithM_ (\d v -> addWatch i ev d (handle v)) (map pack ds) vs
forM_ (zip ds vs) $ \(d, v) -> do
s <- fmap (S.fromList . filter (not . isPrefixOf "."))
$ getDirectoryContents d
atomically $ modifyTVar v (S.union s)
changeLoop (mapM (fmap S.size . readTVar) vs) $ \ns ->
let showmbx m n c = if c == ""
then m ++ show n
else "<fc=" ++ c ++ ">" ++ m ++ show n ++ "</fc>"
cnts = [showmbx m n c | ((m,_,c), n) <- zip ms ns , n /= 0 ]
in cb $ if null cnts then "" else prefix ++ unwords cnts ++ suffix
handle :: TVar (Set String) -> Event -> IO ()
handle v e = atomically $ modifyTVar v $ case e of
Created {} -> create
MovedIn {} -> create
Deleted {} -> delete
MovedOut {} -> delete
_ -> id
where
delete = S.delete ((unpack . filePath) e)
create = S.insert ((unpack . filePath) e)
#endif