haskell-dbus: apply patch to fix the build

Taken from https://github.com/rblaze/haskell-dbus/pull/48.
This commit is contained in:
Peter Simons 2020-04-25 19:32:30 +02:00
parent d28e92d5aa
commit d3ae5625ff
2 changed files with 384 additions and 0 deletions

View File

@ -110,6 +110,7 @@ self: super: {
url = "https://github.com/haskell-hvr/cabal-plan/pull/55.patch";
sha256 = "0lhs4vx5qg5ldhnyb9z7k0jmxhmd2f34x4xbwv6vsljs9vr02pd8";
});
dbus = appendPatch super.dbus ./patches/fix-dbus-for-ghc-8.10.x.patch;
# https://github.com/ndmitchell/hlint/issues/959
hlint = super.hlint.override {

View File

@ -0,0 +1,383 @@
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.
- .
- @
- &#x7b;-\# LANGUAGE OverloadedStrings \#-&#x7d;
- .
- import Data.List (sort)
- import DBus
- import DBus.Client
- .
- main = do
- &#x20; client <- connectSession
- &#x20; //
- &#x20; \-- Request a list of connected clients from the bus
- &#x20; reply <- call_ client (methodCall \"\/org\/freedesktop\/DBus\" \"org.freedesktop.DBus\" \"ListNames\")
- &#x20; &#x7b; methodCallDestination = Just \"org.freedesktop.DBus\"
- &#x20; &#x7d;
- &#x20; //
- &#x20; \-- org.freedesktop.DBus.ListNames() returns a single value, which is
- &#x20; \-- a list of names (here represented as [String])
- &#x20; let Just names = fromVariant (methodReturnBody reply !! 0)
- &#x20; //
- &#x20; \-- Print each name on a line, sorted so reserved names are below
- &#x20; \-- temporary names.
- &#x20; 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.
+ .
+ @
+ &#x7b;-\# LANGUAGE OverloadedStrings \#-&#x7d;
+ .
+ import Data.List (sort)
+ import DBus
+ import DBus.Client
+ .
+ main = do
+ &#x20; client <- connectSession
+ &#x20;
+ &#x20; -- Request a list of connected clients from the bus
+ &#x20; reply <- call_ client (methodCall \"\/org\/freedesktop\/DBus\" \"org.freedesktop.DBus\" \"ListNames\")
+ &#x20; &#x7b; methodCallDestination = Just \"org.freedesktop.DBus\"
+ &#x20; &#x7d;
+ &#x20;
+ &#x20; -- org.freedesktop.DBus.ListNames() returns a single value, which is
+ &#x20; -- a list of names (here represented as [String])
+ &#x20; let Just names = fromVariant (methodReturnBody reply !! 0)
+ &#x20;
+ &#x20; -- Print each name on a line, sorted so reserved names are below
+ &#x20; -- temporary names.
+ &#x20; 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)