blob: 58431ce040e85c120733da1df11ec81cf69ae3f0 (
plain)
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
|
-----------------------------------------------------------------------------
-- |
-- 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 Plugins
import Plugins.Utils (expandHome, changeLoop)
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
-- | A list of mail box names and paths to maildirs.
data Mail = Mail [(String, FilePath)] String
deriving (Read, Show)
instance Exec Mail where
alias (Mail _ a) = a
start (Mail ms _) cb = do
vs <- mapM (const $ newTVarIO S.empty) ms
let ts = map fst ms
rs = map ((</> "new") . snd) ms
ev = [Move, MoveIn, MoveOut, Create, Delete]
ds <- mapM expandHome rs
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 ->
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)
|
