fdo-notify 0.1 → 0.2
raw patch · 5 files changed
+57/−30 lines, 5 filesdep ~dbus-clientdep ~dbus-coresetup-changed
Dependency ranges changed: dbus-client, dbus-core
Files
- DBus/Notify.hs +47/−25
- LICENSE +1/−1
- Setup.hs +0/−2
- Setup.lhs +3/−0
- fdo-notify.cabal +6/−2
DBus/Notify.hs view
@@ -5,7 +5,7 @@ -- -- 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 +module DBus.Notify ( -- * Usage -- $usage@@ -13,6 +13,7 @@ -- * Displaying notifications notify , replace+ , Notification , mkSessionClient , Client -- * Constructing notifications@@ -26,8 +27,9 @@ , Category (..) , UrgencyLevel (..) , Hint (..)- -- * Handles to displayed notifications- , Notification+ -- * Capabilities+ , getCapabilities+ , Capability (..) ) where import DBus.Message@@ -78,7 +80,7 @@ -- 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+mkSessionClient = mkClient =<< getSessionBus -- |A 'Note' with default values. -- All fields are blank except for 'expiry', which is 'Dependent'.@@ -94,9 +96,9 @@ proxy = Proxy (RemoteObject busname path) iface where- busname = mkBusName' "org.freedesktop.Notifications"- path = mkObjectPath' "/org/freedesktop/Notifications"- iface = mkInterfaceName' "org.freedesktop.Notifications"+ busname = "org.freedesktop.Notifications"+ path = "/org/freedesktop/Notifications"+ iface = "org.freedesktop.Notifications" -- |Contents of a notification data Note = Note { appName :: String@@ -157,24 +159,11 @@ data Category = Device | DeviceAdded | DeviceError | DeviceRemoved | Email | EmailArrived | EmailBounced | Im | ImError | ImReceived- | Network | NetworkConnected | NetworkDisconnected | NetworkError + | 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 @@ -193,12 +182,46 @@ 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)+ callProxyBlocking_ cl proxy "Notify" [] args+ where+ args = map ($ note)+ [ 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 Capability = ActionsCap | BodyCap | BodyHyperlinksCap | BodyImagesCap+ | BodyMarkupCap | IconMultiCap | IconStaticCap | SoundCap+ | UnknownCap String+ deriving (Eq, Read, Show)++-- |Determine the server's capabilities+getCapabilities :: Client -> IO [Capability]+getCapabilities cl = map readCapability . fromJust . fromArray . fromJust+ . fromVariant . head . methodReturnBody+ <$> callProxyBlocking_ cl proxy "GetCapabilities" [] []++readCapability :: String -> Capability+readCapability s = case s of+ "actions" -> ActionsCap+ "body" -> BodyCap+ "body-hyperlinks" -> BodyHyperlinksCap+ "body-images" -> BodyImagesCap+ "body-markup" -> BodyMarkupCap+ "icon-multi" -> IconMultiCap+ "icon-static" -> IconStaticCap+ "sound" -> SoundCap+ s -> UnknownCap s+ timeoutInt :: Timeout -> Int32 timeoutInt Never = 0 timeoutInt Dependent = -1-timeoutInt (Milliseconds n) +timeoutInt (Milliseconds n) | n > 0 = n | otherwise = error "notification timeout not positive" @@ -209,7 +232,6 @@ 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>"@@ -235,7 +257,7 @@ hint (X x) = ("x", toVariant x) hint (Y y) = ("x", toVariant y) --- HACK: Assumes the constructor for category foo.bar.baz is FooBarBaz and+-- HACK: Assumes the constructor for category foo.bar is FooBar and -- categories have no capital letters catName :: Category -> String catName c = catName' (show c)
LICENSE view
@@ -14,7 +14,7 @@ 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+THIS SOFTWARE IS PROVIDED BY THE 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
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
fdo-notify.cabal view
@@ -1,5 +1,5 @@ name: fdo-notify-version: 0.1+version: 0.2 synopsis: Desktop Notifications client description: A library for issuing notifications using FreeDesktop.org's Desktop@@ -10,6 +10,7 @@ license-file: LICENSE author: Max Rabkin maintainer: max.rabkin@gmail.com+homepage: http://bitbucket.org/taejo/fdo-notify/ cabal-version: >= 1.2.1 build-type: Simple @@ -17,6 +18,9 @@ examples/fib.hs library- build-depends: base >= 3 && < 5, dbus-core >= 0.5 && < 0.6, dbus-client >= 0.1 && < 0.2+ build-depends:+ base >= 3 && < 5+ , dbus-client >= 0.3 && < 0.4+ , dbus-core >= 0.8 && < 0.9 exposed-modules: DBus.Notify