module System.Libnotify
( Notify, NotifyState, NotifyError (..)
, oneShot, withNotifications
, new, continue, update, render, close
, setTimeout, setCategory, setUrgency
, addHint, removeHints
, addAction, removeActions
, setIconFromPixbuf, setImageFromPixbuf
, module System.Libnotify.Types
) where
import Control.Applicative ((<$>))
import Control.Monad.Reader (ReaderT, ask, runReaderT)
import Control.Monad.State (StateT, execStateT, get, put)
import Control.Monad.Trans (MonadIO, liftIO)
import Data.Maybe (fromMaybe)
import Graphics.UI.Gtk.Gdk.Pixbuf (Pixbuf)
import System.Libnotify.Internal (Notification)
import qualified System.Libnotify.Internal as N
import System.Libnotify.Types
data NotifyState = NotifyState Title Body Icon
data NotifyError
= NotifyInitHasFailed
| NewCalledBeforeInit
deriving Show
newtype Notify a = Notify { runNotify :: StateT NotifyState (ReaderT Notification IO) a } deriving (Functor, Monad, MonadIO)
withNotifications :: Maybe String -> IO a -> IO (Either NotifyError ())
withNotifications a x = (N.initNotify . fromMaybe " ") a >>= \initted ->
if initted
then Right <$> (x >> N.uninitNotify)
else return $ Left NotifyInitHasFailed
oneShot :: Title -> Body -> Icon -> Maybe [Hint] -> IO (Either NotifyError ())
oneShot t b i hs = withNotifications Nothing . new t b i $ mapM_ addHint (fromMaybe [] hs) >> render
new :: Title -> Body -> Icon -> Notify t -> IO (Either NotifyError (Notification, NotifyState))
new t b i f = N.isInitted >>= \initted ->
if initted
then do n <- N.newNotify t (listToMaybe b) (listToMaybe i)
s <- continue (n, NotifyState t b i) f
return $ Right (n, s)
else return $ Left NewCalledBeforeInit
continue :: (Notification, NotifyState) -> Notify a -> IO NotifyState
continue (n, s) f = runReaderT (execStateT (runNotify f) s) n
update :: Maybe Title -> Maybe Body -> Maybe Icon -> Notify Bool
update mt mb mi = Notify $
do n <- ask
NotifyState t b i <- get
let nt = fromMaybe t mt
nb = fromMaybe b mb
ni = fromMaybe i mi
put (NotifyState nt nb ni)
liftIO $ N.updateNotify n nt (listToMaybe nb) (listToMaybe ni)
render :: Notify Bool
render = Notify $ ask >>= liftIO . N.showNotify
close :: Notify Bool
close = Notify $ ask >>= liftIO . N.closeNotify
setTimeout :: Timeout -> Notify ()
setTimeout t = Notify $ ask >>= liftIO . N.setTimeout t
setCategory :: Category -> Notify ()
setCategory c = Notify $ ask >>= liftIO . N.setCategory c
setUrgency :: Urgency -> Notify ()
setUrgency u = Notify $ ask >>= liftIO . N.setUrgency u
setIconFromPixbuf :: Pixbuf -> Notify ()
setIconFromPixbuf p = Notify $ ask >>= liftIO . N.setIconFromPixbuf p
setImageFromPixbuf :: Pixbuf -> Notify ()
setImageFromPixbuf p = Notify $ ask >>= liftIO . N.setImageFromPixbuf p
addHint :: Hint -> Notify ()
addHint (HintInt k v) = Notify $ ask >>= liftIO . N.setHintInt32 k v
addHint (HintDouble k v) = Notify $ ask >>= liftIO . N.setHintDouble k v
addHint (HintString k v) = Notify $ ask >>= liftIO . N.setHintString k v
addHint (HintByte k v) = Notify $ ask >>= liftIO . N.setHintByte k v
addHint (HintArray k v) = Notify $ ask >>= liftIO . N.setHintByteArray k v
removeHints :: Notify ()
removeHints = Notify $ ask >>= liftIO . N.clearHints
addAction :: String -> String -> (Notification -> String -> IO ()) -> Notify ()
addAction a l c = Notify $ ask >>= liftIO . N.addAction a l c
removeActions :: Notify ()
removeActions = Notify $ ask >>= liftIO . N.clearActions
listToMaybe :: [a] -> Maybe [a]
listToMaybe [] = Nothing
listToMaybe xs = Just xs