From 720c9ecadb0302f43769f743b706ffedfbd6b44c Mon Sep 17 00:00:00 2001
From: Jose A Ortega Ruiz <jao@gnu.org>
Date: Fri, 5 Feb 2010 23:13:30 +0100
Subject: New mail monitor for mbox files (MBox)

Ignore-this: abfbb44ff7c6407fa3b8cdf1a456c614

darcs-hash:20100205221330-748be-3ccdc724959795baad629e7b00573aef7cdfffb4.gz
---
 Config.hs       |  3 ++-
 Plugins/MBox.hs | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 README          | 20 +++++++++++++-
 3 files changed, 103 insertions(+), 2 deletions(-)
 create mode 100644 Plugins/MBox.hs

diff --git a/Config.hs b/Config.hs
index 36c1c85..3807711 100644
--- a/Config.hs
+++ b/Config.hs
@@ -35,6 +35,7 @@ import Plugins.EWMH
 
 #ifdef INOTIFY
 import Plugins.Mail
+import Plugins.MBox
 #endif
 
 -- $config
@@ -96,7 +97,7 @@ infixr :*:
 -- this function's type signature.
 runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*:
 #ifdef INOTIFY
-                 Mail :*:
+                 Mail :*: MBox :*:
 #endif
                  ()
 runnableTypes = undefined
diff --git a/Plugins/MBox.hs b/Plugins/MBox.hs
new file mode 100644
index 0000000..276d50a
--- /dev/null
+++ b/Plugins/MBox.hs
@@ -0,0 +1,82 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Plugins.MBox
+-- Copyright   :  (c) Jose A Ortega Ruiz
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Jose A Ortega Ruiz <jao@gnu.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A plugin for checking mail in mbox files.
+--
+-----------------------------------------------------------------------------
+
+module Plugins.MBox (MBox(..)) 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)
+
+-- | A list of display names, paths to mbox files and display colours,
+-- followed by a directory to resolve relative path names (can be "")
+data MBox = MBox [(String, FilePath, String)] FilePath
+          deriving (Read, Show)
+
+instance Exec MBox where
+  start (MBox ms dir) cb = do
+    vs <- mapM (const $ newTVarIO ("", 0 :: Int)) ms
+
+    dirExists <- doesDirectoryExist dir
+    let ts = map (\(t, _, _) -> t) ms
+        sec = \(_, f, _) -> f
+        md = if dirExists then (dir </>) . sec else sec
+        fs = map md ms
+        cs = map (\(_, _, c) -> c) ms
+        ev = [Modify, Create]
+
+    i <- initINotify
+    zipWithM_ (\f v -> addWatch i ev f (handle v)) fs vs
+
+    forM (zip fs vs) $ \(f, v) -> do
+      exists <- doesFileExist f
+      n <- if exists then countMails f else return 0
+      atomically $ writeTVar v (f, n)
+
+    changeLoop (mapM (fmap snd . readTVar) vs) $ \ns ->
+      cb . unwords $ [ showC m n c | (m, n, c) <- zip3 ts ns cs, n /= 0 ]
+
+showC :: String -> Int -> String -> String
+showC m n c =
+  if c == "" then msg else "<fc=" ++ c ++ ">" ++ msg ++ "</fc>"
+    where msg = m ++ show n
+
+countMails :: FilePath -> IO Int
+countMails f = do
+  txt <- readFileSafe f
+  return $ length . filter (isPrefixOf "From ") . lines $ txt
+
+handle :: TVar (FilePath, Int) -> Event -> IO ()
+handle v _ =  do
+  (p, _) <- atomically $ readTVar v
+  n <- countMails p
+  atomically $ writeTVar v (p, n)
+
+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/README b/README
index 77e3384..cea0985 100644
--- a/README
+++ b/README
@@ -410,7 +410,25 @@ Monitors have default aliases.
 - aliases to `Mail`
 - Args: list of maildirs in form [("name1","path1"),("name2","path2")]
 - This plugin requires INOTIFY support in Linux kernel and hinotify library.
-  To activate, pass --flags="with_inotify" to "runhaskell Setup configure".
+  To activate, pass --flags="with_inotify" to "runhaskell Setup configure"
+  or to "cabal configure".
+
+`MBox Mboxes BaseDir`
+
+- aliases to `MBox`
+- Mboxes a list of mbox files of the form [("name", "path", "color")],
+  where name is the displayed name, path the absolute or relative (to
+  BaseDir) path of the mbox file, and color the color to use to display
+  the mail count (use an empty string for the default).
+- BaseDir is a string giving the base directory where mbox files with
+  a relative path live. It can be empty if all your paths are
+  absolute.
+- This plugin requires INOTIFY support in Linux kernel and hinotify library.
+  To activate, pass --flags="with_inotify" to "runhaskell Setup
+  configure" or to "cabal configure".
+- Example:
+   `Run MBox [("I ", "inbox", "red"), ("O ", "/foo/mbox", "")] "/var/mail/"`
+  will look for mails in /var/mail/inbox and /foo/mbox.
 
 ### Monitor Plugins Commands Arguments
 
-- 
cgit v1.2.3