packages feed

libnotify 0.0.2.1 → 0.1.0.0

raw patch · 12 files changed

+762/−549 lines, 12 filesdep −mtldep ~basedep ~bytestringdep ~glib

Dependencies removed: mtl

Dependency ranges changed: base, bytestring, glib, gtk

Files

+ CHANGELOG.md view
@@ -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
LICENSE view
@@ -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
+ README.md view
@@ -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!
− System/Libnotify.hs 
@@ -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
− System/Libnotify/Internal.hsc 
@@ -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 <libnotify/notify.h>--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
− System/Libnotify/Server.hsc 
@@ -1,75 +0,0 @@-{-# 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.hs 
@@ -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
+ example/endless.hs view
@@ -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
libnotify.cabal view
@@ -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 <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-  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 <matvey.aksenov@gmail.com>+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
+ src/Libnotify.hs view
@@ -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")+--+-- <<asset/HelloWorld.png>>+--+-- You can 'reuse' notification tokens:+--+-- >>> display_ (reuse token <> body "Hey!")+--+-- <<asset/Hey.png>>+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!")+--+-- <<asset/summary.png>>+summary :: String -> Mod Notification+summary t = act (\n -> objectSetPropertyString "summary" n t)++-- | Set notification body+--+-- >>> display_ (body "Hello world!")+--+-- <<asset/body.png>>+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+--+-- <<asset/icon.png>>+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 ()))+--+-- <<asset/action.png>>+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)+--+-- <<asset/noactions.png>>+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\"+--+-- <<asset/reuse.png>>+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)
+ src/Libnotify/C/Notify.hsc view
@@ -0,0 +1,128 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE NamedFieldPuns #-}+-- | Low level bindings to libnotify+--+-- See also <https://developer.gnome.org/libnotify/0.7/libnotify-notify.html>. 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 <libnotify/notify.h>++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 ()
+ src/Libnotify/C/NotifyNotification.hsc view
@@ -0,0 +1,337 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-- | Low level bindings to libnotify+--+-- See also <https://developer.gnome.org/libnotify/0.7/NotifyNotification.html>. 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 <libnotify/notify.h>++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 ()