:# Copyright (C) 2009-2010 John Millikin :# :# This program is free software: you can redistribute it and/or modify :# it under the terms of the GNU General Public License as published by :# the Free Software Foundation, either version 3 of the License, or :# any later version. :# :# This program 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 General Public License for more details. :# :# You should have received a copy of the GNU General Public License :# along with this program. If not, see . \section{Types} The {\tt DBus.Types module} defines interfaces for storing, building, and deconstructing D-Bus values. Everything is defined in an internal module, and then exported via the public interface. :f DBus/Types.hs |copyright| module DBus.Types ( |type exports| ) where import DBus.Types.Internal : :f DBus/Types/Internal.cpphs |copyright| |text extensions| |type extensions| module DBus.Types.Internal where |text imports| |type imports| import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as BL8 : D-Bus types are divided into two categories, ``atomic'' and ``container'' types. Atoms are actual values -- strings, numbers, etc. Containers store atoms and other containers. The most interesting difference between the two is that atoms may be used as the keys in associative mappings (``dictionaries''). Internally, types are represented using an enumeration. :f DBus/Types/Internal.cpphs data Type = DBusBoolean | DBusByte | DBusInt16 | DBusInt32 | DBusInt64 | DBusWord16 | DBusWord32 | DBusWord64 | DBusDouble | DBusString | DBusSignature | DBusObjectPath | DBusVariant | DBusArray Type | DBusDictionary Type Type | DBusStructure [Type] deriving (Show, Eq) : :f DBus/Types/Internal.cpphs |apidoc isAtomicType| isAtomicType :: Type -> Bool isAtomicType DBusBoolean = True isAtomicType DBusByte = True isAtomicType DBusInt16 = True isAtomicType DBusInt32 = True isAtomicType DBusInt64 = True isAtomicType DBusWord16 = True isAtomicType DBusWord32 = True isAtomicType DBusWord64 = True isAtomicType DBusDouble = True isAtomicType DBusString = True isAtomicType DBusSignature = True isAtomicType DBusObjectPath = True isAtomicType _ = False : Each type can be converted to a textual representation, used in ``type signatures'' or for debugging. :f DBus/Types/Internal.cpphs |apidoc typeCode| typeCode :: Type -> Text |type codes| : :d type exports -- * Available types Type (..) , typeCode : :f Tests.hs instance Arbitrary Type where arbitrary = oneof [atomicType, containerType] atomicType :: Gen Type atomicType = elements [ DBusBoolean , DBusByte , DBusWord16 , DBusWord32 , DBusWord64 , DBusInt16 , DBusInt32 , DBusInt64 , DBusDouble , DBusString , DBusObjectPath , DBusSignature ] containerType :: Gen Type containerType = do c <- choose (0,3) :: Gen Int case c of 0 -> fmap DBusArray arbitrary 1 -> do kt <- atomicType vt <- arbitrary return $ DBusDictionary kt vt 2 -> fmap DBusStructure $ halfSized arbitrary 3 -> return DBusVariant : \subsection{Variants} A wrapper type is needed for safely storing generic D-Bus values in Haskell. The D-Bus ``variant'' type is perfect for this, because variants may store any D-Bus value. Any type which is an instance of {\tt Variable} is considered a valid D-Bus value, because it can be used to construct {\tt Variant}s. However, outside of this module, {\tt Variant}s can only be constructed from pre-defined types. :f DBus/Types/Internal.cpphs |apidoc Variant| data Variant = VarBoxBool Bool | VarBoxWord8 Word8 | VarBoxInt16 Int16 | VarBoxInt32 Int32 | VarBoxInt64 Int64 | VarBoxWord16 Word16 | VarBoxWord32 Word32 | VarBoxWord64 Word64 | VarBoxDouble Double | VarBoxString Text | VarBoxSignature Signature | VarBoxObjectPath ObjectPath | VarBoxVariant Variant | VarBoxArray Array | VarBoxDictionary Dictionary | VarBoxStructure Structure deriving (Eq) class Variable a where toVariant :: a -> Variant fromVariant :: Variant -> Maybe a : :d type exports -- * Variants , Variant , Variable (..) : Variants can be printed, for debugging purposes -- this instance shouldn't be parsed or inspected or anything like that, since the output format might change drastically. :f DBus/Types/Internal.cpphs instance Show Variant where showsPrec d var = showParen (d > 10) full where full = s "Variant " . shows code . s " " . valueStr code = typeCode $ variantType var s = showString valueStr = showsPrecVar 11 var showsPrecVar :: Int -> Variant -> ShowS showsPrecVar d var = case var of (VarBoxBool x) -> showsPrec d x (VarBoxWord8 x) -> showsPrec d x (VarBoxInt16 x) -> showsPrec d x (VarBoxInt32 x) -> showsPrec d x (VarBoxInt64 x) -> showsPrec d x (VarBoxWord16 x) -> showsPrec d x (VarBoxWord32 x) -> showsPrec d x (VarBoxWord64 x) -> showsPrec d x (VarBoxDouble x) -> showsPrec d x (VarBoxString x) -> showsPrec d x (VarBoxSignature x) -> showsPrec d x (VarBoxObjectPath x) -> showsPrec d x (VarBoxVariant x) -> showsPrec d x (VarBoxArray x) -> showsPrec d x (VarBoxDictionary x) -> showsPrec d x (VarBoxStructure x) -> showsPrec d x : Since many operations on D-Bus values depend on having the correct type, {\tt variantType} is used to retrieve which type is actually stored within a {\tt Variant}. :f DBus/Types/Internal.cpphs |apidoc variantType| variantType :: Variant -> Type variantType var = case var of (VarBoxBool _) -> DBusBoolean (VarBoxWord8 _) -> DBusByte (VarBoxInt16 _) -> DBusInt16 (VarBoxInt32 _) -> DBusInt32 (VarBoxInt64 _) -> DBusInt64 (VarBoxWord16 _) -> DBusWord16 (VarBoxWord32 _) -> DBusWord32 (VarBoxWord64 _) -> DBusWord64 (VarBoxDouble _) -> DBusDouble (VarBoxString _) -> DBusString (VarBoxSignature _) -> DBusSignature (VarBoxObjectPath _) -> DBusObjectPath (VarBoxVariant _) -> DBusVariant (VarBoxArray x) -> DBusArray (arrayType x) (VarBoxDictionary x) -> let keyT = dictionaryKeyType x valueT = dictionaryValueType x in DBusDictionary keyT valueT (VarBoxStructure x) -> let Structure items = x in DBusStructure (map variantType items) variantSignature :: Variant -> Maybe Signature variantSignature = mkBytesSignature . typeCodeB . variantType : :d type exports , variantType : A macro is useful for reducing verbosity in simple {\tt Variable} instances. :f DBus/Types/Internal.cpphs #define INSTANCE_VARIABLE(TYPE) \ instance Variable TYPE where \ { toVariant = VarBox/**/TYPE \ ; fromVariant (VarBox/**/TYPE x) = Just x \ ; fromVariant _ = Nothing \ } : Since {\tt Variant}s are D-Bus values themselves, they can be stored in variants. :f DBus/Types/Internal.cpphs INSTANCE_VARIABLE(Variant) : For testing, {\tt Variant}s are usually generated by type. :f Tests.hs instance Arbitrary Variant where arbitrary = arbitrary >>= genVariant genVariant :: Type -> Gen Variant genVariant t = case t of DBusBoolean -> fmap toVariant (arbitrary :: Gen Bool) DBusByte -> fmap toVariant (arbitrary :: Gen Word8) DBusWord16 -> fmap toVariant (arbitrary :: Gen Word16) DBusWord32 -> fmap toVariant (arbitrary :: Gen Word32) DBusWord64 -> fmap toVariant (arbitrary :: Gen Word64) DBusInt16 -> fmap toVariant (arbitrary :: Gen Int16) DBusInt32 -> fmap toVariant (arbitrary :: Gen Int32) DBusInt64 -> fmap toVariant (arbitrary :: Gen Int64) DBusDouble -> fmap toVariant (arbitrary :: Gen Double) DBusString -> fmap toVariant (arbitrary :: Gen String) DBusObjectPath -> fmap toVariant (arbitrary :: Gen ObjectPath) DBusSignature -> fmap toVariant (arbitrary :: Gen Signature) (DBusArray _) -> fmap toVariant (arbitrary :: Gen Array) (DBusDictionary _ _) -> fmap toVariant (arbitrary :: Gen Dictionary) (DBusStructure _) -> fmap toVariant (arbitrary :: Gen Structure) DBusVariant -> fmap toVariant (arbitrary :: Gen Variant) : \subsection{Numerics} D-Bus supports most common numeric types: \begin{table}[h] \caption{D-Bus Numeric types} \begin{center} \begin{tabular}{ll} \toprule Type & Description \\ \midrule Boolean & Either {\tt True} or {\tt False} \\ Byte & 8-bit unsigned integer \\ Int16 & 16-bit signed integer \\ Int32 & 32-bit signed integer \\ Int64 & 64-bit signed integer \\ Word16 & 16-bit unsigned integer \\ Word32 & 32-bit unsigned integer \\ Word64 & 64-bit unsigned integer \\ Double & 64-bit IEEE754 floating-point \\ \bottomrule \end{tabular} \end{center} \end{table} All D-Bus numeric types are fixed-length, so the {\tt Int} and {\tt Integer} types can't be used. Instead, instances for the fixed-length integer types are defined and any others will have to be converted. :d type imports import Data.Word (Word8, Word16, Word32, Word64) import Data.Int (Int16, Int32, Int64) : :f DBus/Types/Internal.cpphs INSTANCE_VARIABLE(Bool) INSTANCE_VARIABLE(Word8) INSTANCE_VARIABLE(Int16) INSTANCE_VARIABLE(Int32) INSTANCE_VARIABLE(Int64) INSTANCE_VARIABLE(Word16) INSTANCE_VARIABLE(Word32) INSTANCE_VARIABLE(Word64) INSTANCE_VARIABLE(Double) : \subsection{Strings} Strings are a weird case; the built-in type, {\tt String}, is horribly inefficent. To provide better performance for large strings, packed Unicode strings defined in {\tt Data.Text} are used internally. :f DBus/Types/Internal.cpphs instance Variable TL.Text where toVariant = VarBoxString fromVariant (VarBoxString x) = Just x fromVariant _ = Nothing : There's two different {\tt Text} types, strict and lazy. It'd be a pain to store both and have to convert later, so instead, all strict {\tt Text} values are converted to lazy values. :d type imports import qualified Data.Text as T : :f DBus/Types/Internal.cpphs instance Variable T.Text where toVariant = toVariant . TL.fromChunks . (:[]) fromVariant = fmap (T.concat . TL.toChunks) . fromVariant : Built-in {\tt String}s can still be stored, of course, but it requires a language extension. :d type extensions {-# LANGUAGE TypeSynonymInstances #-} : :f DBus/Types/Internal.cpphs instance Variable String where toVariant = toVariant . TL.pack fromVariant = fmap TL.unpack . fromVariant : All this is verified using some QuickCheck properties :d test cases , F.testGroup "String" [ testProperty "String -> strict Text" $ funEq (fromVariant . toVariant) (Just . T.pack) , testProperty "String <- strict Text" $ funEq (fromVariant . toVariant) (Just . T.unpack) , testProperty "String -> lazy Text" $ funEq (fromVariant . toVariant) (Just . TL.pack) , testProperty "String <- lazy Text" $ funEq (fromVariant . toVariant) (Just . TL.unpack) , testProperty "Strict Text -> lazy Text" $ funEq (fromVariant . toVariant) (Just . TL.pack . T.unpack) , testProperty "Strict Text <- lazy Text" $ funEq (fromVariant . toVariant) (Just . T.pack . TL.unpack) ] : \subsection{Signatures} Valid D-Bus types must obey certain rules, such as ``dict keys must be atomic'', which are difficult to express in the Haskell type system. A {\tt Signature} is guaranteed to be valid according to these rules. Creating one requires using the {\tt mkSignature} function, which will convert a valid D-Bus signature string into a {\tt Signature}. :f DBus/Types/Internal.cpphs INSTANCE_VARIABLE(Signature) data Signature = Signature { signatureTypes :: [Type] } deriving (Eq) instance Show Signature where showsPrec d x = showParen (d > 10) $ showString "Signature " . shows (strSignature x) : Signatures can also be converted back into text, by concatenating the type codes of their contained types. :f DBus/Types/Internal.cpphs bytesSignature :: Signature -> B.ByteString bytesSignature (Signature ts) = B.concat $ map typeCodeB ts strSignature :: Signature -> Text strSignature (Signature ts) = TL.concat $ map typeCode ts : It doesn't make much sense to sort signatures, but since they can be used as dictionary keys, it's useful to have them as an instance of {\tt Ord}. :d type imports import Data.Ord (comparing) : :f DBus/Types/Internal.cpphs instance Ord Signature where compare = comparing strSignature : :d type exports -- * Signatures , Signature , signatureTypes , strSignature : \subsubsection{Type codes} For atomic types, the type code is a single letter. Arrays, structures, and dictionary types are multiple characters. :d type imports import Data.Text.Encoding (decodeUtf8) : :d type codes typeCode t = TL.fromChunks [decodeUtf8 $ typeCodeB t] typeCodeB :: Type -> B.ByteString typeCodeB DBusBoolean = "b" typeCodeB DBusByte = "y" typeCodeB DBusInt16 = "n" typeCodeB DBusInt32 = "i" typeCodeB DBusInt64 = "x" typeCodeB DBusWord16 = "q" typeCodeB DBusWord32 = "u" typeCodeB DBusWord64 = "t" typeCodeB DBusDouble = "d" typeCodeB DBusString = "s" typeCodeB DBusSignature = "g" typeCodeB DBusObjectPath = "o" typeCodeB DBusVariant = "v" : An array's type code is ``a'' followed by the type it contains. For example, an array of booleans would have the type string ``ab''. :d type codes typeCodeB (DBusArray t) = B8.cons 'a' $ typeCodeB t : A dictionary's type code is ``a\{$key\_type$ $value\_type$\}''. For example, a dictionary of bytes to booleans would have the type string ``a\{yb\}''. :d type codes typeCodeB (DBusDictionary k v) = B.concat ["a{", typeCodeB k, typeCodeB v, "}"] : A structure's type code is the concatenation of its contained types, wrapped by ``('' and ``)''. Structures may be empty, in which case their type code is simply ``()''. :d type codes typeCodeB (DBusStructure ts) = B.concat $ ["("] ++ map typeCodeB ts ++ [")"] : \subsubsection{Parsing} When parsing, additional restrictions apply which are not inherent to the D-Bus type system. The signature parsing functions guarantee that any {\tt Signature} is valid according to D-Bus rules. Signature parsing is the most common operation when unmarshaling messages; therefore, an efficient parsing implementation is essential. Since all valid signatures as entirely ASCII, it's possible to parse them using byte-based parsers for better performance. These aren't exported from the public interface, but are still used within {\tt DBus.Wire} modules. :d type imports import qualified Data.ByteString.Unsafe as B import qualified Foreign as F import System.IO.Unsafe (unsafePerformIO) : There are three special cases which can be optimized: \begin{enumerate} \item Empty signatures occur when messages have no body, and can use a constant result. \item Single-character signatures occur when parsing variants, and can use a faster atom-only parser. \item Signatures larger than 255 characters are invalid. \end{enumerate} :f DBus/Types/Internal.cpphs mkBytesSignature :: B.ByteString -> Maybe Signature mkBytesSignature = unsafePerformIO . flip B.unsafeUseAsCStringLen io where |fast signature parser| |slow signature parser| io (cstr, len) = case len of 0 -> return $ Just $ Signature [] 1 -> fmap fast $ F.peek cstr _ | len <= 255 -> slow (F.castPtr cstr) len _ -> return Nothing : :d fast signature parser parseAtom c yes no = case c of 0x62 -> yes DBusBoolean 0x79 -> yes DBusByte 0x6E -> yes DBusInt16 0x69 -> yes DBusInt32 0x78 -> yes DBusInt64 0x71 -> yes DBusWord16 0x75 -> yes DBusWord32 0x74 -> yes DBusWord64 0x64 -> yes DBusDouble 0x73 -> yes DBusString 0x67 -> yes DBusSignature 0x6F -> yes DBusObjectPath _ -> no fast c = parseAtom c (\t -> Just (Signature [t])) $ case c of 0x76 -> Just (Signature [DBusVariant]) _ -> Nothing : :d slow signature parser slow :: F.Ptr Word8 -> Int -> IO (Maybe Signature) slow buf len = loop [] 0 where loop acc ii | ii >= len = return . Just . Signature $ reverse acc loop acc ii = do c <- F.peekElemOff buf ii let next t = loop (t : acc) (ii + 1) parseAtom c next $ case c of 0x76 -> next DBusVariant -- '(' 0x28 -> do mt <- structure buf len (ii + 1) case mt of Just (ii', t) -> loop (t : acc) ii' Nothing -> return Nothing -- 'a' 0x61 -> do mt <- array buf len (ii + 1) case mt of Just (ii', t) -> loop (t : acc) ii' Nothing -> return Nothing _ -> return Nothing : :d slow signature parser structure :: F.Ptr Word8 -> Int -> Int -> IO (Maybe (Int, Type)) structure buf len = loop [] where loop _ ii | ii >= len = return Nothing loop acc ii = do c <- F.peekElemOff buf ii let next t = loop (t : acc) (ii + 1) parseAtom c next $ case c of 0x76 -> next DBusVariant -- '(' 0x28 -> do mt <- structure buf len (ii + 1) case mt of Just (ii', t) -> loop (t : acc) ii' Nothing -> return Nothing -- ')' 0x29 -> return $ Just $ (ii + 1, DBusStructure (reverse acc)) -- 'a' 0x61 -> do mt <- array buf len (ii + 1) case mt of Just (ii', t) -> loop (t : acc) ii' Nothing -> return Nothing _ -> return Nothing : :d slow signature parser array :: F.Ptr Word8 -> Int -> Int -> IO (Maybe (Int, Type)) array _ len ii | ii >= len = return Nothing array buf len ii = do c <- F.peekElemOff buf ii let next t = return $ Just (ii + 1, DBusArray t) parseAtom c next $ case c of 0x76 -> next DBusVariant -- '(' 0x28 -> do mt <- structure buf len (ii + 1) case mt of Just (ii', t) -> return $ Just (ii', DBusArray t) Nothing -> return Nothing -- '{' 0x7B -> dict buf len (ii + 1) -- 'a' 0x61 -> do mt <- array buf len (ii + 1) case mt of Just (ii', t) -> return $ Just (ii', DBusArray t) Nothing -> return Nothing _ -> return Nothing : :d slow signature parser dict :: F.Ptr Word8 -> Int -> Int -> IO (Maybe (Int, Type)) dict _ len ii | ii + 1 >= len = return Nothing dict buf len ii = do c1 <- F.peekElemOff buf ii c2 <- F.peekElemOff buf (ii + 1) let mt1 = parseAtom c1 Just Nothing let next t = return $ Just (ii + 2, t) mt2 <- parseAtom c2 next $ case c2 of 0x76 -> next DBusVariant -- '(' 0x28 -> structure buf len (ii + 2) -- 'a' 0x61 -> array buf len (ii + 2) _ -> return Nothing case mt2 of Nothing -> return Nothing Just (ii', t2) -> if ii' >= len then return Nothing else do c3 <- F.peekElemOff buf ii' return $ do if c3 == 0x7D then Just () else Nothing t1 <- mt1 Just (ii' + 1, DBusDictionary t1 t2) : The public interface for building signatures is {\tt Text}-based. :d type imports import Data.Text.Lazy.Encoding (encodeUtf8) : :f DBus/Types/Internal.cpphs mkSignature :: Text -> Maybe Signature mkSignature = mkBytesSignature . B.concat . BL.toChunks . encodeUtf8 : Since many signatures are defined as string literals, it's useful to have a helper function to construct a signature directly from a string. If the input string is invalid, {\tt error} will be called. :d type imports import DBus.Util (mkUnsafe) import qualified Data.String as String : :f DBus/Types/Internal.cpphs mkSignature_ :: Text -> Signature mkSignature_ = mkUnsafe "signature" mkSignature instance String.IsString Signature where fromString = mkUnsafe "signature" mkBytesSignature . BL8.pack : Most signature-related functions are exposed to clients, except the {\tt Signature} value constructor. If that were exposed, clients could construct invalid signatures. :d type exports , mkSignature , mkSignature_ : Checking if a type is valid according to signature rules is common, and if performed through the signature parser, slow. Since such types are already guaranteed to be structurally valid, the only test needed is whether their size is within bounds. :f DBus/Types/Internal.cpphs maybeValidType :: Type -> Maybe () maybeValidType t = if B.length (typeCodeB t) > 255 then Nothing else Just () : :f Tests.hs instance Arbitrary Signature where arbitrary = sizedText 255 $ fmap (TL.concat . map typeCode) arbitrary : :d test cases , F.testGroup "Signature" [ testProperty "Signature identity" $ funEq (mkSignature . strSignature) Just ] : \subsection{Object paths} :f DBus/Types/Internal.cpphs INSTANCE_VARIABLE(ObjectPath) newtype ObjectPath = ObjectPath { strObjectPath :: Text } deriving (Eq, Ord) instance Show ObjectPath where showsPrec d (ObjectPath x) = showParen (d > 10) $ showString "ObjectPath " . shows x instance String.IsString ObjectPath where fromString = mkObjectPath_ . TL.pack : An object path may be one of \begin{itemize} \item The root path, {\tt "/"}. \item {\tt '/'}, followed by one or more element names. Each element name contains characters in the set {\tt [a-zA-Z0-9\_]}, and must have at least one character. \end{itemize} Element names are separated by {\tt '/'}, and the path may not end in {\tt '/'} unless it is the root path. :d type imports import Text.ParserCombinators.Parsec ((<|>)) import qualified Text.ParserCombinators.Parsec as P import DBus.Util (checkLength, parseMaybe) : :f DBus/Types/Internal.cpphs mkObjectPath :: Text -> Maybe ObjectPath mkObjectPath s = parseMaybe path' (TL.unpack s) where c = P.oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_" path = P.char '/' >>= P.optional . P.sepBy (P.many1 c) . P.char path' = path >> P.eof >> return (ObjectPath s) mkObjectPath_ :: Text -> ObjectPath mkObjectPath_ = mkUnsafe "object path" mkObjectPath : :d type exports -- * Object paths , ObjectPath , strObjectPath , mkObjectPath , mkObjectPath_ : :f Tests.hs instance Arbitrary ObjectPath where arbitrary = fmap (mkObjectPath_ . TL.pack) path' where c = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_" path = fmap (intercalate "/" . ([] :)) genElements path' = frequency [(1, return "/"), (9, path)] genElements = atLeast 1 (atLeast 1 (elements c)) : :d test cases , F.testGroup "ObjectPath" [ testProperty "ObjectPath identity" $ funEq (mkObjectPath . strObjectPath) Just ] : \subsection{Arrays} Arrays are homogenous sequences of any valid D-Bus type. Arrays might be empty, so the type they contain is stored instead of being calculated from their contents (as in {\tt variantType}). Many D-Bus APIs represent binary data using an array of bytes; therefore, there is a special constructor for {\tt ByteString}-based arrays. :f DBus/Types/Internal.cpphs INSTANCE_VARIABLE(Array) data Array = VariantArray Type [Variant] | ByteArray BL.ByteString deriving (Eq) |apidoc arrayType| arrayType :: Array -> Type arrayType (VariantArray t _) = t arrayType (ByteArray _) = DBusByte arrayItems :: Array -> [Variant] arrayItems (VariantArray _ xs) = xs arrayItems (ByteArray xs) = map toVariant $ BL.unpack xs : :d type exports -- * Arrays , Array , arrayType , arrayItems : Like {\tt Variant}, deriving {\tt Show} for {\tt Array} is mostly just useful for debugging. :f DBus/Types/Internal.cpphs instance Show Array where showsPrec d array = showParen (d > 10) $ s "Array " . showSig . s " [" . s valueString . s "]" where s = showString showSig = shows . typeCode . arrayType $ array showVar var = showsPrecVar 0 var "" valueString = intercalate ", " $ map showVar $ arrayItems array : Clients constructing an array must provide the expected item type, which will be checked for validity. Every item in the array will be checked against the item type, to ensure the array is homogenous. :f DBus/Types/Internal.cpphs arrayFromItems :: Type -> [Variant] -> Maybe Array arrayFromItems DBusByte vs = fmap (ByteArray . BL.pack) (mapM fromVariant vs) arrayFromItems t vs = do maybeValidType t if all (\x -> variantType x == t) vs then Just $ VariantArray t vs else Nothing : Additionally, for ease of use, an {\tt Array} can be converted directly to/from lists of {\tt Variable} values. :f DBus/Types/Internal.cpphs toArray :: Variable a => Type -> [a] -> Maybe Array toArray t = arrayFromItems t . map toVariant fromArray :: Variable a => Array -> Maybe [a] fromArray = mapM fromVariant . arrayItems : :d type exports , toArray , fromArray , arrayFromItems : To provide a more efficient interface for byte array literals, these functions bypass the conversions in {\tt toArray} and {\tt fromArray} :f DBus/Types/Internal.cpphs arrayToBytes :: Array -> Maybe BL.ByteString arrayToBytes (ByteArray x) = Just x arrayToBytes _ = Nothing arrayFromBytes :: BL.ByteString -> Array arrayFromBytes = ByteArray : :d type exports , arrayToBytes , arrayFromBytes : And to simplify inclusion of {\tt ByteString}s in message, instances of {\tt Variable} exist for both strict and lazy {\tt ByteString}. :f DBus/Types/Internal.cpphs instance Variable BL.ByteString where toVariant = toVariant . arrayFromBytes fromVariant x = fromVariant x >>= arrayToBytes : :f DBus/Types/Internal.cpphs instance Variable B.ByteString where toVariant x = toVariant . arrayFromBytes $ BL.fromChunks [x] fromVariant = fmap (B.concat . BL.toChunks) . fromVariant : When generating random arrays for testing, only atomic values are used. Random containers are almost never homogenous. :f Tests.hs instance Arbitrary Array where arbitrary = do t <- atomicType xs <- listOf $ genVariant t return . fromJust $ arrayFromItems t xs prop_ArrayHomogeneous vs = isJust array == homogeneousTypes where array = arrayFromItems firstType vs homogeneousTypes = all (== firstType) types types = map variantType vs firstType = if null types then DBusByte else head types : :d test cases , F.testGroup "Array" [ testProperty "Array identity" $ \x -> Just x == arrayFromItems (arrayType x) (arrayItems x) , testProperty "Array homogeneity" prop_ArrayHomogeneous ] : \subsection{Dictionaries} Dictionaries are a homogenous (key $\rightarrow$ value) mapping, where the key type must be atomic. Values may be of any valid D-Bus type. Like {\tt Array}, {\tt Dictionary} stores its contained types. :f DBus/Types/Internal.cpphs INSTANCE_VARIABLE(Dictionary) data Dictionary = Dictionary { dictionaryKeyType :: Type , dictionaryValueType :: Type , dictionaryItems :: [(Variant, Variant)] } deriving (Eq) : :d type exports -- * Dictionaries , Dictionary , dictionaryItems , dictionaryKeyType , dictionaryValueType : {\tt show}ing a {\tt Dictionary} displays the mapping in a more readable format than a list of pairs. :d type imports import Data.List (intercalate) : :f DBus/Types/Internal.cpphs instance Show Dictionary where showsPrec d (Dictionary kt vt pairs) = showParen (d > 10) $ s "Dictionary " . showSig . s " {" . s valueString . s "}" where s = showString showSig = shows $ TL.append (typeCode kt) (typeCode vt) valueString = intercalate ", " $ map showPair pairs showPair (k, v) = (showsPrecVar 0 k . showString " -> " . showsPrecVar 0 v) "" : Constructing a {\tt Dictionary} works like constructing an {\tt Array}, except that there are two types to check, and the key type must be atomic. :d type imports import Control.Monad (unless) : :f DBus/Types/Internal.cpphs dictionaryFromItems :: Type -> Type -> [(Variant, Variant)] -> Maybe Dictionary dictionaryFromItems kt vt pairs = do unless (isAtomicType kt) Nothing maybeValidType kt maybeValidType vt let sameType (k, v) = variantType k == kt && variantType v == vt if all sameType pairs then Just $ Dictionary kt vt pairs else Nothing : The closest match for dictionary semantics in Haskell is the {\tt Data.Map.Map} type. Therefore, the utility conversion functions work with {\tt Map}s instead of pair lists. :d type imports import Control.Arrow ((***)) import qualified Data.Map as Map : :f DBus/Types/Internal.cpphs toDictionary :: (Variable a, Variable b) => Type -> Type -> Map.Map a b -> Maybe Dictionary toDictionary kt vt = dictionaryFromItems kt vt . pairs where pairs = map (toVariant *** toVariant) . Map.toList : :d type imports import Control.Monad (forM) : :f DBus/Types/Internal.cpphs fromDictionary :: (Variable a, Ord a, Variable b) => Dictionary -> Maybe (Map.Map a b) fromDictionary (Dictionary _ _ vs) = do pairs <- forM vs $ \(k, v) -> do k' <- fromVariant k v' <- fromVariant v return (k', v') return $ Map.fromList pairs : :d type exports , toDictionary , fromDictionary , dictionaryFromItems : When generating random dictionaries for testing, only atomic values are used. Random containers are almost never homogenous. :f Tests.hs instance Arbitrary Dictionary where arbitrary = do kt <- atomicType vt <- atomicType ks <- listOf $ genVariant kt vs <- vectorOf (length ks) $ genVariant vt return . fromJust $ dictionaryFromItems kt vt $ zip ks vs prop_DictionaryHomogeneous x = all correctType pairs where pairs = dictionaryItems x kType = dictionaryKeyType x vType = dictionaryValueType x correctType (k, v) = variantType k == kType && variantType v == vType : :d test cases , F.testGroup "Dictionary" [ testProperty "Dictionary identity" $ \x -> Just x == dictionaryFromItems (dictionaryKeyType x) (dictionaryValueType x) (dictionaryItems x) , testProperty "Dictionary homogeneity" prop_DictionaryHomogeneous , testProperty "Dictionary must have atomic keys" $ \vt -> forAll containerType $ \kt -> isNothing (dictionaryFromItems kt vt []) , testProperty "Dictionary <-> Array conversion" $ funEq (arrayToDictionary . dictionaryToArray) Just ] : \subsubsection{Converting between {\tt Array} and {\tt Dictionary}} Converting between {\tt Array} and {\tt Dictionary} is useful when (un)marshaling -- dictionaries can be thought of as arrays of two-element structures, much as a {\tt Map} is a list of pairs. :f DBus/Types/Internal.cpphs dictionaryToArray :: Dictionary -> Array dictionaryToArray (Dictionary kt vt items) = array where Just array = toArray itemType structs itemType = DBusStructure [kt, vt] structs = [Structure [k, v] | (k, v) <- items] : :f DBus/Types/Internal.cpphs arrayToDictionary :: Array -> Maybe Dictionary arrayToDictionary array = do let toPair x = do struct <- fromVariant x case struct of Structure [k, v] -> Just (k, v) _ -> Nothing (kt, vt) <- case arrayType array of DBusStructure [kt, vt] -> Just (kt, vt) _ -> Nothing pairs <- mapM toPair $ arrayItems array dictionaryFromItems kt vt pairs : :d type exports , dictionaryToArray , arrayToDictionary : \subsection{Structures} A heterogeneous, fixed-length container; equivalent in purpose to a Haskell tuple. :f DBus/Types/Internal.cpphs INSTANCE_VARIABLE(Structure) data Structure = Structure [Variant] deriving (Show, Eq) : :d type exports -- * Structures , Structure (..) : :f Tests.hs instance Arbitrary Structure where arbitrary = fmap Structure $ halfSized arbitrary : \subsection{Names} Various aspects of D-Bus require the use of specially-formatted strings, called ``names''. All names are limited to 255 characters, and use subsets of ASCII. Since all names have basically the same structure (a {\tt newtype} declaration and some helper functions), I define a macro to automate the definitions. :f DBus/Types/Internal.cpphs #define NAME_TYPE(TYPE, NAME) \ newtype TYPE = TYPE {str/**/TYPE :: Text} \ deriving (Eq, Ord); \ \ instance Show TYPE where \ { showsPrec d (TYPE x) = showParen (d > 10) $ \ showString "TYPE " . shows x \ }; \ \ instance String.IsString TYPE where \ { fromString = mk/**/TYPE/**/_ . TL.pack }; \ \ instance Variable TYPE where \ { toVariant = toVariant . str/**/TYPE \ ; fromVariant = (mk/**/TYPE =<<) . fromVariant }; \ \ mk/**/TYPE/**/_ :: Text -> TYPE; \ mk/**/TYPE/**/_ = mkUnsafe NAME mk/**/TYPE : :d type exports -- * Names : \subsubsection{Bus names} There are two forms of bus names, ``unique'' and ``well-known''. Unique names begin with {\tt `:'} and contain two or more elements, separated by {\tt `.'}. Each element consists of characters from the set {\tt [a-zA-Z0-9\_-]}. Well-known names contain two or more elements, separated by {\tt `.'}. Each element consists of characters from the set {\tt [a-zA-Z0-9\_-]}, and must not start with a digit. :f DBus/Types/Internal.cpphs NAME_TYPE(BusName, "bus name") mkBusName :: Text -> Maybe BusName mkBusName s = checkLength 255 (TL.unpack s) >>= parseMaybe parser where c = ['a'..'z'] ++ ['A'..'Z'] ++ "_-" c' = c ++ ['0'..'9'] parser = (unique <|> wellKnown) >> P.eof >> return (BusName s) unique = P.char ':' >> elems c' wellKnown = elems c elems start = elem' start >> P.many1 (P.char '.' >> elem' start) elem' start = P.oneOf start >> P.many (P.oneOf c') : :d type exports -- ** Bus names , BusName , strBusName , mkBusName , mkBusName_ : :f Tests.hs instance Arbitrary BusName where arbitrary = sizedText 255 (oneof [unique, wellKnown]) where c = ['a'..'z'] ++ ['A'..'Z'] ++ "_-" c' = c ++ ['0'..'9'] unique = do elems' <- atLeast 2 $ elems c' return . TL.pack $ ':' : intercalate "." elems' wellKnown = do elems' <- atLeast 2 $ elems c return . TL.pack $ intercalate "." elems' elems start = do x <- elements start xs <- atLeast 0 (elements c') return (x:xs) : :d test cases , F.testGroup "BusName" [ testProperty "BusName identity" $ funEq (mkBusName . strBusName) Just ] : \subsubsection{Interface names} An interface name consists of two or more {\tt '.'}-separated elements. Each element constists of characters from the set {\tt [a-zA-Z0-9\_]}, may not start with a digit, and must have at least one character. :f DBus/Types/Internal.cpphs NAME_TYPE(InterfaceName, "interface name") mkInterfaceName :: Text -> Maybe InterfaceName mkInterfaceName s = checkLength 255 (TL.unpack s) >>= parseMaybe parser where c = ['a'..'z'] ++ ['A'..'Z'] ++ "_" c' = c ++ ['0'..'9'] element = P.oneOf c >> P.many (P.oneOf c') name = element >> P.many1 (P.char '.' >> element) parser = name >> P.eof >> return (InterfaceName s) : :d type exports -- ** Interface names , InterfaceName , strInterfaceName , mkInterfaceName , mkInterfaceName_ : :f Tests.hs instance Arbitrary InterfaceName where arbitrary = sizedText 255 genName where c = ['a'..'z'] ++ ['A'..'Z'] ++ "_" c' = c ++ ['0'..'9'] genName = fmap (TL.pack . intercalate ".") genElements genElements = atLeast 2 genElement genElement = do x <- elements c xs <- atLeast 0 (elements c') return (x:xs) : :d test cases , F.testGroup "InterfaceName" [ testProperty "InterfaceName identity" $ funEq (mkInterfaceName . strInterfaceName) Just ] : \subsubsection{Error names} Error names have the same format as interface names, so the parser logic can just be re-purposed. :f DBus/Types/Internal.cpphs NAME_TYPE(ErrorName, "error name") mkErrorName :: Text -> Maybe ErrorName mkErrorName = fmap (ErrorName . strInterfaceName) . mkInterfaceName : :d type exports -- ** Error names , ErrorName , strErrorName , mkErrorName , mkErrorName_ : :f Tests.hs instance Arbitrary ErrorName where arbitrary = fmap (mkErrorName_ . strInterfaceName) arbitrary : :d test cases , F.testGroup "ErrorName" [ testProperty "ErrorName identity" $ funEq (mkErrorName . strErrorName) Just ] : \subsubsection{Member names} Member names must contain only characters from the set {\tt [a-zA-Z0-9\_]}, may not begin with a digit, and must be at least one character long. :f DBus/Types/Internal.cpphs NAME_TYPE(MemberName, "member name") mkMemberName :: Text -> Maybe MemberName mkMemberName s = checkLength 255 (TL.unpack s) >>= parseMaybe parser where c = ['a'..'z'] ++ ['A'..'Z'] ++ "_" c' = c ++ ['0'..'9'] name = P.oneOf c >> P.many (P.oneOf c') parser = name >> P.eof >> return (MemberName s) : :d type exports -- ** Member names , MemberName , strMemberName , mkMemberName , mkMemberName_ : :f Tests.hs instance Arbitrary MemberName where arbitrary = sizedText 255 genName where c = ['a'..'z'] ++ ['A'..'Z'] ++ "_" c' = c ++ ['0'..'9'] genName = do x <- elements c xs <- atLeast 0 (elements c') return . TL.pack $ (x:xs) : :d test cases , F.testGroup "MemberName" [ testProperty "MemberName identity" $ funEq (mkMemberName . strMemberName) Just ] :