Commits

Max Rabkin  committed b0fdb2e

Support dbus-client 0.3

  • Participants
  • Parent commits 6159589
  • Tags version 0.2

Comments (0)

Files changed (2)

File DBus/Notify.hs

 --
 -- 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
     -- * Displaying notifications
       notify
     , replace
+    , Notification
     , mkSessionClient
     , Client
     -- * Constructing notifications
     , Category (..)
     , UrgencyLevel (..)
     , Hint (..)
-    -- * Handles to displayed notifications
-    , Notification
     -- * Capabilities
     , getCapabilities
     , Capability (..)
 -- 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'.
 
 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
 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
 
 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
 getCapabilities :: Client -> IO [Capability]
 getCapabilities cl = map readCapability . fromJust . fromArray . fromJust
                     . fromVariant . head . methodReturnBody
-                    <$> callBlocking cl proxy (mkMemberName' "GetCapabilities") [] []
+                    <$> 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"
 
         escape '<' = "&lt;"
         escape '&' = "&amp;"
         escape x = [x]
-
 flattenBody (Bold b) = "<b>" ++ flattenBody b ++ "</b>"
 flattenBody (Italic b) = "<i>" ++ flattenBody b ++ "</i>"
 flattenBody (Underline b) = "<u>" ++ flattenBody b ++ "</u>"

File fdo-notify.cabal

 name:               fdo-notify
-version:            0.1
+version:            0.2
 synopsis:           Desktop Notifications client
 description:
     A library for issuing notifications using FreeDesktop.org's Desktop
     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