File: VariantFormatter.hs

package info (click to toggle)
bustle 0.7.4-1
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 720 kB
  • sloc: haskell: 3,938; ansic: 939; makefile: 110; sh: 8
file content (150 lines) | stat: -rw-r--r-- 5,103 bytes parent folder | download | duplicates (2)
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
147
148
149
150
{-
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 DBus

format_Bool :: Bool -> String
format_Bool = show

format_Word8 :: Word8 -> String
format_Word8 = show

format_ByteArray :: Array -> String
format_ByteArray ay =
    if all isPrintish chars
        then 'b':show chars
        else format_Array ay
  where
    bytes = map (fromJust . fromVariant) (arrayItems ay) :: [Word8]
    chars = map (chr . fromIntegral) bytes
    isPrintish '\0' = True
    isPrintish c    = isPrint c


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 . formatSignature

format_ObjectPath :: ObjectPath -> String
format_ObjectPath = show . formatObjectPath

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 TypeUnixFd     = "h"
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
        TypeUnixFd -> const "<fd>"
        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