384 lines
11 KiB
Diff
384 lines
11 KiB
Diff
|
Only in dbus-1.2.13-new: .codeclimate.yml
|
||
|
diff -ur dbus-1.2.13-old/dbus.cabal dbus-1.2.13-new/dbus.cabal
|
||
|
--- dbus-1.2.13-old/dbus.cabal 2020-04-25 19:29:27.372272952 +0200
|
||
|
+++ dbus-1.2.13-new/dbus.cabal 2020-04-25 19:26:36.140991920 +0200
|
||
|
@@ -1,172 +1,180 @@
|
||
|
-cabal-version: >=1.8
|
||
|
name: dbus
|
||
|
version: 1.2.13
|
||
|
license: Apache-2.0
|
||
|
license-file: license.txt
|
||
|
-maintainer: Andrey Sverdlichenko <blaze@ruddy.ru>
|
||
|
author: John Millikin <john@john-millikin.com>
|
||
|
+maintainer: Andrey Sverdlichenko <blaze@ruddy.ru>
|
||
|
+build-type: Simple
|
||
|
+cabal-version: >= 1.8
|
||
|
+category: Network, Desktop
|
||
|
stability: experimental
|
||
|
homepage: https://github.com/rblaze/haskell-dbus#readme
|
||
|
+
|
||
|
synopsis: A client library for the D-Bus IPC system.
|
||
|
description:
|
||
|
- D-Bus is a simple, message-based protocol for inter-process
|
||
|
- communication, which allows applications to interact with other parts of
|
||
|
- the machine and the user's session using remote procedure calls.
|
||
|
- .
|
||
|
- D-Bus is a essential part of the modern Linux desktop, where it replaces
|
||
|
- earlier protocols such as CORBA and DCOP.
|
||
|
- .
|
||
|
- This library is an implementation of the D-Bus protocol in Haskell. It
|
||
|
- can be used to add D-Bus support to Haskell applications, without the
|
||
|
- awkward interfaces common to foreign bindings.
|
||
|
- .
|
||
|
- Example: connect to the session bus, and get a list of active names.
|
||
|
- .
|
||
|
- @
|
||
|
- {-\# LANGUAGE OverloadedStrings \#-}
|
||
|
- .
|
||
|
- 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\"
|
||
|
-   }
|
||
|
-   //
|
||
|
-   \-- 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)
|
||
|
- @
|
||
|
- .
|
||
|
- >$ ghc --make list-names.hs
|
||
|
- >$ ./list-names
|
||
|
- >:1.0
|
||
|
- >:1.1
|
||
|
- >:1.10
|
||
|
- >:1.106
|
||
|
- >:1.109
|
||
|
- >:1.110
|
||
|
- >ca.desrt.dconf
|
||
|
- >org.freedesktop.DBus
|
||
|
- >org.freedesktop.Notifications
|
||
|
- >org.freedesktop.secrets
|
||
|
- >org.gnome.ScreenSaver
|
||
|
-category: Network, Desktop
|
||
|
-build-type: Simple
|
||
|
+ D-Bus is a simple, message-based protocol for inter-process
|
||
|
+ communication, which allows applications to interact with other parts of
|
||
|
+ the machine and the user's session using remote procedure calls.
|
||
|
+ .
|
||
|
+ D-Bus is a essential part of the modern Linux desktop, where it replaces
|
||
|
+ earlier protocols such as CORBA and DCOP.
|
||
|
+ .
|
||
|
+ This library is an implementation of the D-Bus protocol in Haskell. It
|
||
|
+ can be used to add D-Bus support to Haskell applications, without the
|
||
|
+ awkward interfaces common to foreign bindings.
|
||
|
+ .
|
||
|
+ Example: connect to the session bus, and get a list of active names.
|
||
|
+ .
|
||
|
+ @
|
||
|
+ {-\# LANGUAGE OverloadedStrings \#-}
|
||
|
+ .
|
||
|
+ 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\"
|
||
|
+   }
|
||
|
+  
|
||
|
+   -- 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)
|
||
|
+ @
|
||
|
+ .
|
||
|
+ >$ ghc --make list-names.hs
|
||
|
+ >$ ./list-names
|
||
|
+ >:1.0
|
||
|
+ >:1.1
|
||
|
+ >:1.10
|
||
|
+ >:1.106
|
||
|
+ >:1.109
|
||
|
+ >:1.110
|
||
|
+ >ca.desrt.dconf
|
||
|
+ >org.freedesktop.DBus
|
||
|
+ >org.freedesktop.Notifications
|
||
|
+ >org.freedesktop.secrets
|
||
|
+ >org.gnome.ScreenSaver
|
||
|
+
|
||
|
+
|
||
|
extra-source-files:
|
||
|
- examples/dbus-monitor.hs
|
||
|
- examples/export.hs
|
||
|
- examples/introspect.hs
|
||
|
- examples/list-names.hs
|
||
|
- idlxml/dbus.xml
|
||
|
+ examples/dbus-monitor.hs
|
||
|
+ examples/export.hs
|
||
|
+ examples/introspect.hs
|
||
|
+ examples/list-names.hs
|
||
|
+ idlxml/dbus.xml
|
||
|
|
||
|
source-repository head
|
||
|
- type: git
|
||
|
- location: https://github.com/rblaze/haskell-dbus
|
||
|
+ type: git
|
||
|
+ location: https://github.com/rblaze/haskell-dbus
|
||
|
|
||
|
library
|
||
|
- exposed-modules:
|
||
|
- DBus
|
||
|
- DBus.Client
|
||
|
- DBus.Generation
|
||
|
- DBus.Internal.Address
|
||
|
- DBus.Internal.Message
|
||
|
- DBus.Internal.Types
|
||
|
- DBus.Internal.Wire
|
||
|
- DBus.Introspection
|
||
|
- DBus.Introspection.Parse
|
||
|
- DBus.Introspection.Render
|
||
|
- DBus.Introspection.Types
|
||
|
- DBus.Socket
|
||
|
- DBus.TH
|
||
|
- DBus.Transport
|
||
|
- hs-source-dirs: lib
|
||
|
- ghc-options: -W -Wall
|
||
|
- build-depends:
|
||
|
- base ==4.*,
|
||
|
- bytestring <0.11,
|
||
|
- cereal <0.6,
|
||
|
- conduit >=1.3.0 && <1.4,
|
||
|
- containers <0.7,
|
||
|
- deepseq <1.5,
|
||
|
- exceptions <0.11,
|
||
|
- filepath <1.5,
|
||
|
- lens <4.20,
|
||
|
- network >=3.0.1.0 && <3.2,
|
||
|
- parsec <3.2,
|
||
|
- random <1.2,
|
||
|
- split <0.3,
|
||
|
- template-haskell <2.16.0.0,
|
||
|
- text <1.3,
|
||
|
- th-lift <0.9,
|
||
|
- transformers <0.6,
|
||
|
- unix <2.8,
|
||
|
- vector <0.13,
|
||
|
- xml-conduit >=1.9.0.0 && <1.10.0.0,
|
||
|
- xml-types <0.4
|
||
|
+ ghc-options: -W -Wall
|
||
|
+ hs-source-dirs: lib
|
||
|
+
|
||
|
+ build-depends:
|
||
|
+ base >=4 && <5
|
||
|
+ , bytestring
|
||
|
+ , cereal
|
||
|
+ , conduit >= 1.3.0
|
||
|
+ , containers
|
||
|
+ , deepseq
|
||
|
+ , exceptions
|
||
|
+ , filepath
|
||
|
+ , lens < 4.20
|
||
|
+ , network >= 3.0.1.0 && < 3.2
|
||
|
+ , parsec
|
||
|
+ , random
|
||
|
+ , split
|
||
|
+ , template-haskell < 2.17.0.0
|
||
|
+ , text
|
||
|
+ , th-lift < 0.9
|
||
|
+ , transformers
|
||
|
+ , unix
|
||
|
+ , vector
|
||
|
+ , xml-conduit >= 1.9.0.0 && < 1.10.0.0
|
||
|
+ , xml-types
|
||
|
+
|
||
|
+ exposed-modules:
|
||
|
+ DBus
|
||
|
+ DBus.Client
|
||
|
+ DBus.Generation
|
||
|
+ DBus.Internal.Address
|
||
|
+ DBus.Internal.Message
|
||
|
+ DBus.Internal.Types
|
||
|
+ DBus.Internal.Wire
|
||
|
+ DBus.Introspection
|
||
|
+ DBus.Introspection.Parse
|
||
|
+ DBus.Introspection.Render
|
||
|
+ DBus.Introspection.Types
|
||
|
+ DBus.Socket
|
||
|
+ DBus.TH
|
||
|
+ DBus.Transport
|
||
|
|
||
|
test-suite dbus_tests
|
||
|
- type: exitcode-stdio-1.0
|
||
|
- main-is: DBusTests.hs
|
||
|
- hs-source-dirs: tests
|
||
|
- other-modules:
|
||
|
- DBusTests.Address
|
||
|
- DBusTests.BusName
|
||
|
- DBusTests.Client
|
||
|
- DBusTests.ErrorName
|
||
|
- DBusTests.Generation
|
||
|
- DBusTests.Integration
|
||
|
- DBusTests.InterfaceName
|
||
|
- DBusTests.Introspection
|
||
|
- DBusTests.MemberName
|
||
|
- DBusTests.Message
|
||
|
- DBusTests.ObjectPath
|
||
|
- DBusTests.Serialization
|
||
|
- DBusTests.Signature
|
||
|
- DBusTests.Socket
|
||
|
- DBusTests.TH
|
||
|
- DBusTests.Transport
|
||
|
- DBusTests.Util
|
||
|
- DBusTests.Variant
|
||
|
- DBusTests.Wire
|
||
|
- ghc-options: -W -Wall -fno-warn-orphans
|
||
|
- build-depends:
|
||
|
- dbus -any,
|
||
|
- base ==4.*,
|
||
|
- bytestring <0.11,
|
||
|
- cereal <0.6,
|
||
|
- containers <0.7,
|
||
|
- directory <1.4,
|
||
|
- extra <1.8,
|
||
|
- filepath <1.5,
|
||
|
- network >=3.0.1.0 && <3.2,
|
||
|
- parsec <3.2,
|
||
|
- process <1.7,
|
||
|
- QuickCheck <2.15,
|
||
|
- random <1.2,
|
||
|
- resourcet <1.3,
|
||
|
- tasty <1.3,
|
||
|
- tasty-hunit <0.11,
|
||
|
- tasty-quickcheck <0.11,
|
||
|
- text <1.3,
|
||
|
- transformers <0.6,
|
||
|
- unix <2.8,
|
||
|
- vector <0.13
|
||
|
+ type: exitcode-stdio-1.0
|
||
|
+ main-is: DBusTests.hs
|
||
|
+ hs-source-dirs: tests
|
||
|
+ ghc-options: -W -Wall -fno-warn-orphans
|
||
|
+
|
||
|
+ build-depends:
|
||
|
+ dbus
|
||
|
+ , base >=4 && <5
|
||
|
+ , bytestring
|
||
|
+ , cereal
|
||
|
+ , containers
|
||
|
+ , directory
|
||
|
+ , extra < 1.8
|
||
|
+ , filepath
|
||
|
+ , network >= 3.0.1.0 && < 3.2
|
||
|
+ , parsec
|
||
|
+ , process
|
||
|
+ , QuickCheck < 2.15
|
||
|
+ , random
|
||
|
+ , resourcet
|
||
|
+ , tasty
|
||
|
+ , tasty-hunit
|
||
|
+ , tasty-quickcheck
|
||
|
+ , text
|
||
|
+ , transformers
|
||
|
+ , unix
|
||
|
+ , vector
|
||
|
+
|
||
|
+ other-modules:
|
||
|
+ DBusTests.Address
|
||
|
+ DBusTests.BusName
|
||
|
+ DBusTests.Client
|
||
|
+ DBusTests.ErrorName
|
||
|
+ DBusTests.Generation
|
||
|
+ DBusTests.Integration
|
||
|
+ DBusTests.InterfaceName
|
||
|
+ DBusTests.Introspection
|
||
|
+ DBusTests.MemberName
|
||
|
+ DBusTests.Message
|
||
|
+ DBusTests.ObjectPath
|
||
|
+ DBusTests.Serialization
|
||
|
+ DBusTests.Signature
|
||
|
+ DBusTests.Socket
|
||
|
+ DBusTests.TH
|
||
|
+ DBusTests.Transport
|
||
|
+ DBusTests.Util
|
||
|
+ DBusTests.Variant
|
||
|
+ DBusTests.Wire
|
||
|
|
||
|
benchmark dbus_benchmarks
|
||
|
- type: exitcode-stdio-1.0
|
||
|
- main-is: DBusBenchmarks.hs
|
||
|
- hs-source-dirs: benchmarks
|
||
|
- ghc-options: -Wall -fno-warn-orphans
|
||
|
- build-depends:
|
||
|
- dbus -any,
|
||
|
- base ==4.*,
|
||
|
- criterion <1.6
|
||
|
+ type: exitcode-stdio-1.0
|
||
|
+ main-is: DBusBenchmarks.hs
|
||
|
+ hs-source-dirs: benchmarks
|
||
|
+ ghc-options: -Wall -fno-warn-orphans
|
||
|
+
|
||
|
+ build-depends:
|
||
|
+ dbus
|
||
|
+ , base >=4 && <5
|
||
|
+ , criterion
|
||
|
Only in dbus-1.2.13-new: .git
|
||
|
Only in dbus-1.2.13-new: .gitignore
|
||
|
diff -ur dbus-1.2.13-old/lib/DBus/Generation.hs dbus-1.2.13-new/lib/DBus/Generation.hs
|
||
|
--- dbus-1.2.13-old/lib/DBus/Generation.hs 2019-02-14 16:37:47.000000000 +0100
|
||
|
+++ dbus-1.2.13-new/lib/DBus/Generation.hs 2020-04-25 19:26:36.144991997 +0200
|
||
|
@@ -1,3 +1,4 @@
|
||
|
+{-# LANGUAGE CPP #-}
|
||
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
{-# LANGUAGE TemplateHaskell #-}
|
||
|
module DBus.Generation where
|
||
|
@@ -26,6 +27,13 @@
|
||
|
import Prelude hiding (mapM)
|
||
|
import System.Posix.Types (Fd(..))
|
||
|
|
||
|
+-- | Compatibility helper to create (total) tuple expressions
|
||
|
+mkTupE :: [Exp] -> Exp
|
||
|
+mkTupE = TupE
|
||
|
+#if MIN_VERSION_template_haskell(2,16,0)
|
||
|
+ . map Just
|
||
|
+#endif
|
||
|
+
|
||
|
type ClientBusPathR a = ReaderT (Client, T.BusName, T.ObjectPath) IO a
|
||
|
|
||
|
dbusInvoke :: (Client -> T.BusName -> T.ObjectPath -> a) -> ClientBusPathR a
|
||
|
@@ -232,8 +240,8 @@
|
||
|
finalOutputNames <- buildOutputNames
|
||
|
let variantListExp = map makeToVariantApp methodArgNames
|
||
|
mapOrHead' = mapOrHead outputLength
|
||
|
- fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames TupE
|
||
|
- finalResultTuple = mapOrHead' VarE finalOutputNames TupE
|
||
|
+ fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames mkTupE
|
||
|
+ finalResultTuple = mapOrHead' VarE finalOutputNames mkTupE
|
||
|
maybeExtractionPattern = mapOrHead' makeJustPattern finalOutputNames TupP
|
||
|
getMethodCallDefDec = [d|
|
||
|
$( varP methodCallDefN ) =
|
||
|
@@ -432,7 +440,7 @@
|
||
|
}
|
||
|
|]
|
||
|
let mapOrHead' = mapOrHead argCount
|
||
|
- fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames TupE
|
||
|
+ fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames mkTupE
|
||
|
maybeExtractionPattern = mapOrHead' makeJustPattern toHandlerOutputNames TupP
|
||
|
applyToName toApply n = AppE toApply $ VarE n
|
||
|
finalApplication = foldl applyToName (VarE handlerArgN)
|