1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
-----------------------------------------------------------------------------
-- |
-- 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 Plugins
import Control.Monad
import Control.Concurrent.STM
import Control.Exception (SomeException, handle, evaluate)
import System.Directory
import System.FilePath
import System.INotify
import qualified Data.ByteString.Lazy.Char8 as B
-- | 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 (handleNotification 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 =
handle ((\_ -> evaluate 0) :: SomeException -> IO Int)
(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)
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)
|
