fdo-notify (empty) → 0.1
raw patch · 5 files changed
+310/−0 lines, 5 filesdep +basedep +dbus-clientdep +dbus-coresetup-changed
Dependencies added: base, dbus-client, dbus-core
Files
- DBus/Notify.hs +243/−0
- LICENSE +27/−0
- Setup.hs +2/−0
- examples/fib.hs +16/−0
- fdo-notify.cabal +22/−0
+ DBus/Notify.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE OverloadedStrings #-}+-- |A library for issuing notifications using FreeDesktop.org Desktop+-- Notifications protocol. This protocol is used to communicate with services+-- such as Ubuntu's NotifyOSD.+--+-- This library does not yet support receiving events relating to notifications,+-- or images in notifications: if you need that functionality please contact the maintainer.+module DBus.Notify + (+ -- * Usage+ -- $usage++ -- * Displaying notifications+ notify+ , replace+ , mkSessionClient+ , Client+ -- * Constructing notifications+ , blankNote+ , Note (..)+ , Body (..)+ , URL+ , Timeout (..)+ , Action (..)+ , Image+ , Category (..)+ , UrgencyLevel (..)+ , Hint (..)+ -- * Handles to displayed notifications+ , Notification+ ) where++import DBus.Message+import DBus.Client+import DBus.Bus+import DBus.Types+import Control.Applicative+import Data.Maybe (fromMaybe, fromJust)+import Data.Int+import Data.Word+import Data.Char (isLower, toLower)+import Control.Arrow (first, second, (***))++-- $usage+-- A DBUS 'Client' is needed to display notifications, so the first step is to+-- create one. The notification service will usually run on the session bus (the DBUS+-- instance responsible for messages within a desktop session) so you can use+-- 'mkSessionClient' to create the client.+--+-- To display a notification, first construct a 'Note'. This can be done in pure+-- code. Notifications can have actions, categories, etc. associated to them but+-- we will just show a simple example (these features are not supported by all+-- notification services anyway).+--+-- Use the function 'notify' to display a 'Note'. This returns a handle which+-- can be passed to 'replace' to replace a notification.+--+-- @+--import DBus.Notify+--+--main = do+-- client <- mkSessionClient+-- let startNote = appNote { summary=\"Starting\"+-- , body=(Just $ Text \"Calculating fib(33).\") }+-- notification <- notify client startNote+-- let endNote = appNote { summary=\"Finished\"+-- , body=(Just . Text . show $ fib33) }+-- fib33 \`seq\` replace client notification endNote+-- where+-- appNote = blankNote { appName=\"Fibonacci Demonstration\" }+-- fib 0 = 0+-- fib 1 = 1+-- fib n = fib (n-1) + fib (n-2)+-- fib33 = fib 33+-- @++-- |Create a 'Client' connected to the session bus.+-- Note that this opens a socket and spawns a thread,+-- so it's best to reuse a single client.+mkSessionClient :: IO Client+mkSessionClient = mkClient getSessionBus++-- |A 'Note' with default values.+-- All fields are blank except for 'expiry', which is 'Dependent'.+blankNote :: Note+blankNote = Note { appName=""+ , appImage=Nothing+ , summary=""+ , body=Nothing+ , actions=[]+ , hints=[]+ , expiry=Dependent+ }++proxy = Proxy (RemoteObject busname path) iface+ where+ busname = mkBusName' "org.freedesktop.Notifications"+ path = mkObjectPath' "/org/freedesktop/Notifications"+ iface = mkInterfaceName' "org.freedesktop.Notifications"++-- |Contents of a notification+data Note = Note { appName :: String+ , appImage :: Maybe Image+ , summary :: String+ , body :: Maybe Body+ , actions :: [(Action, String)]+ , hints :: [Hint]+ , expiry :: Timeout+ }+ deriving (Eq, Show)++-- |Message bodies may contain simple markup.+-- NotifyOSD doesn't support any markup.+data Body = Text String+ | Bold Body+ | Italic Body+ | Underline Body+ | Hyperlink URL Body+ | Img URL String+ | Concat Body Body+ deriving (Eq, Show)++type URL = String++-- |Length of time to display notifications. NotifyOSD seems to ignore these.+data Timeout = Never -- ^Wait to be dismissed by user+ | Dependent -- ^Let the notification service decide+ | Milliseconds Int32 -- ^Show notification for a fixed duration+ -- (must be positive)+ deriving (Eq, Show)++newtype Action = Action { actionName :: String }+ deriving (Eq, Show)++-- |Images are not yet supported+newtype Image = Image { bitmap :: String }+ deriving (Eq, Show)++-- |Urgency of the notification. Notifications may be prioritised by urgency.+data UrgencyLevel = Low+ | Normal+ | Critical -- ^Critical notifications require user attention+ deriving (Eq, Ord, Enum, Show)++-- |Various hints about how the notification should be displayed+data Hint = Urgency UrgencyLevel+ | Category Category+ -- DesktopEntry ApplicationDesktopID+ | ImageData Image+ | SoundFile FilePath+ | SuppressSound Bool+ | X Int32+ | Y Int32+ deriving (Eq, Show)++-- |Categorisation of (some) notifications+data Category = Device | DeviceAdded | DeviceError | DeviceRemoved+ | Email | EmailArrived | EmailBounced+ | Im | ImError | ImReceived+ | Network | NetworkConnected | NetworkDisconnected | NetworkError + | Presence | PresenceOffline | PresenceOnline+ | Transfer | TransferComplete | TransferError+ deriving (Eq, Show)++notifyArgs :: Note -> Word32 -> [Variant]+notifyArgs note replaceId = map ($ note) args+ where+ args = [ toVariant . appName+ , const $ toVariant (replaceId::Word32)+ , toVariant . fromMaybe "" .fmap bitmap . appImage+ , toVariant . summary+ , toVariant . fromMaybe "" . fmap flattenBody . body+ , toVariant . actionsArray . actions+ , toVariant . hintsDict . hints+ , toVariant . timeoutInt . expiry+ ]++data ClosedReason = Expired | Dismissed | CloseNotificationCalled+data NotificationEvent = ActionInvoked Action | Closed ClosedReason++-- |A handle on a displayed notification+-- The notification may not have reached the screen yet, and may already have+-- been closed.+data Notification = Notification { notificationId :: Word32 }++-- |Display a notification.+-- Return a handle which can be used to replace the notification.+notify :: Client -> Note -> IO Notification+notify cl = replace cl (Notification { notificationId=0 })++-- |Replace an existing notification.+-- If the notification has already been closed, a new one will be created.+replace :: Client -> Notification -> Note -> IO Notification+replace cl (Notification { notificationId=replaceId }) note =+ Notification . fromJust . fromVariant . head . methodReturnBody <$>+ callBlocking cl proxy (mkMemberName' "Notify") [] (notifyArgs note replaceId)++timeoutInt :: Timeout -> Int32+timeoutInt Never = 0+timeoutInt Dependent = -1+timeoutInt (Milliseconds n) + | n > 0 = n+ | otherwise = error "notification timeout not positive"++flattenBody :: Body -> String+flattenBody (Text s) = concatMap escape s+ where+ escape '>' = ">"+ escape '<' = "<"+ escape '&' = "&"+ escape x = [x]++flattenBody (Bold b) = "<b>" ++ flattenBody b ++ "</b>"+flattenBody (Italic b) = "<i>" ++ flattenBody b ++ "</i>"+flattenBody (Underline b) = "<u>" ++ flattenBody b ++ "</u>"+flattenBody (Hyperlink h b) = "<a href=\"" ++ h ++ "\">" ++ flattenBody b ++ "</a>"+flattenBody (Img h alt) = "<img src=\"" ++ h ++ "\" alt=\"" ++ alt ++ "\"/>"+flattenBody (Concat b1 b2) = flattenBody b1 ++ flattenBody b2++actionsArray :: [(Action, String)] -> Array+actionsArray = fromJust . arrayFromItems DBusString . concatMap pairList+ where+ pairList (a, b) = [toVariant $ actionName a, toVariant $ b]++hintsDict :: [Hint] -> Dictionary+hintsDict = fromJust . dictionaryFromItems DBusString DBusVariant+ . map ((toVariant *** toVariant) . hint)+ where+ hint :: Hint -> (String, Variant)+ hint (Urgency u) = ("urgency", toVariant (fromIntegral $ fromEnum u :: Word8))+ hint (Category c) = ("category", toVariant $ catName c)+ hint (ImageData i) = ("image_data", toVariant $ bitmap i)+ hint (SoundFile s) = ("sound-file", toVariant s)+ hint (SuppressSound b) = ("suppress-sound", toVariant b)+ hint (X x) = ("x", toVariant x)+ hint (Y y) = ("x", toVariant y)++-- HACK: Assumes the constructor for category foo.bar.baz is FooBarBaz and+-- categories have no capital letters+catName :: Category -> String+catName c = catName' (show c)+ where+ catName' (c:cs) = map toLower $ c: (uncurry (++) . second ('.':) . span isLower $ cs)
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2009, Max Rabkin++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/fib.hs view
@@ -0,0 +1,16 @@+import DBus.Notify++main = do+ client <- mkSessionClient+ let startNote = appNote { summary="Starting"+ , body=(Just $ Text "Calculating fib(33).") }+ notification <- notify client startNote+ let endNote = appNote { summary="Finished"+ , body=(Just . Text . show $ fib33) }+ fib33 `seq` replace client notification endNote+ where+ appNote = blankNote { appName="Fibonacci Demonstration" }+ fib 0 = 0+ fib 1 = 1+ fib n = fib (n-1) + fib (n-2)+ fib33 = fib 33
+ fdo-notify.cabal view
@@ -0,0 +1,22 @@+name: fdo-notify+version: 0.1+synopsis: Desktop Notifications client+description:+ A library for issuing notifications using FreeDesktop.org's Desktop+ Notifications protcol. This protocol is supported by services such+ as Ubuntu's NotifyOSD.+category: Desktop+license: BSD3+license-file: LICENSE+author: Max Rabkin+maintainer: max.rabkin@gmail.com+cabal-version: >= 1.2.1+build-type: Simple++extra-source-files:+ examples/fib.hs++library+ build-depends: base >= 3 && < 5, dbus-core >= 0.5 && < 0.6, dbus-client >= 0.1 && < 0.2++ exposed-modules: DBus.Notify