packages feed

libnotify (empty) → 0.0.1.1

raw patch · 7 files changed

+602/−0 lines, 7 filesdep +basedep +bytestringdep +glibsetup-changed

Dependencies added: base, bytestring, glib, gtk, mtl

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (C) 2011-2012 Emon Tsukimiya, Matvey Aksenov++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Libnotify.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}+-- | System.Libnotify module deals with notification session processing.+{-# OPTIONS_HADDOCK prune #-}+module System.Libnotify+  ( oneShot, withNotifications+  , new, continue, update, render, close+  , setTimeout, setCategory, setUrgency+  , Hint(..), GeneralHint, removeHints+  , addAction, removeActions+  , notifyErrorHandler+  ) where++import Control.Exception (throw)+import Control.Monad.Reader (MonadIO, MonadReader, ReaderT, liftIO, runReaderT, ask)+import Data.Int (Int32)+import Data.Maybe (fromMaybe)+import Data.Word (Word8)+import qualified Data.ByteString as BS+import System.IO (stderr, hPutStrLn)++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+                 }++{-|+  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 a x = (N.initNotify . fromMaybe " ") a >>= \initted ->+                        if initted+                          then x >> N.uninitNotify+                          else throw 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++-- | 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 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++-- | Continues old notification session.+continue :: Session -> ReaderT Session IO a -> IO ()+continue s f = runReaderT f s >> return ()++-- | 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))++-- | Shows notification to user.+render :: (MonadIO m, MonadReader Session m) => m Bool+render = ask >>= liftIO . N.showNotify . notification++-- | Closes notification.+close :: (MonadIO m, MonadReader Session m) => m Bool+close = ask >>= liftIO . N.closeNotify . notification++-- | Sets notification 'Timeout'.+setTimeout :: (MonadIO m, MonadReader Session m) => Timeout -> m ()+setTimeout t = ask >>= liftIO . N.setTimeout t . notification++-- | Sets notification 'Category'.+setCategory :: (MonadIO m, MonadReader Session m) => Category -> m ()+setCategory c = ask >>= liftIO . N.setCategory c . notification++-- | 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++instance Hint (Key,String) where+  addHint (k,v) = ask >>= \s -> liftIO $ N.setHintString (notification s) k v+  generalize (k,v) = HintString k v++instance Hint (Key,Word8) where+  addHint (k,v) = ask >>= \s -> liftIO $ N.setHintByte (notification s) k v+  generalize (k,v) = HintByte k v++instance Hint (Key,BS.ByteString) where+  addHint (k,v) = ask >>= \s -> liftIO $ N.setHintByteArray (notification s) k v+  generalize (k,v) = HintArray k v++-- | Removes hints from notification.+removeHints :: (MonadIO m, MonadReader Session m) => m ()+removeHints = ask >>= liftIO . N.clearHints . notification++-- | 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++-- | 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."++listToMaybeAll :: [a] -> Maybe [a]+listToMaybeAll [] = Nothing+listToMaybeAll xs = Just xs
+ System/Libnotify/Internal.hsc view
@@ -0,0 +1,261 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-- | System.Libnotify.Internal module is low level c-bindings to Libnotify.+-- No API stability is guaranteed.+{-# OPTIONS_HADDOCK hide #-}++#include <libnotify/notify.h>++module System.Libnotify.Internal+  ( Notification+  , initNotify, uninitNotify, isInitted+  , newNotify, updateNotify, showNotify+  , setTimeout, expiresDefault, expiresNever, expires+  , setCategory, setUrgency, setIconFromPixbuf, setImageFromPixbuf+  , setHintInt32, setHintDouble, setHintString, setHintByte, setHintByteArray, clearHints+  , addAction, clearActions, closeNotify+  ) where++import Foreign+import Foreign.C+import Graphics.UI.Gtk.Gdk.Pixbuf+import System.Glib.GError+import System.Glib.GList+import Unsafe.Coerce+import qualified Data.ByteString as BS++import System.Libnotify.Types++-- | Notification session pointer+newtype Notification = Notification (Ptr Notification)++initNotify :: String -> IO Bool+initNotify appName =+  withCString appName $ \p_appName ->+  notify_init p_appName++foreign import ccall unsafe "libnotify/notify.h notify_init"+  notify_init :: CString -> IO Bool++uninitNotify :: IO ()+uninitNotify = notify_uninit++foreign import ccall unsafe "libnotify/notify.h notify_uninit"+  notify_uninit :: IO ()++isInitted :: IO Bool+isInitted = notify_is_initted++foreign import ccall unsafe "libnotify/notify.h notify_is_initted"+  notify_is_initted :: IO Bool++type ActionCallback a = Notification -> CString -> Ptr a -> IO ()+type FreeFunc a = Ptr a -> IO ()++newNotify :: String -> Maybe String -> Maybe String -> IO Notification+newNotify summary body icon =+  withCString summary        $ \p_summary ->+  maybeWith withCString body $ \p_body ->+  maybeWith withCString icon $ \p_icon ->+  notify_notification_new p_summary p_body p_icon++foreign import ccall unsafe "libnotify/notify.h notify_notification_new"+  notify_notification_new :: CString+                          -> CString+                          -> CString+                          -> IO Notification++updateNotify :: Notification -> String -> Maybe String -> Maybe String -> IO Bool+updateNotify notify summary body icon =+  withCString summary        $ \p_summary ->+  maybeWith withCString body $ \p_body ->+  maybeWith withCString icon $ \p_icon ->+  notify_notification_update notify p_summary p_body p_icon++foreign import ccall unsafe "libnotify/notify.h notify_notification_update"+  notify_notification_update :: Notification+                             -> CString+                             -> CString+                             -> CString -> IO Bool++showNotify :: Notification -> IO Bool+showNotify notify =+  alloca $ \pp_error -> do+  poke pp_error nullPtr+  result <- notify_notification_show notify pp_error+  p_error <- peek pp_error+  if p_error == nullPtr+    then return result+    else do error <- peek p_error+            g_error_free p_error+            throwGError error++foreign import ccall unsafe "libnotify/notify.h notify_notification_show"+  notify_notification_show :: Notification -> Ptr (Ptr GError) -> IO Bool++foreign import ccall unsafe "glib-object.h g_error_free"+  g_error_free :: Ptr GError -> IO ()++setTimeout :: Timeout -> Notification -> IO ()+setTimeout timeout notify =+  notify_notification_set_timeout notify (getTimeout timeout)++foreign import ccall unsafe "libnotify/notify.h notify_notification_set_timeout"+  notify_notification_set_timeout :: Notification -> CInt -> IO ()++setCategory :: Category -> Notification -> IO ()+setCategory category notify =+  withCString category $ \p_category ->+  notify_notification_set_category notify p_category++foreign import ccall unsafe "libnotify/notify.h notify_notification_set_category"+  notify_notification_set_category :: Notification -> CString -> IO ()++setUrgency :: Urgency -> Notification -> IO ()+setUrgency urgency notify =+  notify_notification_set_urgency notify (getUrgency urgency)++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 =+  withForeignPtr (unsafeCoerce pixbuf) $ \p_pixbuf ->+  notify_notification_set_icon_from_pixbuf notify p_pixbuf++foreign import ccall unsafe "libnotify/notify.h notify_notification_set_icon_from_pixbuf"+  notify_notification_set_icon_from_pixbuf :: Notification+                                           -> Ptr Pixbuf+                                           -> IO ()++setImageFromPixbuf :: Notification -> Pixbuf -> IO ()+setImageFromPixbuf notify pixbuf =+  withForeignPtr (unsafeCoerce pixbuf) $ \p_pixbuf ->+  notify_notification_set_image_from_pixbuf notify p_pixbuf++foreign import ccall unsafe "libnotify/notify.h notify_notification_set_image_from_pixbuf"+  notify_notification_set_image_from_pixbuf :: Notification+                                            -> Ptr Pixbuf+                                            -> IO ()++setHintInt32 :: Notification -> String -> Int32 -> IO ()+setHintInt32 notify key value =+  withCString key $ \p_key ->+  notify_notification_set_hint_int32 notify p_key (fromIntegral value)++foreign import ccall unsafe "libnotify/notify.h notify_notification_set_hint_int32"+  notify_notification_set_hint_int32 :: Notification+                                     -> CString+                                     -> CInt+                                     -> IO ()++setHintDouble :: Notification -> String -> Double -> IO ()+setHintDouble notify key value =+  withCString key $ \p_key ->+  notify_notification_set_hint_double notify p_key (realToFrac value)++foreign import ccall unsafe "libnotify/notify.h notify_notification_set_hint_double"+  notify_notification_set_hint_double :: Notification+                                      -> CString+                                      -> CDouble+                                      -> IO ()++setHintString :: Notification -> String -> String -> IO ()+setHintString notify key value =+  withCString key   $ \p_key ->+  withCString value $ \p_value ->+  notify_notification_set_hint_string notify p_key p_value++foreign import ccall unsafe "libnotify/notify.h notify_notification_set_hint_string"+  notify_notification_set_hint_string :: Notification+                                      -> CString+                                      -> CString+                                      -> IO ()++setHintByte :: Notification -> String -> Word8 -> IO ()+setHintByte notify key value =+  withCString key $ \p_key ->+  notify_notification_set_hint_byte notify p_key (fromIntegral value)++foreign import ccall unsafe "libnotify/notify.h notify_notification_set_hint_byte"+  notify_notification_set_hint_byte :: Notification+                                    -> CString+                                    -> CUChar+                                    -> IO ()++setHintByteArray :: Notification -> String -> BS.ByteString -> IO ()+setHintByteArray notify key value =+  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)+    where+      step x xs = fromIntegral x:xs++foreign import ccall unsafe "libnotify/notify.h notify_notification_set_hint_byte_array"+  notify_notification_set_hint_byte_array :: Notification+                                          -> CString+                                          -> Ptr CUChar+                                          -> CSize+                                          -> IO ()++clearHints :: Notification -> IO ()+clearHints = notify_notification_clear_hints++foreign import ccall unsafe "libnotify/notify.h notify_notification_clear_hints"+  notify_notification_clear_hints :: Notification -> IO ()++addAction+  :: Notification+  -> String+  -> String+  -> (Notification -> String -> IO ())+  -> IO ()+addAction notify action label callback =+  withCString action $ \p_action ->+  withCString label  $ \p_label -> do+    p_callback <- wrapActionCallback $ makeCallback callback+    notify_notification_add_action notify+                                   p_action+                                   p_label+                                   p_callback+                                   nullPtr+                                   nullFunPtr+  where+    makeCallback callback = \notify p_action _ -> do+      action <- peekCString p_action+      callback notify action++foreign import ccall "wrapper"+  wrapActionCallback :: (ActionCallback a) -> IO (FunPtr (ActionCallback a))++foreign import ccall "wrapper"+  wrapFreeFunc :: (FreeFunc a) -> IO (FunPtr (FreeFunc a))++foreign import ccall unsafe "libnotify/notify.h notify_notification_add_action"+  notify_notification_add_action :: Notification+                                 -> CString+                                 -> CString+                                 -> FunPtr (ActionCallback a)+                                 -> Ptr a+                                 -> FunPtr (FreeFunc a)+                                 -> IO ()++clearActions :: Notification -> IO ()+clearActions = notify_notification_clear_actions++foreign import ccall unsafe "libnotify/notify.h notify_notification_clear_actions"+  notify_notification_clear_actions :: Notification -> IO ()++closeNotify :: Notification -> IO Bool+closeNotify notify =+  alloca $ \pp_error -> do+  poke pp_error nullPtr+  result <- notify_notification_close notify pp_error+  p_error <- peek pp_error+  if p_error == nullPtr+    then return result+    else do error <- peek p_error+            g_error_free p_error+            throwGError error++foreign import ccall unsafe "libnotify/notify.h notify_notification_close"+  notify_notification_close :: Notification -> Ptr (Ptr GError) -> IO Bool
+ System/Libnotify/Server.hsc view
@@ -0,0 +1,75 @@+{-# LANGUAGE ForeignFunctionInterface #-}+-- | System.Libnotify.Server module deals with notification server info processing and+-- initialized applications managing.+{-# OPTIONS_HADDOCK prune #-}++#include <libnotify/notify.h>++module System.Libnotify.Server+  ( getAppName, setAppName, getServerCaps, getServerInfo+  ) where++import Foreign+import Foreign.C+import System.Glib.GList++import System.Libnotify.Types (ServerInfo(..))++-- | Returns registered application name.+getAppName :: IO String+getAppName = do+  p_appName <- notify_get_app_name+  peekCString p_appName++foreign import ccall unsafe "libnotify/notify.h notify_get_app_name"+  notify_get_app_name :: IO CString++-- | Updates registered application name.+setAppName :: String -> IO ()+setAppName appName =+  withCString appName $ \p_appName ->+  notify_set_app_name p_appName++foreign import ccall unsafe "libnotify/notify.h notify_set_app_name"+  notify_set_app_name :: CString -> IO ()++-- | Returns server capability strings.+getServerCaps :: IO [String]+getServerCaps = do+  g_type_init+  p_caps <- notify_get_server_caps >>= readGList+  mapM peekCString p_caps++foreign import ccall unsafe "libnotify/notify.h notify_get_server_caps"+  notify_get_server_caps :: IO GList++-- | Returns server information.+getServerInfo :: IO ServerInfo+getServerInfo =+  alloca $ \p_name ->+  alloca $ \p_vendor ->+  alloca $ \p_version ->+  alloca $ \p_specVersion -> do+    g_type_init+    notify_get_server_info p_name p_vendor p_version p_specVersion+    name        <- peekCString =<< peek p_name+    vendor      <- peekCString =<< peek p_vendor+    version     <- peekCString =<< peek p_version+    specVersion <- peekCString =<< peek p_specVersion+    return $ ServerInfo+      { serverName        = name+      , serverVendor      = vendor+      , serverVersion     = version+      , serverSpecVersion = specVersion+      }++foreign import ccall unsafe "libnotify/notify.h notify_get_server_info"+  notify_get_server_info :: (Ptr CString)+                         -> (Ptr CString)+                         -> (Ptr CString)+                         -> (Ptr CString)+                         -> IO Bool++foreign import ccall safe "g_type_init"+  g_type_init :: IO ()+
+ System/Libnotify/Types.hsc view
@@ -0,0 +1,69 @@+{-# 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, getTimeout, expiresDefault, expiresNever, expires+  , Urgency, getUrgency, notifyUrgencyLow, notifyUrgencyNormal, notifyUrgencyCritical+  , Category+  , Title, Body, Icon+  , Key+  , ServerInfo(..)+  , NotifyError(..)+  ) where++import Control.Exception (Exception)+import Data.Typeable (Typeable)+import Foreign (Ptr)+import Foreign.C++-- | Timeout in seconds after which notification is closed.+newtype Timeout = Timeout {getTimeout :: CInt}+#{enum Timeout, Timeout,+  expiresDefault = NOTIFY_EXPIRES_DEFAULT,+  expiresNever   = NOTIFY_EXPIRES_NEVER+}++-- | Sets custom 'Timeout'.+expires :: Int -> Timeout+expires = Timeout . fromIntegral++-- | Urgency can be used by the notification server to filter or display the data in a certain way.+newtype Urgency = Urgency {getUrgency :: CInt}+#{enum Urgency, Urgency,+  notifyUrgencyLow      = NOTIFY_URGENCY_LOW,+  notifyUrgencyNormal   = NOTIFY_URGENCY_NORMAL,+  notifyUrgencyCritical = NOTIFY_URGENCY_CRITICAL+}++-- | 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
@@ -0,0 +1,26 @@+Name:		libnotify+Version:	0.0.1.1+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, Utils+Synopsis:	Haskell binding for Libnotify+Cabal-Version:	>= 1.6+Build-Type:	Simple++Library+  Build-Depends:	base >= 3 && < 4.4, bytestring, glib, gtk, mtl+  Exposed-Modules:	System.Libnotify, System.Libnotify.Internal, System.Libnotify.Server, System.Libnotify.Types+  Pkgconfig-Depends:	libnotify+  Extensions:		DeriveDataTypeable, FlexibleInstances, FlexibleContexts++source-repository head+  type:     git+  location: https://github.com/supki/haskell-libnotify++source-repository this+  type:     git+  location: https://github.com/supki/haskell-libnotify+  tag:      v0.0.1.1