summaryrefslogtreecommitdiffhomepage
path: root/Plugins
diff options
context:
space:
mode:
Diffstat (limited to 'Plugins')
-rw-r--r--Plugins/MBox.hs82
1 files changed, 82 insertions, 0 deletions
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)