Port from dbus-core to dbus

src/System/Information/Battery.hs

@@ -19,12 +19,14 @@ import qualified Data.Map as M
 import Data.Maybe
 import Data.Word
 import Data.Int
-import DBus.Client.Simple
-import Data.List ( find )
-import Data.Text ( isInfixOf, Text )
+import DBus
+import DBus.Client
+import Data.List ( find, isInfixOf )
+import Data.Text ( Text )
+import qualified Data.Text as T
 
 -- | An opaque wrapper around some internal library state
-newtype BatteryContext = BC Proxy
+data BatteryContext = BC Client ObjectPath
 
 data BatteryType = BatteryTypeUnknown
                  | BatteryTypeLinePower
@@ -90,7 +92,7 @@ data BatteryInfo = BatteryInfo { batteryNativePath :: Text
 -- | Find the first power source that is a battery in the list.  The
 -- simple heuristic is a substring search on 'BAT'
 firstBattery :: [ObjectPath] -> Maybe ObjectPath
-firstBattery = find (isInfixOf "BAT" . objectPathText)
+firstBattery = find (isInfixOf "BAT" . formatObjectPath)
 
 -- | The name of the power daemon bus
 powerBusName :: BusName
@@ -128,16 +130,16 @@ readDictIntegral dict key dflt = case variantType variant of
 -- If some fields are not actually present, they may have bogus values
 -- here.  Don't bet anything critical on it.
 getBatteryInfo :: BatteryContext -> IO BatteryInfo
-getBatteryInfo (BC batteryProxy) = do
+getBatteryInfo (BC systemConn battPath) = do
   -- Grab all of the properties of the battery each call with one
   -- message.
-  let iface :: Variant
-      iface = toVariant ("org.freedesktop.UPower.Device" :: Text)
-
-  [val] <- call batteryProxy "org.freedesktop.DBus.Properties" "GetAll" [iface]
+  reply <- call_ systemConn (methodCall battPath "org.freedesktop.DBus.Properties" "GetAll")
+                             { methodCallDestination = Just "org.freedesktop.UPower"
+                             , methodCallBody = [toVariant $ T.pack "org.freedesktop.UPower.Device"]
+                             }
 
   let dict :: Map Text Variant
-      Just dict = fromVariant val
+      Just dict = fromVariant (methodReturnBody reply !! 0)
   return BatteryInfo { batteryNativePath = readDict dict "NativePath" ""
                      , batteryVendor = readDict dict "Vendor" ""
                      , batteryModel = readDict dict "Model" ""
@@ -173,11 +175,12 @@ batteryContextNew = do
 
   -- First, get the list of devices.  For now, we just get the stats
   -- for the first battery
-  powerProxy <- proxy systemConn powerBusName powerBaseObjectPath
-  [ powerDevicesV ] <- call powerProxy "org.freedesktop.UPower" "EnumerateDevices" []
-  let Just powerDevices = fromVariant powerDevicesV
+  reply <- call_ systemConn (methodCall powerBaseObjectPath "org.freedesktop.UPower" "EnumerateDevices")
+        { methodCallDestination = Just powerBusName
+        }
+  let Just powerDevices = fromVariant (methodReturnBody reply !! 0)
+
   case firstBattery powerDevices of
     Nothing -> return Nothing
     Just battPath ->
-      proxy systemConn powerBusName battPath >>= (return . Just . BC)
-
+      return . Just $ BC systemConn battPath

src/System/Taffybar/FreedesktopNotifications.hs

@@ -26,7 +26,8 @@ import Data.Sequence ( Seq, (|>), viewl, ViewL(..) )
 import Data.Text ( Text )
 import qualified Data.Text as T
 import Data.Word ( Word32 )
-import DBus.Client.Simple
+import DBus
+import DBus.Client
 import Graphics.UI.Gtk hiding ( Variant )
 
 -- | A simple structure representing a Freedesktop notification
@@ -146,12 +147,12 @@ replaceNote nid newNote curNote =
 
 notificationDaemon onNote onCloseNote = do
   client <- connectSession
-  _ <- requestName client "org.freedesktop.Notifications" [AllowReplacement, ReplaceExisting]
+  _ <- requestName client "org.freedesktop.Notifications" [nameAllowReplacement, nameReplaceExisting]
   export client "/org/freedesktop/Notifications"
-    [ method "org.freedesktop.Notifications" "GetServerInformation" getServerInformation
-    , method "org.freedesktop.Notifications" "GetCapabilities" getCapabilities
-    , method "org.freedesktop.Notifications" "CloseNotification" onCloseNote
-    , method "org.freedesktop.Notifications" "Notify" onNote
+    [ autoMethod "org.freedesktop.Notifications" "GetServerInformation" getServerInformation
+    , autoMethod "org.freedesktop.Notifications" "GetCapabilities" getCapabilities
+    , autoMethod "org.freedesktop.Notifications" "CloseNotification" onCloseNote
+    , autoMethod "org.freedesktop.Notifications" "Notify" onNote
     ]
 
 -- When a notification is received, add it to the queue.  Post a token to the channel that the

src/System/Taffybar/MPRIS.hs

@@ -13,22 +13,20 @@ import Data.Int ( Int32 )
 import qualified Data.Map as M
 import Data.Text ( Text )
 import qualified Data.Text as T
-import DBus.Client.Simple ( connectSession )
+import DBus
 import DBus.Client
-import DBus.Types
-import DBus.Message
 import Graphics.UI.Gtk hiding ( Signal, Variant )
 import Text.Printf
 
 setupDBus :: Label -> IO ()
 setupDBus w = do
-  let trackMatcher = MatchRule { matchSender = Nothing
+  let trackMatcher = matchAny { matchSender = Nothing
                                , matchDestination = Nothing
                                , matchPath = Just "/Player"
                                , matchInterface = Just "org.freedesktop.MediaPlayer"
                                , matchMember = Just "TrackChange"
                                }
-      stateMatcher = MatchRule { matchSender = Nothing
+      stateMatcher = matchAny { matchSender = Nothing
                                , matchDestination = Nothing
                                , matchPath = Just "/Player"
                                , matchInterface = Just "org.freedesktop.MediaPlayer"
@@ -44,10 +42,11 @@ variantDictLookup k m = do
   fromVariant val
 
 
-trackCallback :: Label -> BusName -> Signal -> IO ()
-trackCallback w _ Signal { signalBody = [variant] } = do
+trackCallback :: Label -> Signal -> IO ()
+trackCallback w s = do
   let v :: Maybe (M.Map Text Variant)
       v = fromVariant variant
+      [variant] = signalBody s
   case v of
     Just m -> do
       let artist = maybe "[unknown]" id (variantDictLookup "artist" m)
@@ -60,11 +59,10 @@ trackCallback w _ Signal { signalBody = [variant] } = do
         labelSetMarkup w txt
         widgetShowAll w
     _ -> return ()
-trackCallback _ _ _ = return ()
 
-stateCallback :: Label -> BusName -> Signal -> IO ()
-stateCallback w _ Signal { signalBody = [bdy] } =
-  case fromVariant bdy of
+stateCallback :: Label -> Signal -> IO ()
+stateCallback w s =
+  case fromVariant (signalBody s !! 0) of
     Just st -> case structureItems st of
       (pstate:_) -> case (fromVariant pstate) :: Maybe Int32 of
         Just 2 -> postGUIAsync $ widgetHideAll w
@@ -73,7 +71,6 @@ stateCallback w _ Signal { signalBody = [bdy] } =
         _ -> return ()
       _ -> return ()
     _ -> return ()
-stateCallback _ _ _ = return ()
 
 mprisNew :: IO Widget
 mprisNew = do

src/System/Taffybar/XMonadLog.hs

@@ -24,10 +24,8 @@ module System.Taffybar.XMonadLog (
   ) where
 
 import Codec.Binary.UTF8.String ( decodeString )
-import DBus.Client.Simple ( connectSession, emit, Client )
-import DBus.Client ( listen, MatchRule(..) )
-import DBus.Types
-import DBus.Message
+import DBus ( toVariant, fromVariant, Signal(..), signal )
+import DBus.Client ( listen, matchAny, MatchRule(..), connectSession, emit, Client )
 import Graphics.UI.Gtk hiding ( Signal )
 
 import XMonad
@@ -79,11 +77,11 @@ outputThroughDBus client str = do
   -- We need to decode the string back into a real String before we
   -- send it over dbus.
   let str' = decodeString str
-  emit client "/org/xmonad/Log" "org.xmonad.Log" "Update" [ toVariant str' ]
+  emit client (signal "/org/xmonad/Log" "org.xmonad.Log" "Update") { signalBody = [ toVariant str' ] }
 
 setupDbus :: Label -> IO ()
 setupDbus w = do
-  let matcher = MatchRule { matchSender = Nothing
+  let matcher = matchAny { matchSender = Nothing
                           , matchDestination = Nothing
                           , matchPath = Just "/org/xmonad/Log"
                           , matchInterface = Just "org.xmonad.Log"
@@ -94,8 +92,8 @@ setupDbus w = do
 
   listen client matcher (callback w)
 
-callback :: Label -> BusName -> Signal -> IO ()
-callback w _ sig = do
+callback :: Label -> Signal -> IO ()
+callback w sig = do
   let [bdy] = signalBody sig
       Just status = fromVariant bdy
   postGUIAsync $ labelSetMarkup w status

taffybar.cabal

@@ -59,7 +59,7 @@ library
   default-language: Haskell2010
   build-depends: base > 3 && < 5, time, old-locale, containers, text, HTTP,
                  parsec >= 3.1, mtl >= 2, network, cairo,
-                 dbus-core >= 0.9.1 && < 1.0, gtk >= 0.12.1, dyre >= 0.8.6,
+                 dbus >= 0.10.1 && < 1.0, gtk >= 0.12.1, dyre >= 0.8.6,
                  HStringTemplate, gtk-traymanager >= 0.1.2 && < 0.2, xmonad-contrib, xmonad,
                  xdg-basedir, filepath, utf8-string, process
   hs-source-dirs: src