tjh.dev
haskell-dbus: apply patch to fix the build
Taken from https://github.com/rblaze/haskell-dbus/pull/48.
+1
pkgs/development/haskell-modules/configuration-ghc-8.10.x.nix
+1
pkgs/development/haskell-modules/configuration-ghc-8.10.x.nix
···
110
url = "https://github.com/haskell-hvr/cabal-plan/pull/55.patch";
111
sha256 = "0lhs4vx5qg5ldhnyb9z7k0jmxhmd2f34x4xbwv6vsljs9vr02pd8";
112
});
113
+
dbus = appendPatch super.dbus ./patches/fix-dbus-for-ghc-8.10.x.patch;
114
115
# https://github.com/ndmitchell/hlint/issues/959
116
hlint = super.hlint.override {
+383
pkgs/development/haskell-modules/patches/fix-dbus-for-ghc-8.10.x.patch
+383
pkgs/development/haskell-modules/patches/fix-dbus-for-ghc-8.10.x.patch
···
···
1
+
Only in dbus-1.2.13-new: .codeclimate.yml
2
+
diff -ur dbus-1.2.13-old/dbus.cabal dbus-1.2.13-new/dbus.cabal
3
+
--- dbus-1.2.13-old/dbus.cabal 2020-04-25 19:29:27.372272952 +0200
4
+
+++ dbus-1.2.13-new/dbus.cabal 2020-04-25 19:26:36.140991920 +0200
5
+
@@ -1,172 +1,180 @@
6
+
-cabal-version: >=1.8
7
+
name: dbus
8
+
version: 1.2.13
9
+
license: Apache-2.0
10
+
license-file: license.txt
11
+
-maintainer: Andrey Sverdlichenko <blaze@ruddy.ru>
12
+
author: John Millikin <john@john-millikin.com>
13
+
+maintainer: Andrey Sverdlichenko <blaze@ruddy.ru>
14
+
+build-type: Simple
15
+
+cabal-version: >= 1.8
16
+
+category: Network, Desktop
17
+
stability: experimental
18
+
homepage: https://github.com/rblaze/haskell-dbus#readme
19
+
+
20
+
synopsis: A client library for the D-Bus IPC system.
21
+
description:
22
+
- D-Bus is a simple, message-based protocol for inter-process
23
+
- communication, which allows applications to interact with other parts of
24
+
- the machine and the user's session using remote procedure calls.
25
+
- .
26
+
- D-Bus is a essential part of the modern Linux desktop, where it replaces
27
+
- earlier protocols such as CORBA and DCOP.
28
+
- .
29
+
- This library is an implementation of the D-Bus protocol in Haskell. It
30
+
- can be used to add D-Bus support to Haskell applications, without the
31
+
- awkward interfaces common to foreign bindings.
32
+
- .
33
+
- Example: connect to the session bus, and get a list of active names.
34
+
- .
35
+
- @
36
+
- {-\# LANGUAGE OverloadedStrings \#-}
37
+
- .
38
+
- import Data.List (sort)
39
+
- import DBus
40
+
- import DBus.Client
41
+
- .
42
+
- main = do
43
+
-   client <- connectSession
44
+
-   //
45
+
-   \-- Request a list of connected clients from the bus
46
+
-   reply <- call_ client (methodCall \"\/org\/freedesktop\/DBus\" \"org.freedesktop.DBus\" \"ListNames\")
47
+
-   { methodCallDestination = Just \"org.freedesktop.DBus\"
48
+
-   }
49
+
-   //
50
+
-   \-- org.freedesktop.DBus.ListNames() returns a single value, which is
51
+
-   \-- a list of names (here represented as [String])
52
+
-   let Just names = fromVariant (methodReturnBody reply !! 0)
53
+
-   //
54
+
-   \-- Print each name on a line, sorted so reserved names are below
55
+
-   \-- temporary names.
56
+
-   mapM_ putStrLn (sort names)
57
+
- @
58
+
- .
59
+
- >$ ghc --make list-names.hs
60
+
- >$ ./list-names
61
+
- >:1.0
62
+
- >:1.1
63
+
- >:1.10
64
+
- >:1.106
65
+
- >:1.109
66
+
- >:1.110
67
+
- >ca.desrt.dconf
68
+
- >org.freedesktop.DBus
69
+
- >org.freedesktop.Notifications
70
+
- >org.freedesktop.secrets
71
+
- >org.gnome.ScreenSaver
72
+
-category: Network, Desktop
73
+
-build-type: Simple
74
+
+ D-Bus is a simple, message-based protocol for inter-process
75
+
+ communication, which allows applications to interact with other parts of
76
+
+ the machine and the user's session using remote procedure calls.
77
+
+ .
78
+
+ D-Bus is a essential part of the modern Linux desktop, where it replaces
79
+
+ earlier protocols such as CORBA and DCOP.
80
+
+ .
81
+
+ This library is an implementation of the D-Bus protocol in Haskell. It
82
+
+ can be used to add D-Bus support to Haskell applications, without the
83
+
+ awkward interfaces common to foreign bindings.
84
+
+ .
85
+
+ Example: connect to the session bus, and get a list of active names.
86
+
+ .
87
+
+ @
88
+
+ {-\# LANGUAGE OverloadedStrings \#-}
89
+
+ .
90
+
+ import Data.List (sort)
91
+
+ import DBus
92
+
+ import DBus.Client
93
+
+ .
94
+
+ main = do
95
+
+   client <- connectSession
96
+
+  
97
+
+   -- Request a list of connected clients from the bus
98
+
+   reply <- call_ client (methodCall \"\/org\/freedesktop\/DBus\" \"org.freedesktop.DBus\" \"ListNames\")
99
+
+   { methodCallDestination = Just \"org.freedesktop.DBus\"
100
+
+   }
101
+
+  
102
+
+   -- org.freedesktop.DBus.ListNames() returns a single value, which is
103
+
+   -- a list of names (here represented as [String])
104
+
+   let Just names = fromVariant (methodReturnBody reply !! 0)
105
+
+  
106
+
+   -- Print each name on a line, sorted so reserved names are below
107
+
+   -- temporary names.
108
+
+   mapM_ putStrLn (sort names)
109
+
+ @
110
+
+ .
111
+
+ >$ ghc --make list-names.hs
112
+
+ >$ ./list-names
113
+
+ >:1.0
114
+
+ >:1.1
115
+
+ >:1.10
116
+
+ >:1.106
117
+
+ >:1.109
118
+
+ >:1.110
119
+
+ >ca.desrt.dconf
120
+
+ >org.freedesktop.DBus
121
+
+ >org.freedesktop.Notifications
122
+
+ >org.freedesktop.secrets
123
+
+ >org.gnome.ScreenSaver
124
+
+
125
+
+
126
+
extra-source-files:
127
+
- examples/dbus-monitor.hs
128
+
- examples/export.hs
129
+
- examples/introspect.hs
130
+
- examples/list-names.hs
131
+
- idlxml/dbus.xml
132
+
+ examples/dbus-monitor.hs
133
+
+ examples/export.hs
134
+
+ examples/introspect.hs
135
+
+ examples/list-names.hs
136
+
+ idlxml/dbus.xml
137
+
138
+
source-repository head
139
+
- type: git
140
+
- location: https://github.com/rblaze/haskell-dbus
141
+
+ type: git
142
+
+ location: https://github.com/rblaze/haskell-dbus
143
+
144
+
library
145
+
- exposed-modules:
146
+
- DBus
147
+
- DBus.Client
148
+
- DBus.Generation
149
+
- DBus.Internal.Address
150
+
- DBus.Internal.Message
151
+
- DBus.Internal.Types
152
+
- DBus.Internal.Wire
153
+
- DBus.Introspection
154
+
- DBus.Introspection.Parse
155
+
- DBus.Introspection.Render
156
+
- DBus.Introspection.Types
157
+
- DBus.Socket
158
+
- DBus.TH
159
+
- DBus.Transport
160
+
- hs-source-dirs: lib
161
+
- ghc-options: -W -Wall
162
+
- build-depends:
163
+
- base ==4.*,
164
+
- bytestring <0.11,
165
+
- cereal <0.6,
166
+
- conduit >=1.3.0 && <1.4,
167
+
- containers <0.7,
168
+
- deepseq <1.5,
169
+
- exceptions <0.11,
170
+
- filepath <1.5,
171
+
- lens <4.20,
172
+
- network >=3.0.1.0 && <3.2,
173
+
- parsec <3.2,
174
+
- random <1.2,
175
+
- split <0.3,
176
+
- template-haskell <2.16.0.0,
177
+
- text <1.3,
178
+
- th-lift <0.9,
179
+
- transformers <0.6,
180
+
- unix <2.8,
181
+
- vector <0.13,
182
+
- xml-conduit >=1.9.0.0 && <1.10.0.0,
183
+
- xml-types <0.4
184
+
+ ghc-options: -W -Wall
185
+
+ hs-source-dirs: lib
186
+
+
187
+
+ build-depends:
188
+
+ base >=4 && <5
189
+
+ , bytestring
190
+
+ , cereal
191
+
+ , conduit >= 1.3.0
192
+
+ , containers
193
+
+ , deepseq
194
+
+ , exceptions
195
+
+ , filepath
196
+
+ , lens < 4.20
197
+
+ , network >= 3.0.1.0 && < 3.2
198
+
+ , parsec
199
+
+ , random
200
+
+ , split
201
+
+ , template-haskell < 2.17.0.0
202
+
+ , text
203
+
+ , th-lift < 0.9
204
+
+ , transformers
205
+
+ , unix
206
+
+ , vector
207
+
+ , xml-conduit >= 1.9.0.0 && < 1.10.0.0
208
+
+ , xml-types
209
+
+
210
+
+ exposed-modules:
211
+
+ DBus
212
+
+ DBus.Client
213
+
+ DBus.Generation
214
+
+ DBus.Internal.Address
215
+
+ DBus.Internal.Message
216
+
+ DBus.Internal.Types
217
+
+ DBus.Internal.Wire
218
+
+ DBus.Introspection
219
+
+ DBus.Introspection.Parse
220
+
+ DBus.Introspection.Render
221
+
+ DBus.Introspection.Types
222
+
+ DBus.Socket
223
+
+ DBus.TH
224
+
+ DBus.Transport
225
+
226
+
test-suite dbus_tests
227
+
- type: exitcode-stdio-1.0
228
+
- main-is: DBusTests.hs
229
+
- hs-source-dirs: tests
230
+
- other-modules:
231
+
- DBusTests.Address
232
+
- DBusTests.BusName
233
+
- DBusTests.Client
234
+
- DBusTests.ErrorName
235
+
- DBusTests.Generation
236
+
- DBusTests.Integration
237
+
- DBusTests.InterfaceName
238
+
- DBusTests.Introspection
239
+
- DBusTests.MemberName
240
+
- DBusTests.Message
241
+
- DBusTests.ObjectPath
242
+
- DBusTests.Serialization
243
+
- DBusTests.Signature
244
+
- DBusTests.Socket
245
+
- DBusTests.TH
246
+
- DBusTests.Transport
247
+
- DBusTests.Util
248
+
- DBusTests.Variant
249
+
- DBusTests.Wire
250
+
- ghc-options: -W -Wall -fno-warn-orphans
251
+
- build-depends:
252
+
- dbus -any,
253
+
- base ==4.*,
254
+
- bytestring <0.11,
255
+
- cereal <0.6,
256
+
- containers <0.7,
257
+
- directory <1.4,
258
+
- extra <1.8,
259
+
- filepath <1.5,
260
+
- network >=3.0.1.0 && <3.2,
261
+
- parsec <3.2,
262
+
- process <1.7,
263
+
- QuickCheck <2.15,
264
+
- random <1.2,
265
+
- resourcet <1.3,
266
+
- tasty <1.3,
267
+
- tasty-hunit <0.11,
268
+
- tasty-quickcheck <0.11,
269
+
- text <1.3,
270
+
- transformers <0.6,
271
+
- unix <2.8,
272
+
- vector <0.13
273
+
+ type: exitcode-stdio-1.0
274
+
+ main-is: DBusTests.hs
275
+
+ hs-source-dirs: tests
276
+
+ ghc-options: -W -Wall -fno-warn-orphans
277
+
+
278
+
+ build-depends:
279
+
+ dbus
280
+
+ , base >=4 && <5
281
+
+ , bytestring
282
+
+ , cereal
283
+
+ , containers
284
+
+ , directory
285
+
+ , extra < 1.8
286
+
+ , filepath
287
+
+ , network >= 3.0.1.0 && < 3.2
288
+
+ , parsec
289
+
+ , process
290
+
+ , QuickCheck < 2.15
291
+
+ , random
292
+
+ , resourcet
293
+
+ , tasty
294
+
+ , tasty-hunit
295
+
+ , tasty-quickcheck
296
+
+ , text
297
+
+ , transformers
298
+
+ , unix
299
+
+ , vector
300
+
+
301
+
+ other-modules:
302
+
+ DBusTests.Address
303
+
+ DBusTests.BusName
304
+
+ DBusTests.Client
305
+
+ DBusTests.ErrorName
306
+
+ DBusTests.Generation
307
+
+ DBusTests.Integration
308
+
+ DBusTests.InterfaceName
309
+
+ DBusTests.Introspection
310
+
+ DBusTests.MemberName
311
+
+ DBusTests.Message
312
+
+ DBusTests.ObjectPath
313
+
+ DBusTests.Serialization
314
+
+ DBusTests.Signature
315
+
+ DBusTests.Socket
316
+
+ DBusTests.TH
317
+
+ DBusTests.Transport
318
+
+ DBusTests.Util
319
+
+ DBusTests.Variant
320
+
+ DBusTests.Wire
321
+
322
+
benchmark dbus_benchmarks
323
+
- type: exitcode-stdio-1.0
324
+
- main-is: DBusBenchmarks.hs
325
+
- hs-source-dirs: benchmarks
326
+
- ghc-options: -Wall -fno-warn-orphans
327
+
- build-depends:
328
+
- dbus -any,
329
+
- base ==4.*,
330
+
- criterion <1.6
331
+
+ type: exitcode-stdio-1.0
332
+
+ main-is: DBusBenchmarks.hs
333
+
+ hs-source-dirs: benchmarks
334
+
+ ghc-options: -Wall -fno-warn-orphans
335
+
+
336
+
+ build-depends:
337
+
+ dbus
338
+
+ , base >=4 && <5
339
+
+ , criterion
340
+
Only in dbus-1.2.13-new: .git
341
+
Only in dbus-1.2.13-new: .gitignore
342
+
diff -ur dbus-1.2.13-old/lib/DBus/Generation.hs dbus-1.2.13-new/lib/DBus/Generation.hs
343
+
--- dbus-1.2.13-old/lib/DBus/Generation.hs 2019-02-14 16:37:47.000000000 +0100
344
+
+++ dbus-1.2.13-new/lib/DBus/Generation.hs 2020-04-25 19:26:36.144991997 +0200
345
+
@@ -1,3 +1,4 @@
346
+
+{-# LANGUAGE CPP #-}
347
+
{-# LANGUAGE OverloadedStrings #-}
348
+
{-# LANGUAGE TemplateHaskell #-}
349
+
module DBus.Generation where
350
+
@@ -26,6 +27,13 @@
351
+
import Prelude hiding (mapM)
352
+
import System.Posix.Types (Fd(..))
353
+
354
+
+-- | Compatibility helper to create (total) tuple expressions
355
+
+mkTupE :: [Exp] -> Exp
356
+
+mkTupE = TupE
357
+
+#if MIN_VERSION_template_haskell(2,16,0)
358
+
+ . map Just
359
+
+#endif
360
+
+
361
+
type ClientBusPathR a = ReaderT (Client, T.BusName, T.ObjectPath) IO a
362
+
363
+
dbusInvoke :: (Client -> T.BusName -> T.ObjectPath -> a) -> ClientBusPathR a
364
+
@@ -232,8 +240,8 @@
365
+
finalOutputNames <- buildOutputNames
366
+
let variantListExp = map makeToVariantApp methodArgNames
367
+
mapOrHead' = mapOrHead outputLength
368
+
- fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames TupE
369
+
- finalResultTuple = mapOrHead' VarE finalOutputNames TupE
370
+
+ fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames mkTupE
371
+
+ finalResultTuple = mapOrHead' VarE finalOutputNames mkTupE
372
+
maybeExtractionPattern = mapOrHead' makeJustPattern finalOutputNames TupP
373
+
getMethodCallDefDec = [d|
374
+
$( varP methodCallDefN ) =
375
+
@@ -432,7 +440,7 @@
376
+
}
377
+
|]
378
+
let mapOrHead' = mapOrHead argCount
379
+
- fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames TupE
380
+
+ fromVariantExp = mapOrHead' makeFromVariantApp fromVariantOutputNames mkTupE
381
+
maybeExtractionPattern = mapOrHead' makeJustPattern toHandlerOutputNames TupP
382
+
applyToName toApply n = AppE toApply $ VarE n
383
+
finalApplication = foldl applyToName (VarE handlerArgN)