haskell-dbus: apply patch to fix the build
Taken from https://github.com/rblaze/haskell-dbus/pull/48.
This commit is contained in:
parent
d28e92d5aa
commit
d3ae5625ff
@ -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 {
|
||||
|
@ -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.
|
||||
- .
|
||||
- @
|
||||
- {-\# 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)
|
Loading…
Reference in New Issue
Block a user