packages feed

libnotify 0.0.1.2 → 0.0.2.0

raw patch · 5 files changed

+168/−190 lines, 5 files

Files

System/Libnotify.hs view
@@ -1,150 +1,130 @@-{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving  #-} -- | System.Libnotify module deals with notification session processing. {-# OPTIONS_HADDOCK prune #-} module System.Libnotify-  ( oneShot, withNotifications+  ( Notify, NotifyState, NotifyError (..)+  , oneShot, withNotifications   , new, continue, update, render, close   , setTimeout, setCategory, setUrgency-  , Hint(..), GeneralHint, removeHints+  , addHint, removeHints   , addAction, removeActions-  , notifyErrorHandler+  , setIconFromPixbuf, setImageFromPixbuf+  , module System.Libnotify.Types   ) where -import Control.Exception (throw)-import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, liftIO, runReaderT, ask)-import Data.Int (Int32)+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 Data.Word (Word8)-import qualified Data.ByteString as BS-import System.IO (stderr, hPutStrLn)+import Graphics.UI.Gtk.Gdk.Pixbuf (Pixbuf) +import System.Libnotify.Internal (Notification) import qualified System.Libnotify.Internal as N import System.Libnotify.Types --- | Notification session. Saves notification initial state.-data Session = Session-                 { notification :: N.Notification-                 , title :: Title-                 , body :: Body-                 , icon :: Icon-                 }+-- | Notification state. Contains next rendered notification data.+data NotifyState = NotifyState Title Body Icon +-- | Libnotify errors.+data NotifyError+  = NotifyInitHasFailed  -- ^ notify_init() has failed.+  | NewCalledBeforeInit  -- ^ 'new' has called before notify_init().+  deriving Show++-- | Notification monad. Saves notification context.+newtype Notify a = Notify { runNotify :: StateT NotifyState (ReaderT Notification IO) a } deriving (Functor, Monad, MonadIO)+ {-|   Initializes and uninitializes libnotify API.   Any notifications API calls should be wrapped into @withNotifications@, i.e.    > main = withNotifications (Just "api-name") $ do { ... here are notification API calls ... } -}-withNotifications :: Maybe String -> IO a -> IO ()+withNotifications :: Maybe String -> IO a -> IO (Either NotifyError ()) withNotifications a x = (N.initNotify . fromMaybe " ") a >>= \initted ->                         if initted-                          then x >> N.uninitNotify-                          else throw NotifyInitHasFailed+                          then Right <$> (x >> N.uninitNotify)+                          else return $ Left NotifyInitHasFailed  -- | Function for one-time notification with hints perhaps. Should be enough for a vast majority of applications.-oneShot :: Hint a => Title -> Body -> Icon -> [a] -> IO ()-oneShot t b i hs = withNotifications Nothing $-                     new t b i $-                       mapM_ addHint hs >> render+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  -- | Creates new notification session. Inside 'new' call one can manage current notification via 'update' or 'render' calls. -- Returns notification pointer. This could be useful if one wants to 'update' or 'close' the same notification after some time (see 'continue').-new :: Title -> Body -> Icon -> ReaderT Session IO t -> IO Session+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 (listToMaybeAll b) (listToMaybeAll i)-                        continue (Session n t b i) f-                        return (Session n t b i)-                else throw NewCalledBeforeInit+                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  -- | Continues old notification session.-continue :: Session -> ReaderT Session IO a -> IO ()-continue s f = runReaderT f s >> return ()+continue :: (Notification, NotifyState) -> Notify a -> IO NotifyState+continue (n, s) f = runReaderT (execStateT (runNotify f) s) n  -- | Updates notification 'Title', 'Body' and 'Icon'. -- User can update notification partially, passing Nothing to arguments that should not changed.-update :: (MonadIO m, MonadReader Session m) => Maybe Title -> Maybe Body -> Maybe Icon -> m Bool-update nt nb ni = ask >>= \(Session n t b i) ->-                    liftIO $ N.updateNotify n-                               (fromMaybe t nt)-                               (listToMaybeAll (fromMaybe b nb))-                               (listToMaybeAll (fromMaybe i ni))+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)  -- | Shows notification to user.-render :: (MonadIO m, MonadReader Session m) => m Bool-render = ask >>= liftIO . N.showNotify . notification+render :: Notify Bool+render = Notify $ ask >>= liftIO . N.showNotify  -- | Closes notification.-close :: (MonadIO m, MonadReader Session m) => m Bool-close = ask >>= liftIO . N.closeNotify . notification+close :: Notify Bool+close = Notify $ ask >>= liftIO . N.closeNotify  -- | Sets notification 'Timeout'.-setTimeout :: (MonadIO m, MonadReader Session m) => Timeout -> m ()-setTimeout t = ask >>= liftIO . N.setTimeout t . notification+setTimeout :: Timeout -> Notify ()+setTimeout t = Notify $ ask >>= liftIO . N.setTimeout t  -- | Sets notification 'Category'.-setCategory :: (MonadIO m, MonadReader Session m) => Category -> m ()-setCategory c = ask >>= liftIO . N.setCategory c . notification+setCategory :: Category -> Notify ()+setCategory c = Notify $ ask >>= liftIO . N.setCategory c  -- | Sets notification 'Urgency'.-setUrgency :: (MonadIO m, MonadReader Session m) => Urgency -> m ()-setUrgency u = ask >>= liftIO . N.setUrgency u . notification---- | Instance of 'Hint' class. Useful for 'oneShot' calls with empty hint list.-data GeneralHint = HintInt String Int32 | HintDouble String Double | HintString String String | HintByte String Word8 | HintArray String BS.ByteString---- | Hint is some setting (server-dependent) which comes with notification.-class Hint a where-  -- | Adds 'Hint' to notification.-  addHint :: a -> (MonadIO m, MonadReader Session m) => m ()-  -- | Generalizes 'Hint' to some type. Could be useful if one wants to pass list of distinct hints types.-  generalize :: a -> GeneralHint--instance Hint GeneralHint where-  addHint (HintInt k v) = addHint (k,v)-  addHint (HintDouble k v) = addHint (k,v)-  addHint (HintString k v) = addHint (k,v)-  addHint (HintByte k v) = addHint (k,v)-  addHint (HintArray k v) = addHint (k,v)-  generalize = id--instance Hint (Key,Int32) where-  addHint (k,v) = ask >>= \s -> liftIO $ N.setHintInt32 (notification s) k v-  generalize (k,v) = HintInt k v--instance Hint (Key,Double) where-  addHint (k,v) = ask >>= \s -> liftIO $ N.setHintDouble (notification s) k v-  generalize (k,v) = HintDouble k v+setUrgency :: Urgency -> Notify ()+setUrgency u = Notify $ ask >>= liftIO . N.setUrgency u -instance Hint (Key,String) where-  addHint (k,v) = ask >>= \s -> liftIO $ N.setHintString (notification s) k v-  generalize (k,v) = HintString k v+-- | Sets notification icon from pixbuf+setIconFromPixbuf :: Pixbuf -> Notify ()+setIconFromPixbuf p = Notify $ ask >>= liftIO . N.setIconFromPixbuf p -instance Hint (Key,Word8) where-  addHint (k,v) = ask >>= \s -> liftIO $ N.setHintByte (notification s) k v-  generalize (k,v) = HintByte k v+-- | Sets notification image from pixbuf+setImageFromPixbuf :: Pixbuf -> Notify ()+setImageFromPixbuf p = Notify $ ask >>= liftIO . N.setImageFromPixbuf p -instance Hint (Key,BS.ByteString) where-  addHint (k,v) = ask >>= \s -> liftIO $ N.setHintByteArray (notification s) k v-  generalize (k,v) = HintArray k v+-- | Adds 'Hint' to notification.+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  -- | Removes hints from notification.-removeHints :: (MonadIO m, MonadReader Session m) => m ()-removeHints = ask >>= liftIO . N.clearHints . notification+removeHints :: Notify ()+removeHints = Notify $ ask >>= liftIO . N.clearHints  -- | Adds action to notification.-addAction :: (MonadIO m, MonadReader Session m) => String -> String -> (N.Notification -> String -> IO ()) -> m ()-addAction a l c = ask >>= \s -> liftIO $ N.addAction (notification s) a l c+addAction :: String -> String -> (Notification -> String -> IO ()) -> Notify ()+addAction a l c = Notify $ ask >>= liftIO . N.addAction a l c  -- | Removes actions from notification.-removeActions :: (MonadIO m, MonadReader Session m) => m ()-removeActions = ask >>= liftIO . N.clearActions . notification---- | Libnotify error handler-notifyErrorHandler :: NotifyError -> IO ()-notifyErrorHandler NotifyInitHasFailed = hPutStrLn stderr "withNotifications: init has failed."-notifyErrorHandler NewCalledBeforeInit = hPutStrLn stderr "new: Libnotify is not initialized properly."+removeActions :: Notify ()+removeActions = Notify $ ask >>= liftIO . N.clearActions -listToMaybeAll :: [a] -> Maybe [a]-listToMaybeAll [] = Nothing-listToMaybeAll xs = Just xs+listToMaybe :: [a] -> Maybe [a]+listToMaybe [] = Nothing+listToMaybe xs = Just xs
System/Libnotify/Internal.hsc view
@@ -15,11 +15,11 @@   , addAction, clearActions, closeNotify   ) where +import Control.Exception (throw) import Foreign import Foreign.C import Graphics.UI.Gtk.Gdk.Pixbuf-import System.Glib.GError-import System.Glib.GList+import System.Glib.GError (GError) import Unsafe.Coerce import qualified Data.ByteString as BS @@ -85,9 +85,9 @@   p_error <- peek pp_error   if p_error == nullPtr     then return result-    else do error <- peek p_error+    else do gerror <- peek p_error             g_error_free p_error-            throwGError error+            throw gerror  foreign import ccall unsafe "libnotify/notify.h notify_notification_show"   notify_notification_show :: Notification -> Ptr (Ptr GError) -> IO Bool@@ -125,8 +125,8 @@ foreign import ccall unsafe "libnotify/notify.h notify_notification_set_urgency"   notify_notification_set_urgency :: Notification -> CInt -> IO () -setIconFromPixbuf :: Notification -> Pixbuf -> IO ()-setIconFromPixbuf notify pixbuf =+setIconFromPixbuf :: Pixbuf -> Notification -> IO ()+setIconFromPixbuf pixbuf notify =   withForeignPtr (unsafeCoerce pixbuf) $ \p_pixbuf ->   notify_notification_set_icon_from_pixbuf notify p_pixbuf @@ -135,8 +135,8 @@                                            -> Ptr Pixbuf                                            -> IO () -setImageFromPixbuf :: Notification -> Pixbuf -> IO ()-setImageFromPixbuf notify pixbuf =+setImageFromPixbuf :: Pixbuf -> Notification -> IO ()+setImageFromPixbuf pixbuf notify =   withForeignPtr (unsafeCoerce pixbuf) $ \p_pixbuf ->   notify_notification_set_image_from_pixbuf notify p_pixbuf @@ -145,8 +145,8 @@                                             -> Ptr Pixbuf                                             -> IO () -setHintInt32 :: Notification -> String -> Int32 -> IO ()-setHintInt32 notify key value =+setHintInt32 :: String -> Int32 -> Notification -> IO ()+setHintInt32 key value notify =   withCString key $ \p_key ->   notify_notification_set_hint_int32 notify p_key (fromIntegral value) @@ -156,8 +156,8 @@                                      -> CInt                                      -> IO () -setHintDouble :: Notification -> String -> Double -> IO ()-setHintDouble notify key value =+setHintDouble :: String -> Double -> Notification -> IO ()+setHintDouble key value notify =   withCString key $ \p_key ->   notify_notification_set_hint_double notify p_key (realToFrac value) @@ -167,8 +167,8 @@                                       -> CDouble                                       -> IO () -setHintString :: Notification -> String -> String -> IO ()-setHintString notify key value =+setHintString :: String -> String -> Notification -> IO ()+setHintString key value notify =   withCString key   $ \p_key ->   withCString value $ \p_value ->   notify_notification_set_hint_string notify p_key p_value@@ -179,8 +179,8 @@                                       -> CString                                       -> IO () -setHintByte :: Notification -> String -> Word8 -> IO ()-setHintByte notify key value =+setHintByte :: String -> Word8 -> Notification -> IO ()+setHintByte key value notify =   withCString key $ \p_key ->   notify_notification_set_hint_byte notify p_key (fromIntegral value) @@ -190,8 +190,8 @@                                     -> CUChar                                     -> IO () -setHintByteArray :: Notification -> String -> BS.ByteString -> IO ()-setHintByteArray notify key value =+setHintByteArray :: String -> BS.ByteString -> Notification -> IO ()+setHintByteArray key value notify =   withCString key $ \p_key ->   withArrayLen (BS.foldr' step [] value) $ \len p_bs ->   notify_notification_set_hint_byte_array notify p_key p_bs (fromIntegral len)@@ -212,12 +212,12 @@   notify_notification_clear_hints :: Notification -> IO ()  addAction-  :: Notification-  -> String+  :: String   -> String   -> (Notification -> String -> IO ())+  -> Notification   -> IO ()-addAction notify action label callback =+addAction action label callback notify =   withCString action $ \p_action ->   withCString label  $ \p_label -> do     p_callback <- wrapActionCallback $ makeCallback callback@@ -261,9 +261,9 @@   p_error <- peek pp_error   if p_error == nullPtr     then return result-    else do error <- peek p_error+    else do gerror <- peek p_error             g_error_free p_error-            throwGError error+            throw gerror  foreign import ccall unsafe "libnotify/notify.h notify_notification_close"   notify_notification_close :: Notification -> Ptr (Ptr GError) -> IO Bool
+ System/Libnotify/Types.hs view
@@ -0,0 +1,53 @@+-- | System.Libnotify.Types module is a collection of types is used in other modules.+-- This is reexported with System.Libnotify module. Perhaps it'll never be needed to import explicitly.+{-# OPTIONS_HADDOCK prune #-}++module System.Libnotify.Types+  ( Timeout(..), Urgency(..), Category+  , Title, Body, Icon+  , ServerInfo(..)+  , Hint(..)+  ) where++import qualified Data.ByteString as BS+import Data.Int (Int32)+import Data.Word (Word8)++-- | Urgency can be used by the notification server to prioritize notifications.+-- Although urgency does not work with notify-osd.+data Urgency+       = Low -- ^ Low priority notification.+       | Normal -- ^ Default notification urgency.+       | Critical -- ^ Critical notification that requires immediate attention.++-- | Timeout in seconds after which notification is closed.+-- Although timeout does not work with notify-osd.+data Timeout+       = Default -- ^ Default server timeout.+       | Custom Int -- ^ User defined timeout (in milliseconds).+       | Infinite -- ^ Notification will not expire until user pays attention to it.++-- | Category can be used by the notification server to filter or display the data in a certain way.+type Category = String++-- | Type synonim for notification title.+type Title = String+-- | Type synonim for notification body.+type Body = String+-- | Type synonim for notification icon.+type Icon = String++-- | Server information.+data ServerInfo = ServerInfo+  { serverName  :: String+  , serverVendor :: String+  , serverVersion :: String+  , serverSpecVersion :: String+  } deriving Show++-- | Hint is some setting (server-dependent) which comes with notification.+data Hint = HintInt String Int32+          | HintDouble String Double+          | HintString String String+          | HintByte String Word8+          | HintArray String BS.ByteString
− System/Libnotify/Types.hsc 
@@ -1,55 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-}--- | System.Libnotify.Types module is a collection of types is used in other modules.--- This is reexported with System.Libnotify module. Perhaps it'll never be needed to import explicitly.-{-# OPTIONS_HADDOCK prune #-}--#include <libnotify/notify.h>--module System.Libnotify.Types-  ( Timeout(..), Urgency(..), Category-  , Title, Body, Icon-  , Key-  , ServerInfo(..)-  , NotifyError(..)-  ) where--import Control.Exception (Exception)-import Data.Typeable (Typeable)-import Foreign.C---- | Urgency can be used by the notification server to prioritize notifications.--- Although urgency does not work with notify-osd.-data Urgency = Low | Normal | Critical---- | Timeout in seconds after which notification is closed.--- Although timeout does not work with notify-osd.-data Timeout = Default | Custom Int | Infinite---- | Category can be used by the notification server to filter or display the data in a certain way.-type Category = String---- | Type synonim for notification title.-type Title = String--- | Type synonim for notification body.-type Body = String--- | Type synonim for notification icon.-type Icon = String---- | Type synonym for 'Hint' key type.-type Key = String---- | Server information.-data ServerInfo = ServerInfo-  { serverName  :: String-  , serverVendor :: String-  , serverVersion :: String-  , serverSpecVersion :: String-  } deriving Show---- | Libnotify errors.-data NotifyError-  = NotifyInitHasFailed  -- ^ notify_init() has failed.-  | NewCalledBeforeInit  -- ^ 'new' has called before notify_init().-  deriving (Show, Typeable)--instance Exception NotifyError
libnotify.cabal view
@@ -1,20 +1,20 @@-Name:		libnotify-Version:	0.0.1.2-Description:	Usable binding to libnotify library.-License:	MIT-License-file:	LICENSE-Author:		Emon Tsukimiya, Matvey Aksenov-Maintainer:	Matvey Aksenov <matvey.aksenov@gmail.com>-Category:	System, Desktop-Synopsis:	Haskell binding for Libnotify-Cabal-Version:	>= 1.6-Build-Type:	Simple+Name: libnotify+Version: 0.0.2.0+Description: Usable binding to libnotify library.+License: MIT+License-file: LICENSE+Author: Emon Tsukimiya, Matvey Aksenov+Maintainer: Matvey Aksenov <matvey.aksenov@gmail.com>+Category: System, Desktop+Synopsis: Haskell binding for Libnotify+Cabal-Version: >= 1.6+Build-Type: Simple  Library-  Build-Depends:	base >= 3 && < 5, bytestring, glib, gtk, mtl-  Exposed-Modules:	System.Libnotify, System.Libnotify.Internal, System.Libnotify.Server, System.Libnotify.Types-  Pkgconfig-Depends:	libnotify-  Extensions:		DeriveDataTypeable, FlexibleInstances, FlexibleContexts+  Build-Depends: base >= 3 && < 5, bytestring, glib, gtk, mtl+  Exposed-Modules: System.Libnotify, System.Libnotify.Internal, System.Libnotify.Server, System.Libnotify.Types+  Pkgconfig-Depends: libnotify+  GHC-options: -Wall  source-repository head   type:     git@@ -23,4 +23,4 @@ source-repository this   type:     git   location: https://github.com/supki/haskell-libnotify-  tag:      v0.0.1.2+  tag:      v0.0.2.0