diff --git a/dbus.cabal b/dbus.cabal --- a/dbus.cabal +++ b/dbus.cabal @@ -1,5 +1,5 @@ name: dbus -version: 1.3.11 +version: 1.4.3 license: Apache-2.0 license-file: license.txt author: John Millikin @@ -85,7 +85,7 @@ , bytestring < 0.13 , cereal < 0.6 , conduit >= 1.3.0 && < 1.4 - , containers < 0.8 + , containers < 0.9 , deepseq < 1.6 , exceptions < 0.11 , filepath < 1.6 @@ -94,7 +94,7 @@ , parsec < 3.2 , random < 1.4 , split < 0.3 - , template-haskell >= 2.18 && < 2.23 + , template-haskell >= 2.18 && < 2.25 , text < 2.2 , th-lift < 0.9 , transformers < 0.7 @@ -131,14 +131,14 @@ , base >=4 && <5 , bytestring < 0.13 , cereal < 0.6 - , containers < 0.8 + , containers < 0.9 , directory < 1.4 , extra < 1.9 , filepath < 1.6 , network >= 3.2 && < 3.3 , parsec < 3.2 , process < 1.7 - , QuickCheck < 2.16 + , QuickCheck < 2.19 , random < 1.4 , resourcet < 1.4 , tasty < 1.6 diff --git a/examples/dbus-monitor.hs b/examples/dbus-monitor.hs --- a/examples/dbus-monitor.hs +++ b/examples/dbus-monitor.hs @@ -105,7 +105,7 @@ putStrLn (formatMessage received ++ "\n") -- Message formatting is verbose and mostly uninteresting, except as an --- excersise in string manipulation. +-- exercise in string manipulation. formatMessage :: ReceivedMessage -> String diff --git a/lib/DBus.hs b/lib/DBus.hs --- a/lib/DBus.hs +++ b/lib/DBus.hs @@ -191,7 +191,7 @@ typeOf :: IsValue a => a -> Type typeOf = DBus.Internal.Types.typeOf --- | Get the D-Bus type corresponding to the given Haskell type 'a'. +-- | Get the D-Bus type corresponding to the given Haskell type @a@. typeOf' :: IsValue a => Proxy a -> Type typeOf' = DBus.Internal.Types.typeOf_ @@ -200,14 +200,17 @@ -- Use fields such as 'methodCallDestination' and 'methodCallBody' to populate -- a 'MethodCall'. -- --- @ ---{-\# LANGUAGE OverloadedStrings \#-} +-- >>> :seti -XOverloadedStrings -- ---methodCall \"/\" \"org.example.Math\" \"Add\" --- { 'methodCallDestination' = Just \"org.example.Calculator\" --- , 'methodCallBody' = ['toVariant' (1 :: Int32), 'toVariant' (2 :: Int32)] +-- >>> import Data.Int +-- +-- >>> :{ +-- (methodCall "/" "org.example.Math" "Add") +-- { methodCallDestination = Just "org.example.Calculator" +-- , methodCallBody = [toVariant (1 :: Int32), toVariant (2 :: Int32)] -- } --- @ +-- :} +-- MethodCall {methodCallPath = ObjectPath "/", methodCallInterface = Just (InterfaceName "org.example.Math"), methodCallMember = MemberName "Add", methodCallSender = Nothing, methodCallDestination = Just (BusName "org.example.Calculator"), methodCallReplyExpected = True, methodCallAutoStart = True, methodCallBody = [Variant 1,Variant 2]} methodCall :: ObjectPath -> InterfaceName -> MemberName -> MethodCall methodCall path iface member = MethodCall path (Just iface) member Nothing Nothing True True [] diff --git a/lib/DBus/Client.hs b/lib/DBus/Client.hs --- a/lib/DBus/Client.hs +++ b/lib/DBus/Client.hs @@ -35,30 +35,27 @@ -- -- Example: connect to the session bus, and get a list of active names. -- --- @ ---{-\# LANGUAGE OverloadedStrings \#-} +-- >>> :seti -XOverloadedStrings -- ---import Data.List (sort) ---import DBus ---import DBus.Client +-- >>> import Data.List (sort) +-- >>> import DBus +-- >>> import DBus.Client -- ---main = do --- client <- 'connectSession' --- // --- \-- Request a list of connected clients from the bus --- reply <- 'call_' client ('methodCall' \"\/org\/freedesktop\/DBus\" \"org.freedesktop.DBus\" \"ListNames\") --- { 'methodCallDestination' = Just \"org.freedesktop.DBus\" +-- >>> :{ +-- getActiveNames :: IO () +-- getActiveNames = do +-- client <- connectSession +-- -- Request a list of connected clients from the bus +-- reply <- call_ client (methodCall "/org/freedesktop/DBus" "org.freedesktop.DBus" "ListNames") +-- { methodCallDestination = Just "org.freedesktop.DBus" -- } --- // --- \-- org.freedesktop.DBus.ListNames() returns a single value, which is --- \-- a list of names (here represented as [String]) --- let Just names = 'fromVariant' ('methodReturnBody' reply !! 0) --- // --- \-- Print each name on a line, sorted so reserved names are below --- \-- temporary names. +-- -- org.freedesktop.DBus.ListNames() returns a single value, which is +-- -- a list of names (here represented as [String]) +-- let Just names = fromVariant (methodReturnBody reply !! 0) +-- -- Print each name on a line, sorted so reserved names are below +-- -- temporary names. -- mapM_ putStrLn (sort names) --- @ --- +-- :} module DBus.Client ( -- * Clients @@ -291,7 +288,7 @@ -- NOTE: This instance is needed to make modifyNothingHandler work, but it -- shouldn't really be used for much else. A more complete implementation can't --- be provided because PathInfo > Interface > Method conatain functions which +-- be provided because PathInfo > Interface > Method contain functions which -- can't/don't have an eq instance. instance Eq PathInfo where a == b = null (_pathInterfaces a) && @@ -756,7 +753,7 @@ -- reserves @\"org.freedesktop.NetworkManager\"@ on the system bus. -- -- * When there are multiple implementations of a particular service, the --- service standard will ususally include a generic bus name for the +-- service standard will usually include a generic bus name for the -- service. This allows other clients to avoid depending on any particular -- implementation's name. For example, both the GNOME Keyring and KDE -- KWallet services request the @\"org.freedesktop.secrets\"@ name on the @@ -897,7 +894,7 @@ , methodErrorSender = sender } $ fromVariant variant --- | Retrieve a property using the method call parameters that were provided. +-- | Like `getPropertyValue`, but returns the value as a 'Variant'. -- -- Throws a 'ClientError' if the property request couldn't be sent. getProperty :: Client -> MethodCall -> IO (Either MethodError Variant) @@ -913,10 +910,19 @@ ] } +-- | Get a property using the standard @\"org.freedesktop.DBus.Properties.Get\"@ method. +-- The interface and property name are given by the 'methodCallInterface' and 'methodCallMember' +-- fields of the supplied 'MethodCall'. This function handles properties of fixed type. For +-- properties of varying types, use 'getProperty'. +-- +-- Throws a 'ClientError' if the property request couldn't be sent. getPropertyValue :: IsValue a => Client -> MethodCall -> IO (Either MethodError a) getPropertyValue client msg = (>>= unpackVariant msg) <$> getProperty client msg +-- | Like 'setPropertyValue', but expects the new value to be wrapped in a 'Variant'. +-- +-- Throws a 'ClientError' if the property request couldn't be sent. setProperty :: Client -> MethodCall -> Variant -> IO (Either MethodError MethodReturn) setProperty client msg@MethodCall { methodCallInterface = interface @@ -927,10 +933,15 @@ , methodCallBody = [ toVariant (coerce (orDefaultInterface interface) :: String) , toVariant (coerce member :: String) - , value + , toVariant value ] } +-- | Set a property using the standard @\"org.freedesktop.DBus.Properties.Set\"@ method. +-- The interface and property name are given by the 'methodCallInterface' and 'methodCallMember' +-- fields of the supplied 'MethodCall'. See `setProperty` for a version that accepts a 'Variant'. +-- +-- Throws a 'ClientError' if the property request couldn't be sent. setPropertyValue :: IsValue a => Client -> MethodCall -> a -> IO (Maybe MethodError) @@ -1239,24 +1250,33 @@ -- Use 'autoMethod' to construct a 'Method' from a function that accepts and -- returns simple types. -- --- Use 'method' to construct a 'Method' from a function that handles parameter +-- Use 'makeMethod' to construct a 'Method' from a function that handles parameter -- conversion manually. -- --- @ ---ping :: MethodCall -> IO 'Reply' ---ping _ = ReplyReturn [] +-- >>> :seti -XOverloadedStrings -- ---sayHello :: String -> IO String ---sayHello name = return (\"Hello \" ++ name ++ \"!\") +-- >>> :{ +-- ping :: MethodCall -> DBusR Reply +-- ping _ = pure $ ReplyReturn [] +-- :} -- --- export client \"/hello_world\" --- defaultInterface { interfaceName = \"com.example.HelloWorld\" --- , interfaceMethods = --- [ 'method' \"com.example.HelloWorld\" \"Ping\" ping --- , 'autoMethod' \"com.example.HelloWorld\" \"Hello\" sayHello --- ] --- } --- @ +-- >>> :{ +-- sayHello :: String -> IO String +-- sayHello name = return ("Hello " ++ name ++ "!") +-- :} +-- +-- >>> :{ +-- doExport :: IO () +-- doExport = do +-- client <- connectSession +-- export client "/hello_world" +-- defaultInterface { interfaceName = "com.example.HelloWorld" +-- , interfaceMethods = +-- [ makeMethod "Ping" (signature_ []) (signature_ []) ping +-- , autoMethod "Hello" sayHello +-- ] +-- } +-- :} export :: Client -> ObjectPath -> Interface -> IO () export client path interface = atomicModifyIORef_ (clientObjects client) $ addInterface path interface diff --git a/lib/DBus/Generation.hs b/lib/DBus/Generation.hs --- a/lib/DBus/Generation.hs +++ b/lib/DBus/Generation.hs @@ -72,7 +72,7 @@ where fn t = case t of -- Because of a quirk in how we unmarshal things, we currently HAVE - -- to decorde arrays of Word8 in this way. + -- to decode arrays of Word8 in this way. T.TypeArray T.TypeWord8 -> ConT ''BS.ByteString T.TypeBoolean -> ConT ''Bool T.TypeWord8 -> ConT ''Word8 diff --git a/lib/DBus/Internal/Types.hs b/lib/DBus/Internal/Types.hs --- a/lib/DBus/Internal/Types.hs +++ b/lib/DBus/Internal/Types.hs @@ -836,7 +836,7 @@ Parsec.skipMany (oneOf alphanum) -- | A D-Bus Structure is a container type similar to Haskell tuples, storing --- values of any type that is convertable to 'IsVariant'. A Structure may +-- values of any type that is convertible to 'IsVariant'. A Structure may -- contain up to 255 values. -- -- Most users can use the 'IsVariant' instance for tuples to extract the diff --git a/lib/DBus/Internal/Wire.hs b/lib/DBus/Internal/Wire.hs --- a/lib/DBus/Internal/Wire.hs +++ b/lib/DBus/Internal/Wire.hs @@ -480,7 +480,7 @@ let end = start + fromIntegral byteCount vs <- untilM (liftM (>= end) getOffset) (unmarshal itemType) end' <- getOffset - when (end' > end) (throwError ("Array data size exeeds array size of " ++ show end)) + when (end' > end) (throwError ("Array data size exceeds array size of " ++ show end)) return (Data.Vector.fromList vs) dictionaryToArray :: Map Atom Value -> Vector Value @@ -626,7 +626,7 @@ checkMaximumSize = do (MarshalState _ messageLength _) <- getState when (toInteger messageLength > messageMaximumLength) - (throwError ("Marshaled message size (" ++ show messageLength ++ " bytes) exeeds maximum limit of (" ++ show messageMaximumLength ++ " bytes).")) + (throwError ("Marshaled message size (" ++ show messageLength ++ " bytes) exceeds maximum limit of (" ++ show messageMaximumLength ++ " bytes).")) unmarshalMessageM :: Monad m => (Int -> m (ByteString, [Fd])) -> m (Either UnmarshalError ReceivedMessage) diff --git a/lib/DBus/Socket.hs b/lib/DBus/Socket.hs --- a/lib/DBus/Socket.hs +++ b/lib/DBus/Socket.hs @@ -313,16 +313,25 @@ -- | An empty authenticator. Use 'authenticatorClient' or 'authenticatorServer' -- to control how the authentication is performed. -- --- @ ---myAuthenticator :: Authenticator MyTransport ---myAuthenticator = authenticator --- { 'authenticatorClient' = clientMyAuth --- , 'authenticatorServer' = serverMyAuth --- } +-- >>> data MyTransport -- ---clientMyAuth :: MyTransport -> IO Bool ---serverMyAuth :: MyTransport -> String -> IO Bool --- @ +-- >>> :{ +-- clientMyAuth :: MyTransport -> IO Bool +-- clientMyAuth = error "example" +-- :} +-- +-- >>> :{ +-- serverMyAuth :: MyTransport -> UUID -> IO Bool +-- serverMyAuth = error "example" +-- :} +-- +-- >>> :{ +-- myAuthenticator :: Authenticator MyTransport +-- myAuthenticator = authenticator +-- { authenticatorClient = clientMyAuth +-- , authenticatorServer = serverMyAuth +-- } +-- :} authenticator :: Authenticator t authenticator = Authenticator (\_ -> return False) (\_ _ -> return False)