{-# LANGUAGE CPP #-}
module Xmobar.Plugins.MBox (MBox(..)) where
import Prelude
import Xmobar.Run.Exec
#ifdef INOTIFY
import Xmobar.System.Utils (changeLoop, expandHome)
import Control.Monad (when)
import Control.Concurrent.STM
import Control.Exception (SomeException (..), handle, evaluate)
import System.Console.GetOpt
import System.Directory (doesFileExist)
import System.FilePath ((</>))
import System.INotify (Event(..), EventVariety(..), initINotify, addWatch)
import qualified Data.ByteString.Lazy.Char8 as B
#if MIN_VERSION_hinotify(0,3,10)
import qualified Data.ByteString.Char8 as BS (ByteString, pack)
pack :: String -> BS.ByteString
pack = BS.pack
#else
pack :: String -> String
pack = id
#endif
data Options = Options
{ oAll :: Bool
, oUniq :: Bool
, oDir :: FilePath
, oPrefix :: String
, oSuffix :: String
}
defaults :: Options
defaults = Options {
oAll = False, oUniq = False, oDir = "", oPrefix = "", oSuffix = ""
}
options :: [OptDescr (Options -> Options)]
options =
[ Option "a" ["all"] (NoArg (\o -> o { oAll = True })) ""
, Option "u" [] (NoArg (\o -> o { oUniq = True })) ""
, 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 }) "") ""
]
parseOptions :: [String] -> IO Options
parseOptions args =
case getOpt Permute options args of
(o, _, []) -> return $ foldr id defaults o
(_, _, errs) -> ioError . userError $ concat errs
#else
import System.IO
#endif
data MBox = MBox [(String, FilePath, String)] [String] String
deriving (Read, Show)
instance Exec MBox where
alias (MBox _ _ a) = a
#ifndef INOTIFY
start _ _ =
hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify" ++
" but the MBox plugin requires it"
#else
start (MBox boxes args _) cb = do
opts <- parseOptions args
let showAll = oAll opts
prefix = oPrefix opts
suffix = oSuffix opts
uniq = oUniq opts
names = map (\(t, _, _) -> t) boxes
colors = map (\(_, _, c) -> c) boxes
extractPath (_, f, _) = expandHome $ oDir opts </> f
events = [CloseWrite]
i <- initINotify
vs <- mapM (\b -> do
f <- extractPath b
exists <- doesFileExist f
n <- if exists then countMails f else return (-1)
v <- newTVarIO (f, n)
when exists $
addWatch i events (pack f) (handleNotification v) >> return ()
return v)
boxes
changeLoop (mapM (fmap snd . readTVar) vs) $ \ns ->
let s = unwords [ showC uniq m n c | (m, n, c) <- zip3 names ns colors
, showAll || n > 0 ]
in cb (if null s then "" else prefix ++ s ++ suffix)
showC :: Bool -> String -> Int -> String -> String
showC u m n c =
if c == "" then msg else "<fc=" ++ c ++ ">" ++ msg ++ "</fc>"
where msg = m ++ if not u || n > 1 then show n else ""
countMails :: FilePath -> IO Int
countMails f =
handle (\(SomeException _) -> evaluate 0)
(do txt <- B.readFile f
evaluate $! length . filter (B.isPrefixOf from) . B.lines $ txt)
where from = B.pack "From "
handleNotification :: TVar (FilePath, Int) -> Event -> IO ()
handleNotification v _ = do
(p, _) <- atomically $ readTVar v
n <- countMails p
atomically $ writeTVar v (p, n)
#endif