diff options
Diffstat (limited to 'Plugins')
| -rw-r--r-- | Plugins/MBox.hs | 22 | ||||
| -rw-r--r-- | Plugins/Mail.hs | 16 | ||||
| -rw-r--r-- | Plugins/Utils.hs | 39 |
3 files changed, 47 insertions, 30 deletions
diff --git a/Plugins/MBox.hs b/Plugins/MBox.hs index 265e860..f24fa1c 100644 --- a/Plugins/MBox.hs +++ b/Plugins/MBox.hs @@ -16,6 +16,7 @@ module Plugins.MBox (MBox(..)) where import Prelude hiding (catch) import Plugins +import Plugins.Utils (changeLoop, expandHome) import Control.Monad import Control.Concurrent.STM @@ -65,7 +66,6 @@ data MBox = MBox [(String, FilePath, String)] [String] String instance Exec MBox where alias (MBox _ _ a) = a start (MBox ms args _) cb = do - vs <- mapM (const $ newTVarIO ("", 0 :: Int)) ms opts <- parseOptions args -- $ words args let dir = oDir opts @@ -76,24 +76,26 @@ instance Exec MBox where dirExists <- doesDirectoryExist dir let ts = map (\(t, _, _) -> t) ms - sec = \(_, f, _) -> f + sec (_, f, _) = f md = if dirExists then (dir </>) . sec else sec fs = map md ms cs = map (\(_, _, c) -> c) ms ev = [CloseWrite] + xfs <- mapM expandHome fs + vs <- replicateM (length xfs) (newTVarIO ("", 0 :: Int)) i <- initINotify - zipWithM_ (\f v -> addWatch i ev f (handleNotification v)) fs vs - forM_ (zip fs vs) $ \(f, v) -> do + forM_ (zip xfs vs) $ \(f, v) -> do exists <- doesFileExist f n <- if exists then countMails f else return 0 atomically $ writeTVar v (f, n) + when exists $ addWatch i ev f (handleNotification v) >> return () changeLoop (mapM (fmap snd . readTVar) vs) $ \ns -> let s = unwords [ showC uniq m n c | (m, n, c) <- zip3 ts ns cs , allb || n /= 0 ] - in cb (if length s == 0 then "" else pref ++ s ++ suff) + in cb (if null s then "" else pref ++ s ++ suff) showC :: Bool -> String -> Int -> String -> String showC u m n c = @@ -112,13 +114,3 @@ 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) diff --git a/Plugins/Mail.hs b/Plugins/Mail.hs index 89cac30..38cdaae 100644 --- a/Plugins/Mail.hs +++ b/Plugins/Mail.hs @@ -16,12 +16,12 @@ 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.Environment import System.FilePath import System.INotify @@ -58,10 +58,6 @@ instance Exec Mail where modifyTVar :: TVar a -> (a -> a) -> STM () modifyTVar v f = readTVar v >>= writeTVar v . f -expandHome :: FilePath -> IO FilePath -expandHome ('~':'/':path) = fmap (</> path) (getEnv "HOME") -expandHome p = return p - handle :: TVar (Set String) -> Event -> IO () handle v e = atomically $ modifyTVar v $ case e of Created {} -> create @@ -72,13 +68,3 @@ handle v e = atomically $ modifyTVar v $ case e of 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/Plugins/Utils.hs b/Plugins/Utils.hs new file mode 100644 index 0000000..1dbcd40 --- /dev/null +++ b/Plugins/Utils.hs @@ -0,0 +1,39 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Plugins.Utils +-- Copyright: (c) 2010 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: Jose A Ortega Ruiz <jao@gnu.org> +-- Stability: unstable +-- Portability: unportable +-- Created: Sat Dec 11, 2010 20:55 +-- +-- +-- Miscellaneous utility functions +-- +------------------------------------------------------------------------------ + + +module Plugins.Utils (expandHome, changeLoop) where + +import Control.Monad +import Control.Concurrent.STM + +import System.Environment +import System.FilePath + + +expandHome :: FilePath -> IO FilePath +expandHome ('~':'/':path) = fmap (</> path) (getEnv "HOME") +expandHome p = return p + +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) |