summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins/MBox.hs
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2018-11-25 15:10:29 +0000
committerjao <jao@gnu.org>2018-11-25 15:10:29 +0000
commit77df1ac30fa7af5948f7ff64f5fee9aed64552b3 (patch)
tree647a4eb67ff1c293a5c530538ee88fc0093b577a /src/Xmobar/Plugins/MBox.hs
parente0d6da82de8d0d1cef98896164c6016b84e47068 (diff)
downloadxmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.gz
xmobar-77df1ac30fa7af5948f7ff64f5fee9aed64552b3.tar.bz2
Back to app/src, since it seems they're the default convention for stack
Diffstat (limited to 'src/Xmobar/Plugins/MBox.hs')
-rw-r--r--src/Xmobar/Plugins/MBox.hs131
1 files changed, 131 insertions, 0 deletions
diff --git a/src/Xmobar/Plugins/MBox.hs b/src/Xmobar/Plugins/MBox.hs
new file mode 100644
index 0000000..4bd0ebd
--- /dev/null
+++ b/src/Xmobar/Plugins/MBox.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE CPP #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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 Xmobar.Plugins.MBox (MBox(..)) where
+
+import Prelude
+import Xmobar.Run.Commands
+#ifdef INOTIFY
+import Xmobar.Utils (changeLoop, expandHome)
+
+import Control.Monad (when)
+import Control.Concurrent.STM
+import Control.Exception (SomeException (..), handle, evaluate)
+
+import System.Console.GetOpt
+import System.Directory (doesFileExist)
+import System.FilePath ((</>))
+import System.INotify (Event(..), EventVariety(..), initINotify, addWatch)
+
+import qualified Data.ByteString.Lazy.Char8 as B
+
+#if MIN_VERSION_hinotify(0,3,10)
+import qualified Data.ByteString.Char8 as BS (ByteString, pack)
+pack :: String -> BS.ByteString
+pack = BS.pack
+#else
+pack :: String -> String
+pack = id
+#endif
+
+data Options = Options
+ { oAll :: Bool
+ , oUniq :: Bool
+ , oDir :: FilePath
+ , oPrefix :: String
+ , oSuffix :: String
+ }
+
+defaults :: Options
+defaults = Options {
+ oAll = False, oUniq = False, oDir = "", oPrefix = "", oSuffix = ""
+ }
+
+options :: [OptDescr (Options -> Options)]
+options =
+ [ Option "a" ["all"] (NoArg (\o -> o { oAll = True })) ""
+ , Option "u" [] (NoArg (\o -> o { oUniq = True })) ""
+ , Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") ""
+ , Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") ""
+ , Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") ""
+ ]
+
+parseOptions :: [String] -> IO Options
+parseOptions args =
+ case getOpt Permute options args of
+ (o, _, []) -> return $ foldr id defaults o
+ (_, _, errs) -> ioError . userError $ concat errs
+
+#else
+import System.IO
+#endif
+
+-- | A list of display names, paths to mbox files and display colours,
+-- followed by a list of options.
+data MBox = MBox [(String, FilePath, String)] [String] String
+ deriving (Read, Show)
+
+instance Exec MBox where
+ alias (MBox _ _ a) = a
+#ifndef INOTIFY
+ start _ _ =
+ hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify" ++
+ " but the MBox plugin requires it"
+#else
+ start (MBox boxes args _) cb = do
+ opts <- parseOptions args
+ let showAll = oAll opts
+ prefix = oPrefix opts
+ suffix = oSuffix opts
+ uniq = oUniq opts
+ names = map (\(t, _, _) -> t) boxes
+ colors = map (\(_, _, c) -> c) boxes
+ extractPath (_, f, _) = expandHome $ oDir opts </> f
+ events = [CloseWrite]
+
+ i <- initINotify
+ vs <- mapM (\b -> do
+ f <- extractPath b
+ exists <- doesFileExist f
+ n <- if exists then countMails f else return (-1)
+ v <- newTVarIO (f, n)
+ when exists $
+ addWatch i events (pack f) (handleNotification v) >> return ()
+ return v)
+ boxes
+
+ changeLoop (mapM (fmap snd . readTVar) vs) $ \ns ->
+ let s = unwords [ showC uniq m n c | (m, n, c) <- zip3 names ns colors
+ , showAll || n > 0 ]
+ in cb (if null s then "" else prefix ++ s ++ suffix)
+
+showC :: Bool -> String -> Int -> String -> String
+showC u m n c =
+ if c == "" then msg else "<fc=" ++ c ++ ">" ++ msg ++ "</fc>"
+ where msg = m ++ if not u || n > 1 then show n else ""
+
+countMails :: FilePath -> IO Int
+countMails f =
+ handle (\(SomeException _) -> evaluate 0)
+ (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)
+#endif