diff options
| -rw-r--r-- | Config.hs | 12 | ||||
| -rw-r--r-- | Plugins/Mail.hs | 78 | ||||
| -rw-r--r-- | xmobar.cabal | 7 |
3 files changed, 96 insertions, 1 deletions
@@ -28,6 +28,10 @@ import Plugins.Date import Plugins.PipeReader import Plugins.StdinReader +#ifdef INOTIFY +import Plugins.Mail +#endif + -- $config -- Configuration data type and default configuration @@ -74,5 +78,11 @@ defaultConfig = -- the 'Runnable.Runnable' Read instance. To install a plugin just add -- the plugin's type to the list of types appearing in this function's type -- signature. -runnableTypes :: (Command,(Monitors,(Date,(PipeReader,(StdinReader,()))))) +runnableTypes :: (Command,(Monitors,(Date,(PipeReader,(StdinReader, +#ifdef INOTIFY + (Mail,()) +#else + () +#endif + ))))) runnableTypes = undefined diff --git a/Plugins/Mail.hs b/Plugins/Mail.hs new file mode 100644 index 0000000..0a8507a --- /dev/null +++ b/Plugins/Mail.hs @@ -0,0 +1,78 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Mail +-- Copyright : (c) Spencer Janssen +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Spencer Janssen <sjanssen@cse.unl.edu> +-- Stability : unstable +-- Portability : unportable +-- +-- A plugin for checking mail. +-- +----------------------------------------------------------------------------- + +module Plugins.Mail where + +import Prelude hiding (catch) +import System.IO +import Plugins + +import Control.Monad +import Control.Concurrent.STM + +import System.Directory +import System.FilePath +import System.INotify + +import Data.List (isPrefixOf) +import Data.Set (Set) +import qualified Data.Set as S + +data Mail = Mail [(String, FilePath)] + deriving (Read, Show) + +instance Exec Mail where + start (Mail ms) cb = do + vs <- mapM (const $ newTVarIO S.empty) ms + + let ts = map fst ms + ds = map ((</> "new") . snd) ms + ev = [Move, MoveIn, MoveOut, Create, Delete] + + i <- initINotify + zipWithM_ (\d v -> addWatch i ev d (handle v)) 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 -> do + cb . unwords $ [m ++ ":" ++ show n + | (m, n) <- zip ts ns + , n /= 0 ] + +modifyTVar :: TVar a -> (a -> a) -> STM () +modifyTVar v f = readTVar v >>= writeTVar v . f + +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 (filePath e) + create = S.insert (filePath e) + +changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO () +changeLoop s f = atomically s >>= go + where + go old = do + f old + go =<< atomically (do + new <- s + guard (new /= old) + return new) diff --git a/xmobar.cabal b/xmobar.cabal index 02e60cb..9ed1cfd 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -24,6 +24,9 @@ flag with_xft flag with_utf8 description: With UTF-8 support. +flag with_inotify + description: inotify support (modern Linux only). Required for the Mail plugin. + executable xmobar main-is: Main.hs other-Modules: Xmobar, Config, Parsers, Commands, XUtil, Runnable, Plugins @@ -43,4 +46,8 @@ executable xmobar build-depends: utf8-string cpp-options: -DUTF8 + if flag(with_inotify) + build-depends: hinotify + cpp-options: -DINOTIFY + build-depends: X11>=1.3.0, mtl, unix, parsec, filepath, stm |