diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,6 @@ +0.1.0.0 +======= + + * More complete and correct low level interface + * Fix memory leak in `notify_notification_new` + * Completely reworked high level interface diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (C) 2011-2012 Emon Tsukimiya, Matvey Aksenov +Copyright (C) 2011-2012 Emon Tsukimiya, 2012-2014 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 diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,11 @@ +libnotify +========= +[![Hackage](https://budueba.com/hackage/libnotify)](https://hackage.haskell.org/package/libnotify) +[![Build Status](https://secure.travis-ci.org/supki/libnotify.png?branch=master)](https://travis-ci.org/supki/libnotify) + +Bindings to [libnotify](https://developer.gnome.org/libnotify/) library + +Note that although the bindings are distributed under MIT license *everything* else is GPLed. +And by everything I mean everything: glib, libnotify, haskell bindings to glib, and so forth. +That effectively means that by using libnotify bindings you agree your project is GPLed too. +Sorry about that! diff --git a/System/Libnotify.hs b/System/Libnotify.hs deleted file mode 100644 --- a/System/Libnotify.hs +++ /dev/null @@ -1,130 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} --- | System.Libnotify module deals with notification session processing. -{-# OPTIONS_HADDOCK prune #-} -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 - --- | 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 (Either NotifyError ()) -withNotifications a x = (N.initNotify . fromMaybe " ") a >>= \initted -> - if initted - 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 :: 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 -> 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 - --- | Continues old notification session. -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 :: 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 :: Notify Bool -render = Notify $ ask >>= liftIO . N.showNotify - --- | Closes notification. -close :: Notify Bool -close = Notify $ ask >>= liftIO . N.closeNotify - --- | Sets notification 'Timeout'. -setTimeout :: Timeout -> Notify () -setTimeout t = Notify $ ask >>= liftIO . N.setTimeout t - --- | Sets notification 'Category'. -setCategory :: Category -> Notify () -setCategory c = Notify $ ask >>= liftIO . N.setCategory c - --- | Sets notification 'Urgency'. -setUrgency :: Urgency -> Notify () -setUrgency u = Notify $ ask >>= liftIO . N.setUrgency u - --- | Sets notification icon from pixbuf -setIconFromPixbuf :: Pixbuf -> Notify () -setIconFromPixbuf p = Notify $ ask >>= liftIO . N.setIconFromPixbuf p - --- | Sets notification image from pixbuf -setImageFromPixbuf :: Pixbuf -> Notify () -setImageFromPixbuf p = Notify $ ask >>= liftIO . N.setImageFromPixbuf p - --- | 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 :: Notify () -removeHints = Notify $ ask >>= liftIO . N.clearHints - --- | Adds action to notification. -addAction :: String -> String -> (Notification -> String -> IO ()) -> Notify () -addAction a l c = Notify $ ask >>= liftIO . N.addAction a l c - --- | Removes actions from notification. -removeActions :: Notify () -removeActions = Notify $ ask >>= liftIO . N.clearActions - -listToMaybe :: [a] -> Maybe [a] -listToMaybe [] = Nothing -listToMaybe xs = Just xs diff --git a/System/Libnotify/Internal.hsc b/System/Libnotify/Internal.hsc deleted file mode 100644 --- a/System/Libnotify/Internal.hsc +++ /dev/null @@ -1,269 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} --- | System.Libnotify.Internal module is low level c-bindings to Libnotify. --- No API stability is guaranteed. -{-# OPTIONS_HADDOCK hide #-} - -#include - -module System.Libnotify.Internal - ( Notification - , initNotify, uninitNotify, isInitted - , newNotify, updateNotify, showNotify - , setTimeout, setCategory, setUrgency - , setIconFromPixbuf, setImageFromPixbuf - , setHintInt32, setHintDouble, setHintString, setHintByte, setHintByteArray, clearHints - , addAction, clearActions, closeNotify - ) where - -import Control.Exception (throw) -import Foreign -import Foreign.C -import Graphics.UI.Gtk.Gdk.Pixbuf -import System.Glib.GError (GError) -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 gerror <- peek p_error - g_error_free p_error - throw gerror - -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) - where getTimeout :: Timeout -> CInt - getTimeout Default = #const NOTIFY_EXPIRES_DEFAULT - getTimeout Infinite = #const NOTIFY_EXPIRES_NEVER - getTimeout (Custom t) = fromIntegral t - -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) - where getUrgency :: Urgency -> CInt - getUrgency Low = #const NOTIFY_URGENCY_LOW - getUrgency Normal = #const NOTIFY_URGENCY_NORMAL - getUrgency Critical = #const NOTIFY_URGENCY_CRITICAL - -foreign import ccall unsafe "libnotify/notify.h notify_notification_set_urgency" - notify_notification_set_urgency :: Notification -> CInt -> IO () - -setIconFromPixbuf :: Pixbuf -> Notification -> IO () -setIconFromPixbuf pixbuf notify = - 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 :: Pixbuf -> Notification -> IO () -setImageFromPixbuf pixbuf notify = - 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 :: String -> Int32 -> Notification -> IO () -setHintInt32 key value notify = - 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 :: String -> Double -> Notification -> IO () -setHintDouble key value notify = - 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 :: 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 - -foreign import ccall unsafe "libnotify/notify.h notify_notification_set_hint_string" - notify_notification_set_hint_string :: Notification - -> CString - -> CString - -> IO () - -setHintByte :: String -> Word8 -> Notification -> IO () -setHintByte key value notify = - 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 :: 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) - 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 - :: String - -> String - -> (Notification -> String -> IO ()) - -> Notification - -> IO () -addAction action label callback notify = - 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 gerror <- peek p_error - g_error_free p_error - throw gerror - -foreign import ccall unsafe "libnotify/notify.h notify_notification_close" - notify_notification_close :: Notification -> Ptr (Ptr GError) -> IO Bool diff --git a/System/Libnotify/Server.hsc b/System/Libnotify/Server.hsc deleted file mode 100644 --- a/System/Libnotify/Server.hsc +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} --- | System.Libnotify.Server module deals with notification server info processing and --- initialized applications managing. -{-# OPTIONS_HADDOCK prune #-} - -#include - -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 () - diff --git a/System/Libnotify/Types.hs b/System/Libnotify/Types.hs deleted file mode 100644 --- a/System/Libnotify/Types.hs +++ /dev/null @@ -1,53 +0,0 @@ --- | 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 diff --git a/example/endless.hs b/example/endless.hs new file mode 100644 --- /dev/null +++ b/example/endless.hs @@ -0,0 +1,37 @@ +#!/usr/bin/env runhaskell + +-- | This little example program shows how to use libnotify action +-- callback together with glib MainLoop thing so they actually work + +import Control.Applicative ((<$)) +import Control.Concurrent (threadDelay) +import Libnotify +import System.Glib.MainLoop (MainLoop, mainLoopNew, mainLoopRun, mainLoopQuit) + +main :: IO () +main = () <$ do + l <- mainLoopNew Nothing False + display $ + summary "Hello!" + <> body "Please, say \"blop\"!" + <> icon "face-embarrassed" + <> timeout Infinite + <> action "blob" "Say \"blop\"" blopCallback + <> action "flop" "Say \"flop\"" (flopCallback l) + mainLoopRun l + +blopCallback :: Notification -> t -> IO Notification +blopCallback n _ = do + close n + putStrLn "Thanks!" + threadDelay second + display (reuse n <> summary "" <> body "Pretty please, say \"blop\"!") + +flopCallback :: MainLoop -> Notification -> t -> IO () +flopCallback l n _ = do + close n + putStrLn "Pfft.." + mainLoopQuit l + +second :: Int +second = 1000000 diff --git a/libnotify.cabal b/libnotify.cabal --- a/libnotify.cabal +++ b/libnotify.cabal @@ -1,24 +1,50 @@ -Name: libnotify -Version: 0.0.2.1 -Description: Usable binding to libnotify library. -License: MIT -License-file: LICENSE -Author: Emon Tsukimiya, Matvey Aksenov -Maintainer: Matvey Aksenov -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 - GHC-Options: -Wall - Extra-Libraries: notify +name: libnotify +version: 0.1.0.0 +synopsis: Bindings to libnotify library +description: + The package provides a high level interface to libnotify API (see "Libnotify") + . + "Libnotify.C.Notify" and "Libnotify.C.NotifyNotification" modules contain + bindings to C-level functions if you're into that +license: MIT +license-file: LICENSE +author: Emon Tsukimiya, Matvey Aksenov +maintainer: Matvey Aksenov +category: System, Desktop +cabal-version: >= 1.10 +build-type: Simple +extra-doc-files: + asset/*.png +extra-source-files: + example/endless.hs + CHANGELOG.md + README.md source-repository head type: git - location: https://github.com/supki/haskell-libnotify + location: https://github.com/supki/libnotify + +source-repository this + type: git + location: https://github.com/supki/libnotify + tag: 0.1.0.0 + +library + default-language: + Haskell2010 + hs-source-dirs: + src + build-depends: + base >= 4.5 && < 5 + , bytestring >= 0.9 + , glib >= 0.12.3 + , gtk >= 0.12.3 + exposed-modules: + Libnotify + Libnotify.C.Notify + Libnotify.C.NotifyNotification + ghc-options: + -Wall + -fno-warn-unused-do-bind + extra-libraries: + notify diff --git a/src/Libnotify.hs b/src/Libnotify.hs new file mode 100644 --- /dev/null +++ b/src/Libnotify.hs @@ -0,0 +1,195 @@ +{-# LANGUAGE FlexibleInstances #-} +-- | High level interface to libnotify API +module Libnotify + ( -- * Notification API + Notification + , display + , display_ + , close + -- * Modifiers + , Mod + , summary + , body + , icon + , timeout + , Timeout(..) + , category + , urgency + , Urgency(..) + , image + , Hint(..) + , nohints + , action + , noactions + , reuse + -- * Convenience re-exports + , Monoid(..), (<>) + ) where + +import Control.Applicative ((<$)) +import Data.ByteString (ByteString) +import Data.Int (Int32) +import Data.Monoid (Monoid(..), (<>), Last(..)) +import Data.Word (Word8) +import Graphics.UI.Gtk.Gdk.Pixbuf (Pixbuf) +import System.Glib.Properties (objectSetPropertyString) + +import Libnotify.C.Notify +import Libnotify.C.NotifyNotification + +{-# ANN module "HLint: ignore Avoid lambda" #-} + + +-- | Notification object +newtype Notification = Notification + { unNotification :: NotifyNotification + } deriving (Show, Eq) + +-- | Display notification +-- +-- >>> token <- display (summary "Greeting" <> body "Hello world!" <> icon "face-smile-big") +-- +-- <> +-- +-- You can 'reuse' notification tokens: +-- +-- >>> display_ (reuse token <> body "Hey!") +-- +-- <> +display :: Mod Notification -> IO Notification +display (Mod m a) = do + notify_init "haskell-libnotify" + n <- maybe (notify_notification_new "" "" "") (return . unNotification) (getLast m) + let y = Notification n + a y + notify_notification_show n + return y + +-- | Display and discard notification token +-- +-- >>> display_ (summary "Greeting" <> body "Hello world!" <> icon "face-smile-big") +display_ :: Mod Notification -> IO () +display_ m = () <$ display m + +-- | Close notification +close :: Notification -> IO () +close n = () <$ do + notify_init "haskell-libnotify" + notify_notification_close (unNotification n) + +-- | A notification modifier +data Mod a = Mod (Last a) (a -> IO ()) + +instance Monoid (Mod a) where + mempty = Mod mempty (\_ -> return ()) + mappend = (<>) + +-- | Set notification summary +-- +-- >>> display_ (summary "Hello!") +-- +-- <> +summary :: String -> Mod Notification +summary t = act (\n -> objectSetPropertyString "summary" n t) + +-- | Set notification body +-- +-- >>> display_ (body "Hello world!") +-- +-- <> +body :: String -> Mod Notification +body t = act (\n -> objectSetPropertyString "body" n t) + +-- | Set notification icon +-- +-- >>> display_ (icon "face-smile") +-- +-- The argument is either icon name or file name +-- +-- <> +icon :: String -> Mod Notification +icon t = act (\n -> objectSetPropertyString "icon-name" n t) + +-- | Set notification timeout +timeout :: Timeout -> Mod Notification +timeout t = act (\n -> notify_notification_set_timeout n t) + +-- | Set notification category +category :: String -> Mod Notification +category t = act (\n -> notify_notification_set_category n t) + +-- | Set notification urgency +urgency :: Urgency -> Mod Notification +urgency t = act (\n -> notify_notification_set_urgency n t) + +-- | Set notification image +image :: Pixbuf -> Mod Notification +image t = act (\n -> notify_notification_set_image_from_pixbuf n t) + +-- | Add a hint to notification +-- +-- It's perfectly OK to add multiple hints to a single notification +class Hint v where + hint :: String -> v -> Mod Notification + +instance Hint Int32 where + hint k v = act (\n -> notify_notification_set_hint_int32 n k v) + +instance Hint Double where + hint k v = act (\n -> notify_notification_set_hint_double n k v) + +instance Hint String where + hint k v = act (\n -> notify_notification_set_hint_string n k v) + +instance Hint Word8 where + hint k v = act (\n -> notify_notification_set_hint_byte n k v) + +instance Hint ByteString where + hint k v = act (\n -> notify_notification_set_hint_byte_array n k v) + +-- | Remove all hints from the notification +nohints :: Mod Notification +nohints = act notify_notification_clear_hints + +-- | Add an action to notification +-- +-- It's perfectly OK to add multiple actions to a single notification +-- +-- >>> display_ (action "hello" "Hello world!" (\_ _ -> return ())) +-- +-- <> +action + :: String -- ^ Name + -> String -- ^ Button label + -> (Notification -> String -> IO a) -- ^ Callback + -> Mod Notification +action a l f = + Mod mempty (\n -> notify_notification_add_action (unNotification n) a l + (\p s' -> () <$ f (Notification p) s')) + +-- | Remove all actions from the notification +-- +-- >>> let callback _ _ = return () +-- >>> display_ (summary "No hello for you!" <> action "hello" "Hello world!" callback <> noactions) +-- +-- <> +noactions :: Mod Notification +noactions = act notify_notification_clear_actions + +-- | Reuse existing notification token, instead of creating a new one +-- +-- If you try to reuse multiple tokens, the last one wins, e.g. +-- +-- >>> foo <- display (body "foo") +-- >>> bar <- display (body "bar") +-- >>> display_ (base foo <> base bar) +-- +-- will show only \"bar\" +-- +-- <> +reuse :: Notification -> Mod Notification +reuse n = Mod (Last (Just n)) (\_ -> return ()) + +-- A helper for making an I/O 'Mod' +act :: (NotifyNotification -> IO ()) -> Mod Notification +act f = Mod mempty (f . unNotification) diff --git a/src/Libnotify/C/Notify.hsc b/src/Libnotify/C/Notify.hsc new file mode 100644 --- /dev/null +++ b/src/Libnotify/C/Notify.hsc @@ -0,0 +1,128 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE NamedFieldPuns #-} +-- | Low level bindings to libnotify +-- +-- See also . Haddocks here +-- are mostly excerpts from there +module Libnotify.C.Notify + ( notify_init + , notify_uninit + , notify_is_initted + , notify_get_app_name + , notify_set_app_name + , notify_get_server_caps + , ServerInfo(..) + , notify_get_server_info + ) where + +#include + +import Data.Data (Typeable, Data) +import GHC.Generics (Generic) +import Foreign +import Foreign.C +import System.Glib.GList (GList, readGList) + +{-# ANN module "HLint: ignore Use camelCase" #-} + +-- | Initialize libnotify +-- +-- This must be called before any other functions +notify_init + :: String -- ^ Application name. Should not be empty! + -> IO Bool +notify_init name = withCString name notify_init_c + +-- | Uninitialize libnotify +notify_uninit :: IO () +notify_uninit = notify_uninit_c + +-- | Get whether libnotify is initialized or not +notify_is_initted :: IO Bool +notify_is_initted = notify_is_initted_c + +-- | Get the application name +-- +-- Do not forget to call 'notify_init' before calling this! +notify_get_app_name :: IO String +notify_get_app_name = notify_get_app_name_c >>= peekCString + +-- | Set the application name +-- +-- Do not forget to call 'notify_init' before calling this! +notify_set_app_name :: String -> IO () +notify_set_app_name name = withCString name notify_set_app_name_c + +-- | Return server capabilities +-- +-- Synchronously queries the server for its capabilities +-- +-- >>> notify_get_server_caps +-- ["actions","body","body-markup","body-hyperlinks","icon-static","x-canonical-private-icon-only"] +notify_get_server_caps :: IO [String] +notify_get_server_caps = do + glist <- notify_get_server_caps_c + p_caps <- readGList glist + caps <- mapM peekCString p_caps + mapM_ free p_caps -- free list elements + g_list_free glist -- free list itself + return caps + +-- | Server information +data ServerInfo = ServerInfo + { name :: String + , vendor :: String + , version :: String + , specVersion :: String + } deriving (Show, Eq, Typeable, Data, Generic) + +-- | Return server information +-- +-- Synchronously queries the server for its information, specifically, +-- the name, vendor, server version, and the version of the notifications +-- specification that it is compliant with +-- +-- >>> notify_get_server_info +-- Just (ServerInfo {name = "Xfce Notify Daemon", vendor = "Xfce", version = "0.2.4", specVersion = "0.9"}) +notify_get_server_info :: IO (Maybe ServerInfo) +notify_get_server_info = + alloca $ \p_name -> + alloca $ \p_vendor -> + alloca $ \p_version -> + alloca $ \p_specVersion -> do + ret <- notify_get_server_info_c p_name p_vendor p_version p_specVersion + if ret + then do + name <- peekCString =<< peek p_name + vendor <- peekCString =<< peek p_vendor + version <- peekCString =<< peek p_version + specVersion <- peekCString =<< peek p_specVersion + return $ Just ServerInfo { name, vendor, version, specVersion } + else + return Nothing + +foreign import ccall safe "libnotify/notify.h notify_init" + notify_init_c :: CString -> IO Bool + +foreign import ccall safe "libnotify/notify.h notify_uninit" + notify_uninit_c :: IO () + +foreign import ccall safe "libnotify/notify.h notify_is_initted" + notify_is_initted_c :: IO Bool + +foreign import ccall safe "libnotify/notify.h notify_get_app_name" + notify_get_app_name_c :: IO CString + +foreign import ccall safe "libnotify/notify.h notify_set_app_name" + notify_set_app_name_c :: CString -> IO () + +foreign import ccall safe "libnotify/notify.h notify_get_server_caps" + notify_get_server_caps_c :: IO GList + +foreign import ccall safe "libnotify/notify.h notify_get_server_info" + notify_get_server_info_c :: Ptr CString -> Ptr CString -> Ptr CString -> Ptr CString -> IO Bool + +foreign import ccall safe "g_list_free" + g_list_free :: GList -> IO () diff --git a/src/Libnotify/C/NotifyNotification.hsc b/src/Libnotify/C/NotifyNotification.hsc new file mode 100644 --- /dev/null +++ b/src/Libnotify/C/NotifyNotification.hsc @@ -0,0 +1,337 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ForeignFunctionInterface #-} +-- | Low level bindings to libnotify +-- +-- See also . Haddocks here +-- are mostly excerpts from there +module Libnotify.C.NotifyNotification + ( NotifyNotification + , notify_notification_new + , notify_notification_update + , notify_notification_show + , notify_notification_set_app_name + , Timeout(..) + , notify_notification_set_timeout + , notify_notification_set_category + , Urgency(..) + , notify_notification_set_urgency + , notify_notification_set_icon_from_pixbuf + , notify_notification_set_image_from_pixbuf + , notify_notification_set_hint_int32 + , notify_notification_set_hint_uint32 + , notify_notification_set_hint_double + , notify_notification_set_hint_string + , notify_notification_set_hint_byte + , notify_notification_set_hint_byte_array + , notify_notification_clear_hints + , notify_notification_add_action + , notify_notification_clear_actions + , notify_notification_close + , notify_notification_get_closed_reason + ) where + +#include + +import Control.Exception (throwIO) +import Data.Data (Typeable, Data) +import GHC.Generics (Generic) +import Foreign +import Foreign.C +import Graphics.UI.Gtk.Gdk.Pixbuf (Pixbuf) +import System.Glib.GError (GError) +import System.Glib.GObject (GObjectClass(..), GObject(..), unGObject, wrapNewGObject, objectUnref) +import Unsafe.Coerce (unsafeCoerce) +import qualified Data.ByteString as BS + +-- | An opaque notification token +newtype NotifyNotification = NotifyNotification (ForeignPtr NotifyNotification) + deriving (Show, Eq) + +instance GObjectClass NotifyNotification where + toGObject (NotifyNotification p) = GObject (castForeignPtr p) + unsafeCastGObject = NotifyNotification . castForeignPtr . unGObject + +-- | Create a new 'NotifyNotification' +-- +-- Only summary is required +notify_notification_new + :: String -- ^ Summary + -> String -- ^ Body + -> String -- ^ Icon (icon name or file name) + -> IO NotifyNotification +notify_notification_new summary body icon = + withCString summary $ \p_summary -> + withCString body $ \p_body -> + withCString icon $ \p_icon -> + wrapNewGObject (NotifyNotification, objectUnref) $ + notify_notification_new_c p_summary p_body p_icon + + +-- | Update the notification text and icon +notify_notification_update + :: NotifyNotification + -> String -- ^ Summary + -> String -- ^ Body + -> String -- ^ Icon (icon name or file name) + -> IO Bool +notify_notification_update (NotifyNotification notify) summary body icon = + withCString summary $ \p_summary -> + withCString body $ \p_body -> + withCString icon $ \p_icon -> + withForeignPtr notify $ \p_notify -> + notify_notification_update_c p_notify p_summary p_body p_icon + +-- | Display the notification on the screen +notify_notification_show :: NotifyNotification -> IO Bool +notify_notification_show (NotifyNotification notify) = + withForeignPtr notify $ \p_notify -> + alloca $ \pp_error -> do + poke pp_error nullPtr + result <- notify_notification_show_c p_notify pp_error + p_error <- peek pp_error + if p_error == nullPtr + then + return result + else do + gerror <- peek p_error + g_error_free p_error + throwIO gerror + +-- | Set the application name for the notification +-- +-- Used to override an application name for a specific notification. +-- See also 'notify_init' and 'notify_set_app_name' +notify_notification_set_app_name :: NotifyNotification -> String -> IO () +notify_notification_set_app_name (NotifyNotification notify) name = + withForeignPtr notify $ \p_notify -> + withCString name $ \p_name -> + notify_notification_set_app_name_c p_notify p_name + +-- | Timeout after which notification is closed +data Timeout = + Default -- ^ Default server timeout + | Custom Int -- ^ User defined timeout (in milliseconds) + | Infinite -- ^ Notification will never expire + deriving (Show, Eq, Typeable, Data, Generic) + +-- | Set the timeout of the notification +notify_notification_set_timeout :: NotifyNotification -> Timeout -> IO () +notify_notification_set_timeout (NotifyNotification notify) timeout = + withForeignPtr notify $ \p_notify -> + notify_notification_set_timeout_c p_notify $ case timeout of + Default -> #const NOTIFY_EXPIRES_DEFAULT + Infinite -> #const NOTIFY_EXPIRES_NEVER + Custom t -> fromIntegral t + +-- | Set the category of the notification +notify_notification_set_category :: NotifyNotification -> String -> IO () +notify_notification_set_category (NotifyNotification notify) category = + withForeignPtr notify $ \p_notify -> + withCString category $ \p_category -> + notify_notification_set_category_c p_notify p_category + +-- | The urgency level of the notification +data Urgency = + Low -- ^ Low urgency. Used for unimportant notifications + | Normal -- ^ Normal urgency. Used for most standard notifications + | Critical -- ^ Critical urgency. Used for very important notifications + deriving (Show, Eq, Ord, Typeable, Data, Generic) + +-- | Set the urgency level of the notification +notify_notification_set_urgency :: NotifyNotification -> Urgency -> IO () +notify_notification_set_urgency (NotifyNotification notify) urgency = + withForeignPtr notify $ \p_notify -> + notify_notification_set_urgency_c p_notify $ case urgency of + Low -> #const NOTIFY_URGENCY_LOW + Normal -> #const NOTIFY_URGENCY_NORMAL + Critical -> #const NOTIFY_URGENCY_CRITICAL + +-- | Set the icon in the notification from the 'Pixbuf' +notify_notification_set_icon_from_pixbuf :: NotifyNotification -> Pixbuf -> IO () +notify_notification_set_icon_from_pixbuf (NotifyNotification notify) pixbuf = + withForeignPtr notify $ \p_notify -> + withForeignPtr (unsafeCoerce pixbuf) $ \p_pixbuf -> + notify_notification_set_icon_from_pixbuf_c p_notify p_pixbuf +{-# DEPRECATED notify_notification_set_icon_from_pixbuf + "Use notify_notification_set_image_from_pixbuf instead" #-} + +-- | Set the icon in the notification from the 'Pixbuf' +notify_notification_set_image_from_pixbuf :: NotifyNotification -> Pixbuf -> IO () +notify_notification_set_image_from_pixbuf (NotifyNotification notify) pixbuf = + withForeignPtr notify $ \p_notify -> + withForeignPtr (unsafeCoerce pixbuf) $ \p_pixbuf -> + notify_notification_set_image_from_pixbuf_c p_notify p_pixbuf + +-- | Set a hint with a 32-bit integer value +notify_notification_set_hint_int32 :: NotifyNotification -> String -> Int32 -> IO () +notify_notification_set_hint_int32 (NotifyNotification notify) key value = + withForeignPtr notify $ \p_notify -> + withCString key $ \p_key -> + notify_notification_set_hint_int32_c p_notify p_key (fromIntegral value) + +-- | Set a hint with an unsigned 32-bit integer value +notify_notification_set_hint_uint32 :: NotifyNotification -> String -> Word32 -> IO () +notify_notification_set_hint_uint32 (NotifyNotification notify) key value = + withForeignPtr notify $ \p_notify -> + withCString key $ \p_key -> + notify_notification_set_hint_uint32_c p_notify p_key (fromIntegral value) + +-- | Set a hint with a double value +notify_notification_set_hint_double :: NotifyNotification -> String -> Double -> IO () +notify_notification_set_hint_double (NotifyNotification notify) key value = + withForeignPtr notify $ \p_notify -> + withCString key $ \p_key -> + notify_notification_set_hint_double_c p_notify p_key (realToFrac value) + +-- | Set a hint with a string value +notify_notification_set_hint_string :: NotifyNotification -> String -> String -> IO () +notify_notification_set_hint_string (NotifyNotification notify) key value = + withForeignPtr notify $ \p_notify -> + withCString key $ \p_key -> + withCString value $ \p_value -> + notify_notification_set_hint_string_c p_notify p_key p_value + +-- | Set a hint with a byte value +notify_notification_set_hint_byte :: NotifyNotification -> String -> Word8 -> IO () +notify_notification_set_hint_byte (NotifyNotification notify) key value = + withForeignPtr notify $ \p_notify -> + withCString key $ \p_key -> + notify_notification_set_hint_byte_c p_notify p_key (fromIntegral value) + +-- | Set a hint with a byte array value +notify_notification_set_hint_byte_array :: NotifyNotification -> String -> BS.ByteString -> IO () +notify_notification_set_hint_byte_array (NotifyNotification notify) key value = + withForeignPtr notify $ \p_notify -> + withCString key $ \p_key -> + withArrayLen (BS.foldr' step [] value) $ \len p_bs -> + notify_notification_set_hint_byte_array_c p_notify p_key p_bs (fromIntegral len) + where + step x xs = fromIntegral x:xs + +-- | Clear all hints +notify_notification_clear_hints :: NotifyNotification -> IO () +notify_notification_clear_hints (NotifyNotification notify) = + withForeignPtr notify notify_notification_clear_hints_c + +type NotifyActionCallback a = Ptr NotifyNotification -> CString -> Ptr a -> IO () + +-- | Add an action to a notification. When the action is invoked, the specified callback +-- function will be called +-- +-- For the callback to be *actually* invoked, some kind of magical glib @mainLoop@ thing +-- should be running +notify_notification_add_action + :: NotifyNotification + -> String + -> String + -> (NotifyNotification -> String -> IO ()) + -> IO () +notify_notification_add_action (NotifyNotification notify) action label callback = + withForeignPtr notify $ \p_notify -> + withCString action $ \p_action -> + withCString label $ \p_label -> do + p_callback <- wrapActionCallback $ \p_notify' p_action' _ -> do + action' <- peekCString p_action' + fp_notify' <- newForeignPtr_ p_notify' + callback (NotifyNotification fp_notify') action' + notify_notification_add_action_c p_notify p_action p_label p_callback nullPtr nullFunPtr + +-- | Clear all actions +notify_notification_clear_actions :: NotifyNotification -> IO () +notify_notification_clear_actions (NotifyNotification notify) = + withForeignPtr notify notify_notification_clear_actions_c + +-- | Hide the notification from the screen +notify_notification_close :: NotifyNotification -> IO Bool +notify_notification_close (NotifyNotification notify) = + withForeignPtr notify $ \p_notify -> + alloca $ \pp_error -> do + poke pp_error nullPtr + result <- notify_notification_close_c p_notify pp_error + p_error <- peek pp_error + if p_error == nullPtr + then + return result + else do + gerror <- peek p_error + g_error_free p_error + throwIO gerror + +-- | Get the closed reason code for the notification +notify_notification_get_closed_reason :: NotifyNotification -> IO Int +notify_notification_get_closed_reason (NotifyNotification notify) = + withForeignPtr notify notify_notification_get_closed_reason_c + +foreign import ccall safe "libnotify/notify.h notify_notification_new" + notify_notification_new_c :: CString -> CString -> CString -> IO (Ptr NotifyNotification) + +foreign import ccall safe "libnotify/notify.h notify_notification_update" + notify_notification_update_c :: Ptr NotifyNotification -> CString -> CString -> CString -> IO Bool + +foreign import ccall safe "libnotify/notify.h notify_notification_show" + notify_notification_show_c :: Ptr NotifyNotification -> Ptr (Ptr GError) -> IO Bool + +foreign import ccall safe "libnotify/notify.h notify_notification_set_app_name" + notify_notification_set_app_name_c :: Ptr NotifyNotification -> CString -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_set_timeout" + notify_notification_set_timeout_c :: Ptr NotifyNotification -> CInt -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_set_category" + notify_notification_set_category_c :: Ptr NotifyNotification -> CString -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_set_urgency" + notify_notification_set_urgency_c :: Ptr NotifyNotification -> CInt -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_set_icon_from_pixbuf" + notify_notification_set_icon_from_pixbuf_c :: Ptr NotifyNotification -> Ptr Pixbuf -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_set_image_from_pixbuf" + notify_notification_set_image_from_pixbuf_c :: Ptr NotifyNotification -> Ptr Pixbuf -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_set_hint_int32" + notify_notification_set_hint_int32_c :: Ptr NotifyNotification -> CString -> CInt -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_set_hint_uint32" + notify_notification_set_hint_uint32_c :: Ptr NotifyNotification -> CString -> CUInt -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_set_hint_double" + notify_notification_set_hint_double_c :: Ptr NotifyNotification -> CString -> CDouble -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_set_hint_string" + notify_notification_set_hint_string_c :: Ptr NotifyNotification -> CString -> CString -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_set_hint_byte" + notify_notification_set_hint_byte_c :: Ptr NotifyNotification -> CString -> CUChar -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_set_hint_byte_array" + notify_notification_set_hint_byte_array_c :: Ptr NotifyNotification -> CString -> Ptr CUChar -> CSize -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_clear_hints" + notify_notification_clear_hints_c :: Ptr NotifyNotification -> IO () + +foreign import ccall safe "wrapper" + wrapActionCallback :: NotifyActionCallback a -> IO (FunPtr (NotifyActionCallback a)) + +foreign import ccall safe "libnotify/notify.h notify_notification_add_action" + notify_notification_add_action_c + :: Ptr NotifyNotification + -> CString + -> CString + -> FunPtr (NotifyActionCallback a) + -> Ptr a + -> FunPtr (Ptr a -> IO ()) + -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_clear_actions" + notify_notification_clear_actions_c :: Ptr NotifyNotification -> IO () + +foreign import ccall safe "libnotify/notify.h notify_notification_close" + notify_notification_close_c :: Ptr NotifyNotification -> Ptr (Ptr GError) -> IO Bool + +foreign import ccall safe "libnotify/notify.h notify_notification_get_closed_reason" + notify_notification_get_closed_reason_c :: Ptr NotifyNotification -> IO Int + +foreign import ccall safe "glib-object.h g_error_free" + g_error_free :: Ptr GError -> IO ()