libnotify 0.1.1.0 → 0.2
raw patch · 5 files changed
+148/−31 lines, 5 files
Files
- CHANGELOG.md +7/−0
- example/notify-send.hs +95/−0
- libnotify.cabal +3/−3
- src/Libnotify.hs +33/−19
- src/Libnotify/C/Notify.hsc +10/−9
CHANGELOG.md view
@@ -1,3 +1,10 @@+0.2+===++ * Added `appName`, a way to provide a custom application name for a notification.++ * Renamed `ServerInfo` record accessors, so that they are less likely to conflict with other definitions.+ 0.1.1.0 =======
+ example/notify-send.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+module Main (main) where++import Data.Bool (bool)+import Data.Int (Int32)+import Data.Maybe (catMaybes)+import Data.Word (Word8)+import qualified Libnotify as L+import Options.Applicative+import Prelude hiding (mod)+import Text.Printf (printf)+import Text.Read (readEither)+++main :: IO ()+main = do+ Options {summary, body, mod} <- parseOpts+ L.display_ (mod <> L.summary summary <> foldMap L.body body)++data Options = Options+ { summary :: String+ , body :: Maybe String+ , mod :: L.Mod L.Notification+ }++parseOpts :: IO Options+parseOpts =+ customExecParser (prefs showHelpOnError) (info (helper <*> parser) desc)+ where+ desc =+ fullDesc <> progDesc "Create a notification." <> header "notify-send - an example of the libnotify library"+ parser = do+ summary <- argument str (metavar "SUMMARY")+ body <- optional (argument str (metavar "BODY"))+ mod <- parserMod+ pure Options {..}+ parserMod =+ fmap (mconcat . catMaybes) . traverse optional $+ [ option urgency (short 'u' <> long "urgency" <> metavar "LEVEL")+ , option timeout (short 't' <> long "timeout" <> metavar "TIME")+ , option appName (short 'a' <> long "app-name" <> metavar "APP_NAME")+ , option icon (short 'i' <> long "icon" <> metavar "ICON")+ , option category (short 'c' <> long "category" <> metavar "TIME")+ , option hint (short 'h' <> long "hint" <> metavar "TYPE:NAME:VALUE")+ ]+ urgency =+ eitherReader $ \case+ "low" ->+ pure (L.urgency L.Low)+ "normal" ->+ pure (L.urgency L.Normal)+ "critical" ->+ pure (L.urgency L.Critical)+ urg ->+ Left (printf "Unknown urgency `%s'. Known urgencies: `low', `normal', and `critical'." urg)+ timeout = do+ time <- auto+ pure (L.timeout (bool (L.Custom time) L.Infinite (time == 0)))+ appName = do+ name <- str+ pure (L.appName name)+ icon = do+ name <- str+ pure (L.icon name)+ category = do+ cat <- str+ pure (L.category cat)+ hint :: ReadM (L.Mod L.Notification)+ hint =+ eitherReader $ \typeNameVal ->+ case break (== ':') typeNameVal of+ (type_, ':' : nameVal) ->+ case break (== ':') nameVal of+ (name, ':' : val) ->+ case type_ of+ "int" -> do+ int <- readEither val+ pure (L.hint name (int :: Int32))+ "double" -> do+ double <- readEither val+ pure (L.hint name (double :: Double))+ "string" ->+ pure (L.hint name val)+ "byte" -> do+ byte <- readEither val+ pure (L.hint name (byte :: Word8))+ _ ->+ Left (printf "Invalid hint: `%s`" typeNameVal)+ _ ->+ Left (printf "Invalid hint: `%s`" typeNameVal)+ _ ->+ Left (printf "Invalid hint: `%s`" typeNameVal)
libnotify.cabal view
@@ -1,5 +1,5 @@ name: libnotify-version: 0.1.1.0+version: 0.2 synopsis: Bindings to libnotify library description: The package provides a high level interface to libnotify API (see "Libnotify")@@ -17,6 +17,7 @@ asset/*.png extra-source-files: example/endless.hs+ example/notify-send.hs CHANGELOG.md README.md @@ -27,7 +28,7 @@ source-repository this type: git location: https://github.com/supki/libnotify- tag: 0.1.1.0+ tag: 0.2 library default-language:@@ -45,6 +46,5 @@ Libnotify.C.NotifyNotification ghc-options: -Wall- -fno-warn-unused-do-bind extra-libraries: notify
src/Libnotify.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-} -- | High level interface to libnotify API module Libnotify ( -- * Notification API@@ -21,6 +22,7 @@ , nohints , action , noactions+ , appName , reuse -- * Convenience re-exports , Monoid(..), (<>)@@ -29,6 +31,7 @@ import Control.Applicative ((<$)) import Data.ByteString (ByteString) import Data.Int (Int32)+import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(..), (<>), Last(..)) import Data.Word (Word8) import Graphics.UI.Gtk.Gdk.Pixbuf (Pixbuf)@@ -41,8 +44,9 @@ -- | Notification object-newtype Notification = Notification- { unNotification :: NotifyNotification+data Notification = Notification+ { token :: !NotifyNotification+ , name :: !String } deriving (Show, Eq) -- | Display notification@@ -57,13 +61,13 @@ -- -- <<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 (Mod (Last reusedToken) (Last named) acts) = do+ let name = fromMaybe defaultAppName named+ _ <- notify_init name+ token <- maybe (notify_notification_new "" "" "") return reusedToken+ acts token name+ _ <- notify_notification_show token+ return Notification {token, name} -- | Display and discard notification token --@@ -73,16 +77,18 @@ -- | Close notification close :: Notification -> IO ()-close n = () <$ do- notify_init "haskell-libnotify"- notify_notification_close (unNotification n)+close Notification {name, token} = () <$ do+ _ <- notify_init name+ notify_notification_close token -- | A notification modifier-data Mod a = Mod (Last a) (a -> IO ())+data Mod a = -- the unused type parameter cannot be removed without breaking backward compatibility+ Mod (Last NotifyNotification) (Last String) (NotifyNotification -> String -> IO ()) instance Monoid (Mod a) where- mempty = Mod mempty (\_ -> return ())- mappend (Mod x fx) (Mod y fy) = Mod (x <> y) (\n -> fx n >> fy n)+ mempty = Mod mempty mempty (\_ _ -> return ())+ mappend (Mod u x fx) (Mod v y fy) =+ Mod (u <> v) (x <> y) (\token name -> fx token name >> fy token name) -- | Set notification summary --@@ -164,8 +170,8 @@ -> (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'))+ Mod mempty mempty+ (\token name -> notify_notification_add_action token a l (\p s' -> () <$ f (Notification p name) s')) -- | Remove all actions from the notification --@@ -176,6 +182,10 @@ noactions :: Mod Notification noactions = act notify_notification_clear_actions +-- | Set the application name.+appName :: String -> Mod Notification+appName name = Mod mempty (Last (Just name)) (\_ _ -> return ())+ -- | Reuse existing notification token, instead of creating a new one -- -- If you try to reuse multiple tokens, the last one wins, e.g.@@ -188,8 +198,12 @@ -- -- <<asset/reuse.png>> reuse :: Notification -> Mod Notification-reuse n = Mod (Last (Just n)) (\_ -> return ())+reuse Notification {token, name} = Mod (Last (Just token)) (Last (Just name)) (\_ _ -> return ()) -- A helper for making an I/O 'Mod' act :: (NotifyNotification -> IO ()) -> Mod Notification-act f = Mod mempty (f . unNotification)+act f = Mod mempty mempty (\token _name -> f token)++-- The default application name used unless the user specifies the preferred one with 'appName'.+defaultAppName :: String+defaultAppName = "haskell-libnotify"
src/Libnotify/C/Notify.hsc view
@@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-} -- | Low level bindings to libnotify -- -- See also <https://developer.gnome.org/libnotify/0.7/libnotify-notify.html>. Haddocks here@@ -72,10 +73,10 @@ -- | Server information data ServerInfo = ServerInfo- { name :: String- , vendor :: String- , version :: String- , specVersion :: String+ { serverName :: String+ , serverVendor :: String+ , serverVersion :: String+ , serverSpecVersion :: String } deriving (Show, Eq, Typeable, Data, Generic) -- | Return server information@@ -95,11 +96,11 @@ 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 }+ serverName <- peekCString =<< peek p_name+ serverVendor <- peekCString =<< peek p_vendor+ serverVersion <- peekCString =<< peek p_version+ serverSpecVersion <- peekCString =<< peek p_specVersion+ return $ Just ServerInfo {..} else return Nothing