{-# 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.Exec
#ifdef INOTIFY

import Xmobar.Plugins.Monitors.Common (parseOptsWith)
import Xmobar.System.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 :: String -> ByteString
pack = String -> ByteString
BS.pack
#else
pack :: String -> String
pack = id
#endif

data Options = Options
               { Options -> Bool
oAll :: Bool
               , Options -> Bool
oUniq :: Bool
               , Options -> String
oDir :: FilePath
               , Options -> String
oPrefix :: String
               , Options -> String
oSuffix :: String
               }

defaults :: Options
defaults :: Options
defaults = Options :: Bool -> Bool -> String -> String -> String -> Options
Options {
  oAll :: Bool
oAll = Bool
False, oUniq :: Bool
oUniq = Bool
False, oDir :: String
oDir = "", oPrefix :: String
oPrefix = "", oSuffix :: String
oSuffix = ""
  }

options :: [OptDescr (Options -> Options)]
options :: [OptDescr (Options -> Options)]
options =
  [ String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "a" ["all"] ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (\o :: Options
o -> Options
o { oAll :: Bool
oAll = Bool
True })) ""
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "u" [] ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (\o :: Options
o -> Options
o { oUniq :: Bool
oUniq = Bool
True })) ""
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "d" ["dir"] ((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: Options
o -> Options
o { oDir :: String
oDir = String
x }) "") ""
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "p" ["prefix"] ((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: Options
o -> Options
o { oPrefix :: String
oPrefix = String
x }) "") ""
  , String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "s" ["suffix"] ((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\x :: String
x o :: Options
o -> Options
o { oSuffix :: String
oSuffix = String
x }) "") ""
  ]

#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 (ReadPrec [MBox]
ReadPrec MBox
Int -> ReadS MBox
ReadS [MBox]
(Int -> ReadS MBox)
-> ReadS [MBox] -> ReadPrec MBox -> ReadPrec [MBox] -> Read MBox
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MBox]
$creadListPrec :: ReadPrec [MBox]
readPrec :: ReadPrec MBox
$creadPrec :: ReadPrec MBox
readList :: ReadS [MBox]
$creadList :: ReadS [MBox]
readsPrec :: Int -> ReadS MBox
$creadsPrec :: Int -> ReadS MBox
Read, Int -> MBox -> ShowS
[MBox] -> ShowS
MBox -> String
(Int -> MBox -> ShowS)
-> (MBox -> String) -> ([MBox] -> ShowS) -> Show MBox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MBox] -> ShowS
$cshowList :: [MBox] -> ShowS
show :: MBox -> String
$cshow :: MBox -> String
showsPrec :: Int -> MBox -> ShowS
$cshowsPrec :: Int -> MBox -> ShowS
Show)

instance Exec MBox where
  alias :: MBox -> String
alias (MBox _ _ a :: String
a) = String
a
#ifndef INOTIFY
  start _ _ =
    hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify" ++
          " but the MBox plugin requires it"
#else
  start :: MBox -> (String -> IO ()) -> IO ()
start (MBox boxes :: [(String, String, String)]
boxes args :: [String]
args _) cb :: String -> IO ()
cb = do
    Options
opts <- [OptDescr (Options -> Options)]
-> Options -> [String] -> IO Options
forall opts.
[OptDescr (opts -> opts)] -> opts -> [String] -> IO opts
parseOptsWith [OptDescr (Options -> Options)]
options Options
defaults [String]
args
    let showAll :: Bool
showAll = Options -> Bool
oAll Options
opts
        prefix :: String
prefix = Options -> String
oPrefix Options
opts
        suffix :: String
suffix = Options -> String
oSuffix Options
opts
        uniq :: Bool
uniq = Options -> Bool
oUniq Options
opts
        names :: [String]
names = ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(t :: String
t, _, _) -> String
t) [(String, String, String)]
boxes
        colors :: [String]
colors = ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(_, _, c :: String
c) -> String
c) [(String, String, String)]
boxes
        extractPath :: (a, String, c) -> IO String
extractPath (_, f :: String
f, _) = String -> IO String
expandHome (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Options -> String
oDir Options
opts String -> ShowS
</> String
f
        events :: [EventVariety]
events = [EventVariety
CloseWrite]

    INotify
i <- IO INotify
initINotify
    [TVar (String, Int)]
vs <- ((String, String, String) -> IO (TVar (String, Int)))
-> [(String, String, String)] -> IO [TVar (String, Int)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\b :: (String, String, String)
b -> do
                   String
f <- (String, String, String) -> IO String
forall a c. (a, String, c) -> IO String
extractPath (String, String, String)
b
                   Bool
exists <- String -> IO Bool
doesFileExist String
f
                   Int
n <- if Bool
exists then String -> IO Int
countMails String
f else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (-1)
                   TVar (String, Int)
v <- (String, Int) -> IO (TVar (String, Int))
forall a. a -> IO (TVar a)
newTVarIO (String
f, Int
n)
                   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                     INotify
-> [EventVariety]
-> ByteString
-> (Event -> IO ())
-> IO WatchDescriptor
addWatch INotify
i [EventVariety]
events (String -> ByteString
pack String
f) (TVar (String, Int) -> Event -> IO ()
handleNotification TVar (String, Int)
v) IO WatchDescriptor -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   TVar (String, Int) -> IO (TVar (String, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return TVar (String, Int)
v)
                [(String, String, String)]
boxes

    STM [Int] -> ([Int] -> IO ()) -> IO ()
forall a. Eq a => STM a -> (a -> IO ()) -> IO ()
changeLoop ((TVar (String, Int) -> STM Int)
-> [TVar (String, Int)] -> STM [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (((String, Int) -> Int) -> STM (String, Int) -> STM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Int) -> Int
forall a b. (a, b) -> b
snd (STM (String, Int) -> STM Int)
-> (TVar (String, Int) -> STM (String, Int))
-> TVar (String, Int)
-> STM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (String, Int) -> STM (String, Int)
forall a. TVar a -> STM a
readTVar) [TVar (String, Int)]
vs) (([Int] -> IO ()) -> IO ()) -> ([Int] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ns :: [Int]
ns ->
      let s :: String
s = [String] -> String
unwords [ Bool -> String -> Int -> ShowS
showC Bool
uniq String
m Int
n String
c | (m :: String
m, n :: Int
n, c :: String
c) <- [String] -> [Int] -> [String] -> [(String, Int, String)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [String]
names [Int]
ns [String]
colors
                                         , Bool
showAll Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 ]
      in String -> IO ()
cb (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then "" else String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suffix)

showC :: Bool -> String -> Int -> String -> String
showC :: Bool -> String -> Int -> ShowS
showC u :: Bool
u m :: String
m n :: Int
n c :: String
c =
  if String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" then String
msg else "<fc=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ ">" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ "</fc>"
    where msg :: String
msg = String
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Bool -> Bool
not Bool
u Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 then Int -> String
forall a. Show a => a -> String
show Int
n else ""

countMails :: FilePath -> IO Int
countMails :: String -> IO Int
countMails f :: String
f =
  (SomeException -> IO Int) -> IO Int -> IO Int
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException _) -> Int -> IO Int
forall a. a -> IO a
evaluate 0)
         (do ByteString
txt <- String -> IO ByteString
B.readFile String
f
             Int -> IO Int
forall a. a -> IO a
evaluate (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ByteString] -> Int)
-> (ByteString -> [ByteString]) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
from) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ ByteString
txt)
  where from :: ByteString
from = String -> ByteString
B.pack "From "

handleNotification :: TVar (FilePath, Int) -> Event -> IO ()
handleNotification :: TVar (String, Int) -> Event -> IO ()
handleNotification v :: TVar (String, Int)
v _ =  do
  (p :: String
p, _) <- STM (String, Int) -> IO (String, Int)
forall a. STM a -> IO a
atomically (STM (String, Int) -> IO (String, Int))
-> STM (String, Int) -> IO (String, Int)
forall a b. (a -> b) -> a -> b
$ TVar (String, Int) -> STM (String, Int)
forall a. TVar a -> STM a
readTVar TVar (String, Int)
v
  Int
n <- String -> IO Int
countMails String
p
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (String, Int) -> (String, Int) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (String, Int)
v (String
p, Int
n)
#endif