1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
{-
Bustle.VariantFormatter: produces GVariant strings representing D-Bus values
Copyright © 2011 Will Thompson
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
-}
module Bustle.VariantFormatter
( format_Variant
, VariantStyle(..)
)
where
import Data.Word
import Data.Int
import Data.List (intercalate)
import Data.Char (chr, isPrint)
-- :'(
import Data.Maybe (fromJust)
import qualified Data.Text.Lazy as Text
import DBus.Types
format_Bool :: Bool -> String
format_Bool = show
format_Word8 :: Word8 -> String
format_Word8 = show
format_ByteArray :: Array -> String
format_ByteArray ay =
if all (\y -> isPrint (chr (fromIntegral y))) bytes
then show (map (chr . fromIntegral) bytes :: String)
else format_Array ay
where
bytes = map (fromJust . fromVariant) (arrayItems ay) :: [Word8]
format_Int16 :: Int16 -> String
format_Int16 = show
format_Int32 :: Int32 -> String
format_Int32 = show
format_Int64 :: Int64 -> String
format_Int64 = show
format_Word16 :: Word16 -> String
format_Word16 = show
format_Word32 :: Word32 -> String
format_Word32 = show
format_Word64 :: Word64 -> String
format_Word64 = show
format_Double :: Double -> String
format_Double = show
format_String :: String -> String
format_String = show
format_Signature :: Signature -> String
format_Signature = show . signatureText
format_ObjectPath :: ObjectPath -> String
format_ObjectPath = show . objectPathText
format_Array :: Array -> String
format_Array a = "[" ++ intercalate ", " items ++ "]"
where
items = map (format_Variant VariantStyleBare) $ arrayItems a
format_Dictionary :: Dictionary -> String
format_Dictionary d = "{" ++ intercalate ", " items ++ "}"
where
items = map (\(k, v) -> format_Variant VariantStyleBare k ++ ": " ++ format_Variant VariantStyleBare v) $ dictionaryItems d
-- FIXME…
format_Structure :: Structure -> String
format_Structure s = case structureItems s of
[] -> "()"
[v] -> "(" ++ format_Variant VariantStyleBare v ++ ",)"
vs -> "(" ++ intercalate ", " items ++ ")"
where
items = map (format_Variant VariantStyleBare) vs
data VariantStyle =
VariantStyleBare
| VariantStyleSignature
| VariantStyleAngleBrackets
-- why did you remove typeCode from the public API, John…
typeCode :: Type -> String
typeCode TypeBoolean = "b"
typeCode TypeWord8 = "y"
typeCode TypeWord16 = "q"
typeCode TypeWord32 = "u"
typeCode TypeWord64 = "t"
typeCode TypeInt16 = "n"
typeCode TypeInt32 = "i"
typeCode TypeInt64 = "x"
typeCode TypeDouble = "d"
typeCode TypeString = "s"
typeCode TypeSignature = "g"
typeCode TypeObjectPath = "o"
typeCode TypeVariant = "v"
typeCode (TypeArray t) = 'a':typeCode t
typeCode (TypeDictionary kt vt) = concat [ "a{", typeCode kt , typeCode vt, "}"]
typeCode (TypeStructure ts) = concat ["(", concatMap typeCode ts, ")"]
format_Variant :: VariantStyle -> Variant -> String
format_Variant style v =
case style of
VariantStyleBare -> formatted
VariantStyleSignature -> typeSignature ++ " " ++ formatted
VariantStyleAngleBrackets -> "<" ++ typeSignature ++ " " ++ formatted ++ ">"
where
ty = variantType v
typeSignature = ('@':) . typeCode $ ty
format = case ty of
TypeBoolean -> format_Bool . fromJust . fromVariant
TypeInt16 -> format_Int16 . fromJust . fromVariant
TypeInt32 -> format_Int32 . fromJust . fromVariant
TypeInt64 -> format_Int64 . fromJust . fromVariant
TypeWord8 -> format_Word8 . fromJust . fromVariant
TypeWord16 -> format_Word16 . fromJust . fromVariant
TypeWord32 -> format_Word32 . fromJust . fromVariant
TypeWord64 -> format_Word64 . fromJust . fromVariant
TypeDouble -> format_Double . fromJust . fromVariant
TypeString -> format_String . fromJust . fromVariant
TypeSignature -> format_Signature . fromJust . fromVariant
TypeObjectPath -> format_ObjectPath . fromJust . fromVariant
TypeVariant -> format_Variant VariantStyleAngleBrackets . fromJust . fromVariant
TypeArray TypeWord8 -> format_ByteArray . fromJust . fromVariant
TypeArray _ -> format_Array . fromJust . fromVariant
TypeDictionary _ _ -> format_Dictionary . fromJust . fromVariant
TypeStructure _ -> format_Structure . fromJust . fromVariant
formatted = format v
|
