:# Copyright (C) 2009-2011 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{Values and types} \dbus{} values are divided into two categories, \emph{atoms} and \emph{containers}. Atoms are strings, numbers, and so on. Containers can store other values, including other containers. Generally, values act like their Haskell equivalents, with one important exception: \dbus{} dictionaries only support atomic keys. Every \dbus{} type has a \emph{type code}, a short string describing what sort of data the value stores. \begin{table}[h] \label{tab:dbus-types} \caption{\dbus{} Types} \begin{center} \begin{tabular}{llll} \toprule \dbus{} Type & Code & Description & Haskell Type \\ \midrule Boolean & {\tt b} & {\tt True} or {\tt False} & {\tt Bool} \\ Byte & {\tt y} & 8-bit unsigned integer & {\tt Word8} \\ Int16 & {\tt n} & 16-bit signed integer & {\tt Int16} \\ UInt16 & {\tt q} & 16-bit unsigned integer & {\tt Word16} \\ Int32 & {\tt i} & 32-bit signed integer & {\tt Int32} \\ UInt32 & {\tt u} & 32-bit unsigned integer & {\tt Word32} \\ Int64 & {\tt x} & 64-bit signed integer & {\tt Int64} \\ UInt64 & {\tt t} & 64-bit unsigned integer & {\tt Word64} \\ Double & {\tt d} & 64-bit IEEE754 floating-point & {\tt Double} \\ String & {\tt s} & Unicode text & {\tt Text} \\ Object Path & {\tt o} & \dbus{} remote object path & {\tt DBus.Types.ObjectPath} \\ Signature & {\tt g} & List of \dbus{} types & {\tt DBus.Types.Signature} \\ Variant & {\tt v} & Can contain any \dbus{} value & {\tt DBus.Types.Variant} \\ Array & {\tt a}\emph{t} & Homogenous list of \emph{t} & {\tt Vector} \\ Dictionary & {\tt a\{}\emph{k}\emph{t}{\tt \}} & Associative map of \emph{k} to \emph{t} & {\tt Map} \\ Structure & {\tt (}\emph{codes}{\tt )} & Heterogeneous list of \dbus{} values & Tuples \\ \bottomrule \end{tabular} \end{center} \end{table} \clearpage \subsubsection*{Values and types (continued)} \begin{multicols}{2} Since the set of types is fixed, they are internally stored as an enumeration, named {\tt Type}. The names mostly match the \dbus{} names, but a few have been slightly changed to conform with Haskell naming conventions. \vfill \columnbreak :d DBus.Types data Type = TypeBoolean | TypeWord8 | TypeWord16 | TypeWord32 | TypeWord64 | TypeInt16 | TypeInt32 | TypeInt64 | TypeDouble | TypeString | TypeSignature | TypeObjectPath | TypeVariant | TypeArray Type | TypeDictionary Type Type | TypeStructure [Type] deriving (Eq, Ord) : \end{multicols} \begin{multicols}{2} I have two choices when deciding how to show {\tt Type}s; either use type codes, as in signatures, or try to generate a more Haskell-ish format. I chose the second option because it's easier to read; for example, compare {\tt "a\{sas\}"} and {\tt Map String [String]}. This is particularly important when working with complex or deeply-nested structures, which are common in some APIs. \vfill \columnbreak :d DBus.Types instance Show Type where showsPrec d = showString . showType (d > 10) showType :: Bool -> Type -> String showType paren t = case t of TypeBoolean -> "Bool" TypeWord8 -> "Word8" TypeWord16 -> "Word16" TypeWord32 -> "Word32" TypeWord64 -> "Word64" TypeInt16 -> "Int16" TypeInt32 -> "Int32" TypeInt64 -> "Int64" TypeDouble -> "Double" TypeString -> "String" TypeSignature -> "Signature" TypeObjectPath -> "ObjectPath" TypeVariant -> "Variant" TypeArray t' -> concat ["[", show t', "]"] TypeDictionary kt vt -> showParen paren ( showString "Map " . shows kt . showString " " . showsPrec 11 vt) "" TypeStructure ts -> concat ["(", intercalate ", " (map show ts), ")"] : \end{multicols} \clearpage \subsection{Type signatures} \begin{multicols}{2} A list of types is called a \emph{signature}. Signatures are traditionally represented as a string of type codes, such as {\tt "a\{sas\}"} for {\tt Map String [String]}. However, this library stores signatures as {\tt [Type]} to take advantage of Haskell's strong typing. \vfill \columnbreak :d DBus.Types newtype Signature = Signature [Type] deriving (Eq, Ord) signatureTypes :: Signature -> [Type] signatureTypes (Signature types) = types instance Show Signature where showsPrec d sig = showParen (d > 10) $ showString "Signature " . shows (signatureText sig) : \end{multicols} \begin{multicols}{2} Although signatures are strongly-typed internally, they are exposed to the user as if they're special strings matching the \dbus{} signature format. \vfill \columnbreak :d DBus.Types signatureText :: Signature -> Text signatureText = Data.Text.Encoding.decodeUtf8 . Data.ByteString.Char8.pack . concatMap typeCode . signatureTypes 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, ")"] : \end{multicols} \clearpage \subsubsection*{Parsing signatures} \begin{multicols}{2} Signature parsing is the most common operation when unmarshaling messages; therefore, an efficient parsing implementation is essential. However, I still want the library's users to see a text-based interface to signatures. Therefore, there are actually two signature parsing APIs -- one for other modules in this library (especially {\tt DBus.Wire}, and a small wrapper for users. The wrapper follows the pattern for other special strings, so users can use string literals and so on. \vfill \columnbreak :d DBus.Types instance Data.String.IsString Signature where fromString = signature_ . Data.Text.pack signature :: Text -> Maybe Signature signature text = parseSignature bytes where bytes = Data.Text.Encoding.encodeUtf8 text signature_ :: Text -> Signature signature_ = tryParse "signature" signature : \end{multicols} \begin{multicols}{2} \noindent 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 non-recursive parser. \item All signatures larger than 255 characters are invalid, so they can be failed immediately. \end{enumerate} \vfill \columnbreak :d DBus.Types parseSignature :: ByteString -> Maybe Signature parseSignature bytes = case Data.ByteString.length bytes of 0 -> Just (Signature []) 1 -> parseSigFast bytes len | len <= 255 -> parseSigFull bytes _ -> Nothing : \end{multicols} \begin{multicols}{2} Additionally, the library might already have a list of {\tt Type}s available, and just wants to see if they're a valid signature. Rather than re-parsing them, we can assume the types are already nested correctly, and just check their string length. \vfill \columnbreak :d DBus.Types checkSignature :: [Type] -> Maybe Signature checkSignature = check where check ts = if sumLen ts > 255 then Nothing else Just (Signature ts) sumLen :: [Type] -> Int sumLen = sum . map len len (TypeArray t) = 1 + len t len (TypeDictionary kt vt) = 3 + len kt + len vt len (TypeStructure ts) = 2 + sumLen ts len _ = 1 : \end{multicols} \clearpage \subsubsection*{Fast signature parser} \begin{multicols}{2} The fast parser relies on all atoms having single-character codes; if the input string has only one character, it must be either an atomic type or {\tt TypeVariant}. This optimization is important when parsing variants, as they very often contain signatures with only a single atomic type. \vfill \columnbreak :d DBus.Types parseSigFast :: ByteString -> Maybe Signature parseSigFast bytes = let byte = Data.ByteString.head bytes in parseAtom byte (\t -> Just (Signature [t])) (case byte of 0x76 -> Just (Signature [TypeVariant]) _ -> Nothing) parseAtom :: Word8 -> (Type -> a) -> a -> a parseAtom byte yes no = case byte of 0x62 -> yes TypeBoolean 0x6E -> yes TypeInt16 0x69 -> yes TypeInt32 0x78 -> yes TypeInt64 0x79 -> yes TypeWord8 0x71 -> yes TypeWord16 0x75 -> yes TypeWord32 0x74 -> yes TypeWord64 0x64 -> yes TypeDouble 0x73 -> yes TypeString 0x67 -> yes TypeSignature 0x6F -> yes TypeObjectPath _ -> no : \end{multicols} \clearpage \subsubsection*{Full signature parser} This is horrible, gnarly, and almost completely undocumented. Someday I'll get around to cleaning it up, or at least hanging some curtains on it. :d DBus.Types parseSigFull :: ByteString -> Maybe Signature parseSigFull bytes = unsafePerformIO io where io = Data.ByteString.Unsafe.unsafeUseAsCStringLen bytes castBuf castBuf (ptr, len) = parseSigBuf (Foreign.castPtr ptr, len) parseSigBuf (buf, len) = mainLoop [] 0 where |full signature parser| : :d full signature parser mainLoop acc ii | ii >= len = return (Just (Signature (reverse acc))) mainLoop acc ii = do c <- Foreign.peekElemOff buf ii let next t = mainLoop (t : acc) (ii + 1) parseAtom c next $ case c of 0x76 -> next TypeVariant 0x28 -> do -- '(' mt <- structure (ii + 1) case mt of Just (ii', t) -> mainLoop (t : acc) ii' Nothing -> return Nothing 0x61 -> do -- 'a' mt <- array (ii + 1) case mt of Just (ii', t) -> mainLoop (t : acc) ii' Nothing -> return Nothing _ -> return Nothing : :d full signature parser structure :: Int -> IO (Maybe (Int, Type)) structure = loop [] where loop _ ii | ii >= len = return Nothing loop acc ii = do c <- Foreign.peekElemOff buf ii let next t = loop (t : acc) (ii + 1) parseAtom c next $ case c of 0x76 -> next TypeVariant 0x28 -> do -- '(' mt <- structure (ii + 1) case mt of Just (ii', t) -> loop (t : acc) ii' Nothing -> return Nothing 0x61 -> do -- 'a' mt <- array (ii + 1) case mt of Just (ii', t) -> loop (t : acc) ii' Nothing -> return Nothing -- ')' 0x29 -> return $ case acc of [] -> Nothing _ -> Just $ (ii + 1, TypeStructure (reverse acc)) _ -> return Nothing : \clearpage \subsubsection*{Full signature parser (continued)} :d full signature parser array :: Int -> IO (Maybe (Int, Type)) array ii | ii >= len = return Nothing array ii = do c <- Foreign.peekElemOff buf ii let next t = return $ Just (ii + 1, TypeArray t) parseAtom c next $ case c of 0x76 -> next TypeVariant 0x7B -> dict (ii + 1) -- '{' 0x28 -> do -- '(' mt <- structure (ii + 1) case mt of Just (ii', t) -> return $ Just (ii', TypeArray t) Nothing -> return Nothing 0x61 -> do -- 'a' mt <- array (ii + 1) case mt of Just (ii', t) -> return $ Just (ii', TypeArray t) Nothing -> return Nothing _ -> return Nothing : :d full signature parser dict :: Int -> IO (Maybe (Int, Type)) dict ii | ii + 1 >= len = return Nothing dict ii = do c1 <- Foreign.peekElemOff buf ii c2 <- Foreign.peekElemOff buf (ii + 1) let next t = return (Just (ii + 2, t)) mt2 <- parseAtom c2 next $ case c2 of 0x76 -> next TypeVariant 0x28 -> structure (ii + 2) -- '(' 0x61 -> array (ii + 2) -- 'a' _ -> return Nothing case mt2 of Nothing -> return Nothing Just (ii', t2) -> if ii' >= len then return Nothing else do c3 <- Foreign.peekElemOff buf ii' return $ do if c3 == 0x7D then Just () else Nothing t1 <- parseAtom c1 Just Nothing Just (ii' + 1, TypeDictionary t1 t2) : \clearpage \subsection{Generic value boxing} \begin{multicols}{2} The \dbus{} type system is similar to Haskell's, but has some minor differences. Most notably, {\em variants} can store any \dbus{} type, and dictionaries must have atomic keys. To provide a clean interface for converting between \dbus{} and Haskell types, the interface is encoded with three classes: \begin{enumerate} \item {\tt IsVariant} is the most general, and the only class that users may add instances for. Any type that can be converted to primitive \dbus{} values can be stored in a {\tt Variant}, and converted safely back to its original form. \item {\tt IsValue} is slightly stricter, and is used for constraining container values. If containers were constrained to {\tt IsVariant}, users could define an instance for {\tt Either} and create heterogenous containers. \item {\tt IsAtom} is the strictest, and is used for constraining dictionary key types. Only atomic values can be converted with this class, and users cannot define their own instances. \end{enumerate} It is possible to make this slightly less verbose by using existential types, but the additional indirection causes slower message parsing. As a special optimization, arrays of bytes can be stored directly in a {\tt Value} in three common formats. This allows the marshaling system to avoid copying data unless needed. {\tt ValueVector} and {\tt ValueMap} require special handling. \dbus{} needs to know their full type even if they're empty, but {\tt ([] :: [Value])} contains no information about its contents. As a workaround, the full type of the container is stored in the box itself at construction. \vfill \columnbreak :d DBus.Types class IsVariant a where toVariant :: a -> Variant fromVariant :: Variant -> Maybe a class IsVariant a => IsValue a where typeOf :: a -> Type toValue :: a -> Value fromValue :: Value -> Maybe a class IsValue a => IsAtom a where toAtom :: a -> Atom fromAtom :: Atom -> Maybe a |apidoc DBus.Types.Variant| newtype Variant = Variant Value deriving (Eq) data Value = ValueAtom Atom | ValueVariant Variant | ValueBytes ByteString | ValueVector Type (Vector Value) | ValueMap Type Type (Map Atom Value) | ValueStructure [Value] deriving (Show) data Atom = AtomBool Bool | AtomWord8 Word8 | AtomWord16 Word16 | AtomWord32 Word32 | AtomWord64 Word64 | AtomInt16 Int16 | AtomInt32 Int32 | AtomInt64 Int64 | AtomDouble Double | AtomText Text | AtomSignature Signature | AtomObjectPath ObjectPath deriving (Show, Eq, Ord) : \end{multicols} \clearpage \subsubsection*{Generic value boxing (continued)} The byte-handling optimization comes at a cost, however; it's no longer possible to derive {\tt Eq}, and the instance is quite ugly. :d DBus.Types instance Eq Value where (==) (ValueBytes x) y = case y of ValueBytes y' -> x == y' ValueVector TypeWord8 y' -> x == vectorToBytes y' _ -> False (==) (ValueVector TypeWord8 x) y = case y of ValueBytes y' -> vectorToBytes x == y' ValueVector TypeWord8 y' -> x == y' _ -> False (==) (ValueAtom x) (ValueAtom y) = x == y (==) (ValueVariant x) (ValueVariant y) = x == y (==) (ValueVector tx x) (ValueVector ty y) = tx == ty && x == y (==) (ValueMap ktx vtx x) (ValueMap kty vty y) = ktx == kty && vtx == vty && x == y (==) (ValueStructure x) (ValueStructure y) = x == y (==) _ _ = False : \clearpage \subsubsection*{Generic value boxing (continued)} If a user is interacting with the library through an REPL (e.g. GHCI), they might want to print the content of a variant -- for example, to print messages received from the bus. Due to the various wrappers between {\tt Variant} and the actual data, this is somewhat complex. :d DBus.Types showAtom :: Bool -> Atom -> String showAtom _ (AtomBool x) = show x showAtom _ (AtomWord8 x) = show x showAtom _ (AtomWord16 x) = show x showAtom _ (AtomWord32 x) = show x showAtom _ (AtomWord64 x) = show x showAtom _ (AtomInt16 x) = show x showAtom _ (AtomInt32 x) = show x showAtom _ (AtomInt64 x) = show x showAtom _ (AtomDouble x) = show x showAtom _ (AtomText x) = show x showAtom p (AtomSignature x) = showsPrec (if p then 11 else 0) x "" showAtom p (AtomObjectPath x) = showsPrec (if p then 11 else 0) x "" showValue :: Bool -> Value -> String showValue p (ValueAtom x) = showAtom p x showValue p (ValueVariant x) = showsPrec (if p then 11 else 0) x "" showValue _ (ValueBytes xs) = 'b' : show xs showValue _ (ValueVector TypeWord8 xs) = 'b' : show (vectorToBytes xs) showValue _ (ValueVector _ xs) = showThings "[" (showValue False) "]" (Data.Vector.toList xs) showValue _ (ValueMap _ _ xs) = showThings "{" showPair "}" (Data.Map.toList xs) where showPair (k, v) = showAtom False k ++ ": " ++ showValue False v showValue _ (ValueStructure xs) = showThings "(" (showValue False) ")" xs showThings :: String -> (a -> String) -> String -> [a] -> String showThings a s z xs = a ++ intercalate ", " (map s xs) ++ z vectorToBytes :: Vector Value -> ByteString vectorToBytes = Data.ByteString.pack . Data.Vector.toList . Data.Vector.map (\(ValueAtom (AtomWord8 x)) -> x) : To preserve the variant-based public interface, {\tt showAtom} and {\tt showValue} are not exported to the user. This preserves the appearance that {\tt Variant} is a simple wrapping box. \begin{quote} :d DBus.Types instance Show Variant where showsPrec d (Variant x) = showParen (d > 10) $ showString "Variant " . showString (showValue True x) : \end{quote} \clearpage \subsubsection*{Generic value boxing (continued)} Printing a {\tt Variant} lets the user see what value it contains, but sometimes they need to know exactly what type \dbus{} thinks it is. This is particularly important when working with integers, as some APIs will only accept integers of a particular size. :d DBus.Types |apidoc DBus.Types.variantType| variantType :: Variant -> Type variantType (Variant val) = valueType val valueType :: Value -> Type valueType (ValueAtom x) = atomType x valueType (ValueVariant _) = TypeVariant valueType (ValueVector t _) = TypeArray t valueType (ValueBytes _) = TypeArray TypeWord8 valueType (ValueMap kt vt _) = TypeDictionary kt vt valueType (ValueStructure vs) = TypeStructure (map valueType vs) atomType :: Atom -> Type atomType (AtomBool _) = TypeBoolean atomType (AtomWord8 _) = TypeWord8 atomType (AtomWord16 _) = TypeWord16 atomType (AtomWord32 _) = TypeWord32 atomType (AtomWord64 _) = TypeWord64 atomType (AtomInt16 _) = TypeInt16 atomType (AtomInt32 _) = TypeInt32 atomType (AtomInt64 _) = TypeInt64 atomType (AtomDouble _) = TypeDouble atomType (AtomText _) = TypeString atomType (AtomSignature _) = TypeSignature atomType (AtomObjectPath _) = TypeObjectPath : \clearpage \subsubsection*{Generic value boxing (continued)} \begin{multicols}{2} Since atoms are stored directly in the {\tt Atom} box, there is no fancy logic required in their class instances. They're still pretty verbose, so I used a small macro to keep things reasonable. \vfill \columnbreak :d DBus.Types #define IS_ATOM(HsType, AtomCons, TypeCons) \ instance IsAtom HsType where \ { toAtom = AtomCons \ ; fromAtom (AtomCons x) = Just x \ ; fromAtom _ = Nothing \ }; \ instance IsValue HsType where \ { typeOf _ = TypeCons \ ; toValue = ValueAtom . toAtom \ ; fromValue (ValueAtom x) = fromAtom x \ ; fromValue _ = Nothing \ }; \ instance IsVariant HsType where \ { toVariant = Variant . toValue \ ; fromVariant (Variant val) = fromValue val \ } IS_ATOM(Bool, AtomBool, TypeBoolean) IS_ATOM(Word8, AtomWord8, TypeWord8) IS_ATOM(Word16, AtomWord16, TypeWord16) IS_ATOM(Word32, AtomWord32, TypeWord32) IS_ATOM(Word64, AtomWord64, TypeWord64) IS_ATOM(Int16, AtomInt16, TypeInt16) IS_ATOM(Int32, AtomInt32, TypeInt32) IS_ATOM(Int64, AtomInt64, TypeInt64) IS_ATOM(Double, AtomDouble, TypeDouble) IS_ATOM(Text, AtomText, TypeString) IS_ATOM(Signature, AtomSignature, TypeSignature) IS_ATOM(ObjectPath, AtomObjectPath, TypeObjectPath) : \end{multicols} \begin{multicols}{2} ~ \vfill \columnbreak :d DBus.Types instance IsValue Variant where typeOf _ = TypeVariant toValue = ValueVariant fromValue (ValueVariant x) = Just x fromValue _ = Nothing instance IsVariant Variant where toVariant = Variant . toValue fromVariant (Variant val) = fromValue val : \end{multicols} \clearpage \subsubsection*{Generic value boxing (continued)} :d DBus.Types instance IsAtom Data.Text.Lazy.Text where toAtom = toAtom . Data.Text.Lazy.toStrict fromAtom = fmap Data.Text.Lazy.fromStrict . fromAtom instance IsValue Data.Text.Lazy.Text where typeOf _ = TypeString toValue = ValueAtom . toAtom fromValue (ValueAtom x) = fromAtom x fromValue _ = Nothing instance IsVariant Data.Text.Lazy.Text where toVariant = Variant . toValue fromVariant (Variant val) = fromValue val : :d DBus.Types instance IsAtom String where toAtom = toAtom . Data.Text.pack fromAtom = fmap Data.Text.unpack . fromAtom instance IsValue String where typeOf _ = TypeString toValue = ValueAtom . toAtom fromValue (ValueAtom x) = fromAtom x fromValue _ = Nothing instance IsVariant String where toVariant = Variant . toValue fromVariant (Variant val) = fromValue val : \clearpage \subsubsection*{Generic value boxing (continued)} Arrays are stored as a {\tt Vector Value}; this is somewhat inefficient, but allows type-safe casting between different array representations. :d DBus.Types instance IsValue a => IsValue (Vector a) where typeOf v = TypeArray (vectorItemType v) toValue v = ValueVector (vectorItemType v) (Data.Vector.map toValue v) fromValue (ValueVector _ v) = Data.Vector.mapM fromValue v fromValue _ = Nothing vectorItemType :: IsValue a => Vector a -> Type vectorItemType v = typeOf (undefined `asTypeOf` Data.Vector.head v) instance IsValue a => IsVariant (Vector a) where toVariant = Variant . toValue fromVariant (Variant val) = fromValue val : :d DBus.Types instance IsValue a => IsValue [a] where typeOf v = TypeArray (typeOf (undefined `asTypeOf` head v)) toValue = toValue . Data.Vector.fromList fromValue = fmap Data.Vector.toList . fromValue instance IsValue a => IsVariant [a] where toVariant = toVariant . Data.Vector.fromList fromVariant = fmap Data.Vector.toList . fromVariant : As an optimization, arrays of bytes are treated specially -- they can be converted to/from packed bytestrings. :d DBus.Types instance IsValue ByteString where typeOf _ = TypeArray TypeWord8 toValue = ValueBytes fromValue (ValueBytes bs) = Just bs fromValue (ValueVector TypeWord8 v) = Just (vectorToBytes v) fromValue _ = Nothing instance IsVariant ByteString where toVariant = Variant . toValue fromVariant (Variant val) = fromValue val : :d DBus.Types instance IsValue Data.ByteString.Lazy.ByteString where typeOf _ = TypeArray TypeWord8 toValue = toValue . Data.ByteString.concat . Data.ByteString.Lazy.toChunks fromValue = fmap (\bs -> Data.ByteString.Lazy.fromChunks [bs]) . fromValue instance IsVariant Data.ByteString.Lazy.ByteString where toVariant = Variant . toValue fromVariant (Variant val) = fromValue val : \clearpage \subsubsection*{Generic value boxing (continued)} :d DBus.Types instance (Ord k, IsAtom k, IsValue v) => IsValue (Map k v) where typeOf m = TypeDictionary kt vt where (kt, vt) = mapItemType m toValue m = ValueMap kt vt (bimap box m) where (kt, vt) = mapItemType m box k v = (toAtom k, toValue v) fromValue (ValueMap _ _ m) = bimapM unbox m where unbox k v = do k' <- fromAtom k v' <- fromValue v return (k', v') fromValue _ = Nothing bimap :: Ord k' => (k -> v -> (k', v')) -> Map k v -> Map k' v' bimap f = Data.Map.fromList . map (\(k, v) -> f k v) . Data.Map.toList bimapM :: (Monad m, Ord k') => (k -> v -> m (k', v')) -> Map k v -> m (Map k' v') bimapM f = liftM Data.Map.fromList . mapM (\(k, v) -> f k v) . Data.Map.toList mapItemType :: (IsValue k, IsValue v) => Map k v -> (Type, Type) mapItemType m = (typeOf k, typeOf v) where mapItem :: Map k v -> (k, v) mapItem _ = (undefined, undefined) (k, v) = mapItem m instance (Ord k, IsAtom k, IsValue v) => IsVariant (Map k v) where toVariant = Variant . toValue fromVariant (Variant val) = fromValue val : \clearpage \subsubsection*{Generic value boxing (continued)} \dbus{}'s structures are essentially the same as Haskell's tuples, except they can contain up to 255 items. There's no way I'm going to define 255 instances for {\tt IsValue} and {\tt IsVariant}; other classes (such as {\tt Show}) only go up to 15 or so, so that's how far {\tt dbus-core} goes too. I'm also not going to include all the instance declarations inline in this document, since they're all essentially the same. Here's the instances for two-element tuples, as a template. :d DBus.Types instance (IsValue a1, IsValue a2) => IsValue (a1, a2) where typeOf ~(a1, a2) = TypeStructure [typeOf a1, typeOf a2] toValue (a1, a2) = ValueStructure [toValue a1, toValue a2] fromValue (ValueStructure [a1, a2]) = do a1' <- fromValue a1 a2' <- fromValue a2 return (a1', a2') fromValue _ = Nothing instance (IsVariant a1, IsVariant a2) => IsVariant (a1, a2) where toVariant (a1, a2) = Variant (ValueStructure [varToVal a1, varToVal a2]) fromVariant (Variant (ValueStructure [a1, a2])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 return (a1', a2') fromVariant _ = Nothing varToVal :: IsVariant a => a -> Value varToVal a = case toVariant a of Variant val -> val : \clearpage \subsection{Special string types} Various aspects of \dbus{} require the use of specially-formatted strings. Every special string type gets its own Haskell type and construction function; this allows the library to assume all such strings are correctly formatted. The constructors will evaluate to {\tt Nothing} if their input is invalid. In addition, partial versions (suffixed with {\tt \_}) are available for users who don't care about validation; these will throw an exception if the input is invalid. Finally, {\tt IsString} instances are available for all special strings, so users can just enable {\tt OverloadedStrings} and use string literals directly. Validation is performed using Parsec. Unfortunately, Parsec does not work with packed strings; I'll define a few utility functions first, so the validation logic is more obvious. Note that these discard the Parsec error message; if some input doesn't match, the exact error is unlikely to be interesting. :d text validation imports import qualified Text.ParserCombinators.Parsec as Parsec import Text.ParserCombinators.Parsec ((<|>), oneOf) : :d text validation skipSepBy1 :: Parsec.Parser a -> Parsec.Parser b -> Parsec.Parser () skipSepBy1 p sep = do void p Parsec.skipMany (sep >> p) runParser :: Parsec.Parser a -> Text -> Maybe a runParser parser text = case Parsec.parse parser "" (Data.Text.unpack text) of Left _ -> Nothing Right a -> Just a tryParse :: String -> (Text -> Maybe a) -> Text -> a tryParse label parse text = case parse text of Just x -> x Nothing -> error ("Invalid " ++ label ++ ": " ++ show text) : \clearpage \subsubsection{Object paths} \begin{multicols}{2} \dbus{} is an object-oriented protocol; most \dbus{} sessions consist of method calls sent to \emph{objects} exported by other applications. An objects is identified by a \emph{object path}, such as {\tt /org/freedesktop/DBus}, which is unique within each application. \vfill \columnbreak :d DBus.Types newtype ObjectPath = ObjectPath Text deriving (Eq, Ord, Show) objectPathText :: ObjectPath -> Text objectPathText (ObjectPath text) = text objectPath :: Text -> Maybe ObjectPath objectPath text = do runParser parseObjectPath text return (ObjectPath text) objectPath_ :: Text -> ObjectPath objectPath_ = tryParse "object path" objectPath instance Data.String.IsString ObjectPath where fromString = objectPath_ . Data.Text.pack : \end{multicols} \begin{multicols}{2} An object path may be one of \begin{itemize} \item The root path, {\tt "/"}. \item {\tt '/'}, followed by one or more elements, separated by {\tt '/'}. Each element 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. \vfill \columnbreak :d DBus.Types parseObjectPath :: Parsec.Parser () parseObjectPath = root <|> object where root = Parsec.try $ do slash Parsec.eof object = do slash skipSepBy1 element slash Parsec.eof element = Parsec.skipMany1 (oneOf chars) slash = void (Parsec.char '/') chars = concat [ ['a'..'z'] , ['A'..'Z'] , ['0'..'9'] , "_"] : \end{multicols} \clearpage \subsubsection{Interface names} \begin{multicols}{2} Each object may have several \emph{interfaces}, each identified by an \emph{interface name}. Interfaces are the basic units of \dbus{} APIs, and even simple objects are expected to contain several (such as {\tt org.freedesktop.DBus.Introspectable} or {\tt org.freedesktop.DBus.Properties}). They correspond generally to Haskell classes, or Python protocols. \vfill \columnbreak :d DBus.Types newtype InterfaceName = InterfaceName Text deriving (Eq, Ord, Show) interfaceNameText :: InterfaceName -> Text interfaceNameText (InterfaceName text) = text interfaceName :: Text -> Maybe InterfaceName interfaceName text = do when (Data.Text.length text > 255) Nothing runParser parseInterfaceName text return (InterfaceName text) interfaceName_ :: Text -> InterfaceName interfaceName_ = tryParse "interface name" interfaceName instance Data.String.IsString InterfaceName where fromString = interfaceName_ . Data.Text.pack instance IsVariant InterfaceName where toVariant = toVariant . interfaceNameText fromVariant = fromVariant >=> interfaceName : \end{multicols} \begin{multicols}{2} 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. \vfill \columnbreak :d DBus.Types parseInterfaceName :: Parsec.Parser () parseInterfaceName = name >> Parsec.eof where alpha = ['a'..'z'] ++ ['A'..'Z'] ++ "_" alphanum = alpha ++ ['0'..'9'] element = do void (oneOf alpha) Parsec.skipMany (oneOf alphanum) name = do element void (Parsec.char '.') skipSepBy1 element (Parsec.char '.') : \end{multicols} \clearpage \subsubsection{Member names} \begin{multicols}{2} An interface, in turn, contains several \emph{members}, each identified by a \emph{member name} such as {\tt Introspect}. A member might be either a \emph{method}, which clients can call, or a \emph{signal}, which clients can wait for. \vfill \columnbreak :d DBus.Types newtype MemberName = MemberName Text deriving (Eq, Ord, Show) memberNameText :: MemberName -> Text memberNameText (MemberName text) = text memberName :: Text -> Maybe MemberName memberName text = do when (Data.Text.length text > 255) Nothing runParser parseMemberName text return (MemberName text) memberName_ :: Text -> MemberName memberName_ = tryParse "member name" memberName instance Data.String.IsString MemberName where fromString = memberName_ . Data.Text.pack instance IsVariant MemberName where toVariant = toVariant . memberNameText fromVariant = fromVariant >=> memberName : \end{multicols} \begin{multicols}{2} 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. \vfill \columnbreak :d DBus.Types parseMemberName :: Parsec.Parser () parseMemberName = name >> Parsec.eof where alpha = ['a'..'z'] ++ ['A'..'Z'] ++ "_" alphanum = alpha ++ ['0'..'9'] name = do void (oneOf alpha) Parsec.skipMany (oneOf alphanum) : \end{multicols} \clearpage \subsubsection{Error names} \begin{multicols}{2} Every error returned from a method call has an \emph{error name}, so clients can know (generally) what went wrong without having to parse the error message. Applications may define their own error names, or use one of the standardized names listed in section~\ref{sec:standard-error-names}. Error names have the same format as interface names, so the parser logic can be reused. \vfill \columnbreak :d DBus.Types newtype ErrorName = ErrorName Text deriving (Eq, Ord, Show) errorNameText :: ErrorName -> Text errorNameText (ErrorName text) = text errorName :: Text -> Maybe ErrorName errorName text = do when (Data.Text.length text > 255) Nothing runParser parseInterfaceName text return (ErrorName text) errorName_ :: Text -> ErrorName errorName_ = tryParse "error name" errorName instance Data.String.IsString ErrorName where fromString = errorName_ . Data.Text.pack instance IsVariant ErrorName where toVariant = toVariant . errorNameText fromVariant = fromVariant >=> errorName : \end{multicols} \clearpage \subsubsection{Bus names} \begin{multicols}{2} Bus names are used when connecting to a central message dispatch bus. Every connection is assigned a \emph{unique name}, such as {\tt :103.1}. This name is usually used by the bus to send signals and method returns to client applications. Additionally, applications may request a \emph{well-known} name such as {\tt org.freedesktop.DBus}. These are similar to internet hostnames; client applications are written to send messages to this address, where they can be served by whatever server happens to be running at the time. \vfill \columnbreak :d DBus.Types newtype BusName = BusName Text deriving (Eq, Ord, Show) busNameText :: BusName -> Text busNameText (BusName text) = text busName :: Text -> Maybe BusName busName text = do when (Data.Text.length text > 255) Nothing runParser parseBusName text return (BusName text) busName_ :: Text -> BusName busName_ = tryParse "bus name" busName instance Data.String.IsString BusName where fromString = busName_ . Data.Text.pack instance IsVariant BusName where toVariant = toVariant . busNameText fromVariant = fromVariant >=> busName : \end{multicols} \begin{multicols}{2} 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. \vfill \columnbreak :d DBus.Types parseBusName :: Parsec.Parser () parseBusName = name >> Parsec.eof where alpha = ['a'..'z'] ++ ['A'..'Z'] ++ "_-" alphanum = alpha ++ ['0'..'9'] name = unique <|> wellKnown unique = do void (Parsec.char ':') elements alphanum wellKnown = elements alpha elements start = do element start Parsec.skipMany1 $ do void (Parsec.char '.') element start element start = do void (oneOf start) Parsec.skipMany (oneOf alphanum) : \end{multicols} \clearpage \subsection{Container boxes} :d DBus.Types newtype Structure = Structure [Value] deriving (Eq) instance Show Structure where show (Structure xs) = showValue True (ValueStructure xs) instance IsVariant Structure where toVariant (Structure xs) = Variant (ValueStructure xs) fromVariant (Variant (ValueStructure xs)) = Just (Structure xs) fromVariant _ = Nothing structureItems :: Structure -> [Variant] structureItems (Structure xs) = map Variant xs : :d DBus.Types data Array = Array Type (Vector Value) | ArrayBytes ByteString instance Show Array where show (Array t xs) = showValue True (ValueVector t xs) show (ArrayBytes xs) = showValue True (ValueBytes xs) instance Eq Array where x == y = norm x == norm y where norm (Array TypeWord8 xs) = Left (vectorToBytes xs) norm (Array t xs) = Right (t, xs) norm (ArrayBytes xs) = Left xs instance IsVariant Array where toVariant (Array t xs) = Variant (ValueVector t xs) toVariant (ArrayBytes bs) = Variant (ValueBytes bs) fromVariant (Variant (ValueVector t xs)) = Just (Array t xs) fromVariant (Variant (ValueBytes bs)) = Just (ArrayBytes bs) fromVariant _ = Nothing arrayItems :: Array -> [Variant] arrayItems (Array _ xs) = map Variant (Data.Vector.toList xs) arrayItems (ArrayBytes bs) = map toVariant (Data.ByteString.unpack bs) : :d DBus.Types data Dictionary = Dictionary Type Type (Map Atom Value) deriving (Eq) instance Show Dictionary where show (Dictionary kt vt xs) = showValue True (ValueMap kt vt xs) instance IsVariant Dictionary where toVariant (Dictionary kt vt xs) = Variant (ValueMap kt vt xs) fromVariant (Variant (ValueMap kt vt xs)) = Just (Dictionary kt vt xs) fromVariant _ = Nothing dictionaryItems :: Dictionary -> [(Variant, Variant)] dictionaryItems (Dictionary _ _ xs) = do (k, v) <- Data.Map.toList xs return (Variant (ValueAtom k), Variant v) : \begin{comment} \clearpage \subsection{Boring type instances} :d DBus.Types instance (IsValue a1, IsValue a2, IsValue a3) => IsValue (a1, a2, a3) where typeOf ~(a1, a2, a3) = TypeStructure [typeOf a1, typeOf a2, typeOf a3] toValue (a1, a2, a3) = ValueStructure [toValue a1, toValue a2, toValue a3] fromValue (ValueStructure [a1, a2, a3]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 return (a1', a2', a3') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4) => IsValue (a1, a2, a3, a4) where typeOf ~(a1, a2, a3, a4) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4] toValue (a1, a2, a3, a4) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4] fromValue (ValueStructure [a1, a2, a3, a4]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 return (a1', a2', a3', a4') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4, IsValue a5) => IsValue (a1, a2, a3, a4, a5) where typeOf ~(a1, a2, a3, a4, a5) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4, typeOf a5] toValue (a1, a2, a3, a4, a5) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4, toValue a5] fromValue (ValueStructure [a1, a2, a3, a4, a5]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 a5' <- fromValue a5 return (a1', a2', a3', a4', a5') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4, IsValue a5, IsValue a6) => IsValue (a1, a2, a3, a4, a5, a6) where typeOf ~(a1, a2, a3, a4, a5, a6) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4, typeOf a5, typeOf a6] toValue (a1, a2, a3, a4, a5, a6) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4, toValue a5, toValue a6] fromValue (ValueStructure [a1, a2, a3, a4, a5, a6]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 a5' <- fromValue a5 a6' <- fromValue a6 return (a1', a2', a3', a4', a5', a6') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4, IsValue a5, IsValue a6, IsValue a7) => IsValue (a1, a2, a3, a4, a5, a6, a7) where typeOf ~(a1, a2, a3, a4, a5, a6, a7) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4, typeOf a5, typeOf a6, typeOf a7] toValue (a1, a2, a3, a4, a5, a6, a7) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4, toValue a5, toValue a6, toValue a7] fromValue (ValueStructure [a1, a2, a3, a4, a5, a6, a7]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 a5' <- fromValue a5 a6' <- fromValue a6 a7' <- fromValue a7 return (a1', a2', a3', a4', a5', a6', a7') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4, IsValue a5, IsValue a6, IsValue a7, IsValue a8) => IsValue (a1, a2, a3, a4, a5, a6, a7, a8) where typeOf ~(a1, a2, a3, a4, a5, a6, a7, a8) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4, typeOf a5, typeOf a6, typeOf a7, typeOf a8] toValue (a1, a2, a3, a4, a5, a6, a7, a8) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4, toValue a5, toValue a6, toValue a7, toValue a8] fromValue (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 a5' <- fromValue a5 a6' <- fromValue a6 a7' <- fromValue a7 a8' <- fromValue a8 return (a1', a2', a3', a4', a5', a6', a7', a8') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4, IsValue a5, IsValue a6, IsValue a7, IsValue a8, IsValue a9) => IsValue (a1, a2, a3, a4, a5, a6, a7, a8, a9) where typeOf ~(a1, a2, a3, a4, a5, a6, a7, a8, a9) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4, typeOf a5, typeOf a6, typeOf a7, typeOf a8, typeOf a9] toValue (a1, a2, a3, a4, a5, a6, a7, a8, a9) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4, toValue a5, toValue a6, toValue a7, toValue a8, toValue a9] fromValue (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 a5' <- fromValue a5 a6' <- fromValue a6 a7' <- fromValue a7 a8' <- fromValue a8 a9' <- fromValue a9 return (a1', a2', a3', a4', a5', a6', a7', a8', a9') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4, IsValue a5, IsValue a6, IsValue a7, IsValue a8, IsValue a9, IsValue a10) => IsValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) where typeOf ~(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4, typeOf a5, typeOf a6, typeOf a7, typeOf a8, typeOf a9, typeOf a10] toValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4, toValue a5, toValue a6, toValue a7, toValue a8, toValue a9, toValue a10] fromValue (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 a5' <- fromValue a5 a6' <- fromValue a6 a7' <- fromValue a7 a8' <- fromValue a8 a9' <- fromValue a9 a10' <- fromValue a10 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4, IsValue a5, IsValue a6, IsValue a7, IsValue a8, IsValue a9, IsValue a10, IsValue a11) => IsValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) where typeOf ~(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4, typeOf a5, typeOf a6, typeOf a7, typeOf a8, typeOf a9, typeOf a10, typeOf a11] toValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4, toValue a5, toValue a6, toValue a7, toValue a8, toValue a9, toValue a10, toValue a11] fromValue (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 a5' <- fromValue a5 a6' <- fromValue a6 a7' <- fromValue a7 a8' <- fromValue a8 a9' <- fromValue a9 a10' <- fromValue a10 a11' <- fromValue a11 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10', a11') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4, IsValue a5, IsValue a6, IsValue a7, IsValue a8, IsValue a9, IsValue a10, IsValue a11, IsValue a12) => IsValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) where typeOf ~(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4, typeOf a5, typeOf a6, typeOf a7, typeOf a8, typeOf a9, typeOf a10, typeOf a11, typeOf a12] toValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4, toValue a5, toValue a6, toValue a7, toValue a8, toValue a9, toValue a10, toValue a11, toValue a12] fromValue (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 a5' <- fromValue a5 a6' <- fromValue a6 a7' <- fromValue a7 a8' <- fromValue a8 a9' <- fromValue a9 a10' <- fromValue a10 a11' <- fromValue a11 a12' <- fromValue a12 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10', a11', a12') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4, IsValue a5, IsValue a6, IsValue a7, IsValue a8, IsValue a9, IsValue a10, IsValue a11, IsValue a12, IsValue a13) => IsValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) where typeOf ~(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4, typeOf a5, typeOf a6, typeOf a7, typeOf a8, typeOf a9, typeOf a10, typeOf a11, typeOf a12, typeOf a13] toValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4, toValue a5, toValue a6, toValue a7, toValue a8, toValue a9, toValue a10, toValue a11, toValue a12, toValue a13] fromValue (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 a5' <- fromValue a5 a6' <- fromValue a6 a7' <- fromValue a7 a8' <- fromValue a8 a9' <- fromValue a9 a10' <- fromValue a10 a11' <- fromValue a11 a12' <- fromValue a12 a13' <- fromValue a13 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10', a11', a12', a13') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4, IsValue a5, IsValue a6, IsValue a7, IsValue a8, IsValue a9, IsValue a10, IsValue a11, IsValue a12, IsValue a13, IsValue a14) => IsValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) where typeOf ~(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4, typeOf a5, typeOf a6, typeOf a7, typeOf a8, typeOf a9, typeOf a10, typeOf a11, typeOf a12, typeOf a13, typeOf a14] toValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4, toValue a5, toValue a6, toValue a7, toValue a8, toValue a9, toValue a10, toValue a11, toValue a12, toValue a13, toValue a14] fromValue (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 a5' <- fromValue a5 a6' <- fromValue a6 a7' <- fromValue a7 a8' <- fromValue a8 a9' <- fromValue a9 a10' <- fromValue a10 a11' <- fromValue a11 a12' <- fromValue a12 a13' <- fromValue a13 a14' <- fromValue a14 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10', a11', a12', a13', a14') fromValue _ = Nothing instance (IsValue a1, IsValue a2, IsValue a3, IsValue a4, IsValue a5, IsValue a6, IsValue a7, IsValue a8, IsValue a9, IsValue a10, IsValue a11, IsValue a12, IsValue a13, IsValue a14, IsValue a15) => IsValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) where typeOf ~(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) = TypeStructure [typeOf a1, typeOf a2, typeOf a3, typeOf a4, typeOf a5, typeOf a6, typeOf a7, typeOf a8, typeOf a9, typeOf a10, typeOf a11, typeOf a12, typeOf a13, typeOf a14, typeOf a15] toValue (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) = ValueStructure [toValue a1, toValue a2, toValue a3, toValue a4, toValue a5, toValue a6, toValue a7, toValue a8, toValue a9, toValue a10, toValue a11, toValue a12, toValue a13, toValue a14, toValue a15] fromValue (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15]) = do a1' <- fromValue a1 a2' <- fromValue a2 a3' <- fromValue a3 a4' <- fromValue a4 a5' <- fromValue a5 a6' <- fromValue a6 a7' <- fromValue a7 a8' <- fromValue a8 a9' <- fromValue a9 a10' <- fromValue a10 a11' <- fromValue a11 a12' <- fromValue a12 a13' <- fromValue a13 a14' <- fromValue a14 a15' <- fromValue a15 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10', a11', a12', a13', a14', a15') fromValue _ = Nothing : :d DBus.Types instance (IsVariant a1, IsVariant a2, IsVariant a3) => IsVariant (a1, a2, a3) where toVariant (a1, a2, a3) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3]) fromVariant (Variant (ValueStructure [a1, a2, a3])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 return (a1', a2', a3') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4) => IsVariant (a1, a2, a3, a4) where toVariant (a1, a2, a3, a4) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 return (a1', a2', a3', a4') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4, IsVariant a5) => IsVariant (a1, a2, a3, a4, a5) where toVariant (a1, a2, a3, a4, a5) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4, varToVal a5]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4, a5])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 a5' <- (fromVariant . Variant) a5 return (a1', a2', a3', a4', a5') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4, IsVariant a5, IsVariant a6) => IsVariant (a1, a2, a3, a4, a5, a6) where toVariant (a1, a2, a3, a4, a5, a6) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4, varToVal a5, varToVal a6]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4, a5, a6])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 a5' <- (fromVariant . Variant) a5 a6' <- (fromVariant . Variant) a6 return (a1', a2', a3', a4', a5', a6') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4, IsVariant a5, IsVariant a6, IsVariant a7) => IsVariant (a1, a2, a3, a4, a5, a6, a7) where toVariant (a1, a2, a3, a4, a5, a6, a7) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4, varToVal a5, varToVal a6, varToVal a7]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4, a5, a6, a7])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 a5' <- (fromVariant . Variant) a5 a6' <- (fromVariant . Variant) a6 a7' <- (fromVariant . Variant) a7 return (a1', a2', a3', a4', a5', a6', a7') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4, IsVariant a5, IsVariant a6, IsVariant a7, IsVariant a8) => IsVariant (a1, a2, a3, a4, a5, a6, a7, a8) where toVariant (a1, a2, a3, a4, a5, a6, a7, a8) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4, varToVal a5, varToVal a6, varToVal a7, varToVal a8]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 a5' <- (fromVariant . Variant) a5 a6' <- (fromVariant . Variant) a6 a7' <- (fromVariant . Variant) a7 a8' <- (fromVariant . Variant) a8 return (a1', a2', a3', a4', a5', a6', a7', a8') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4, IsVariant a5, IsVariant a6, IsVariant a7, IsVariant a8, IsVariant a9) => IsVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9) where toVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4, varToVal a5, varToVal a6, varToVal a7, varToVal a8, varToVal a9]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 a5' <- (fromVariant . Variant) a5 a6' <- (fromVariant . Variant) a6 a7' <- (fromVariant . Variant) a7 a8' <- (fromVariant . Variant) a8 a9' <- (fromVariant . Variant) a9 return (a1', a2', a3', a4', a5', a6', a7', a8', a9') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4, IsVariant a5, IsVariant a6, IsVariant a7, IsVariant a8, IsVariant a9, IsVariant a10) => IsVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) where toVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4, varToVal a5, varToVal a6, varToVal a7, varToVal a8, varToVal a9, varToVal a10]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 a5' <- (fromVariant . Variant) a5 a6' <- (fromVariant . Variant) a6 a7' <- (fromVariant . Variant) a7 a8' <- (fromVariant . Variant) a8 a9' <- (fromVariant . Variant) a9 a10' <- (fromVariant . Variant) a10 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4, IsVariant a5, IsVariant a6, IsVariant a7, IsVariant a8, IsVariant a9, IsVariant a10, IsVariant a11) => IsVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) where toVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4, varToVal a5, varToVal a6, varToVal a7, varToVal a8, varToVal a9, varToVal a10, varToVal a11]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 a5' <- (fromVariant . Variant) a5 a6' <- (fromVariant . Variant) a6 a7' <- (fromVariant . Variant) a7 a8' <- (fromVariant . Variant) a8 a9' <- (fromVariant . Variant) a9 a10' <- (fromVariant . Variant) a10 a11' <- (fromVariant . Variant) a11 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10', a11') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4, IsVariant a5, IsVariant a6, IsVariant a7, IsVariant a8, IsVariant a9, IsVariant a10, IsVariant a11, IsVariant a12) => IsVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) where toVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4, varToVal a5, varToVal a6, varToVal a7, varToVal a8, varToVal a9, varToVal a10, varToVal a11, varToVal a12]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 a5' <- (fromVariant . Variant) a5 a6' <- (fromVariant . Variant) a6 a7' <- (fromVariant . Variant) a7 a8' <- (fromVariant . Variant) a8 a9' <- (fromVariant . Variant) a9 a10' <- (fromVariant . Variant) a10 a11' <- (fromVariant . Variant) a11 a12' <- (fromVariant . Variant) a12 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10', a11', a12') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4, IsVariant a5, IsVariant a6, IsVariant a7, IsVariant a8, IsVariant a9, IsVariant a10, IsVariant a11, IsVariant a12, IsVariant a13) => IsVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) where toVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4, varToVal a5, varToVal a6, varToVal a7, varToVal a8, varToVal a9, varToVal a10, varToVal a11, varToVal a12, varToVal a13]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 a5' <- (fromVariant . Variant) a5 a6' <- (fromVariant . Variant) a6 a7' <- (fromVariant . Variant) a7 a8' <- (fromVariant . Variant) a8 a9' <- (fromVariant . Variant) a9 a10' <- (fromVariant . Variant) a10 a11' <- (fromVariant . Variant) a11 a12' <- (fromVariant . Variant) a12 a13' <- (fromVariant . Variant) a13 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10', a11', a12', a13') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4, IsVariant a5, IsVariant a6, IsVariant a7, IsVariant a8, IsVariant a9, IsVariant a10, IsVariant a11, IsVariant a12, IsVariant a13, IsVariant a14) => IsVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) where toVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4, varToVal a5, varToVal a6, varToVal a7, varToVal a8, varToVal a9, varToVal a10, varToVal a11, varToVal a12, varToVal a13, varToVal a14]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 a5' <- (fromVariant . Variant) a5 a6' <- (fromVariant . Variant) a6 a7' <- (fromVariant . Variant) a7 a8' <- (fromVariant . Variant) a8 a9' <- (fromVariant . Variant) a9 a10' <- (fromVariant . Variant) a10 a11' <- (fromVariant . Variant) a11 a12' <- (fromVariant . Variant) a12 a13' <- (fromVariant . Variant) a13 a14' <- (fromVariant . Variant) a14 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10', a11', a12', a13', a14') fromVariant _ = Nothing instance (IsVariant a1, IsVariant a2, IsVariant a3, IsVariant a4, IsVariant a5, IsVariant a6, IsVariant a7, IsVariant a8, IsVariant a9, IsVariant a10, IsVariant a11, IsVariant a12, IsVariant a13, IsVariant a14, IsVariant a15) => IsVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) where toVariant (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) = Variant (ValueStructure [varToVal a1, varToVal a2, varToVal a3, varToVal a4, varToVal a5, varToVal a6, varToVal a7, varToVal a8, varToVal a9, varToVal a10, varToVal a11, varToVal a12, varToVal a13, varToVal a14, varToVal a15]) fromVariant (Variant (ValueStructure [a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15])) = do a1' <- (fromVariant . Variant) a1 a2' <- (fromVariant . Variant) a2 a3' <- (fromVariant . Variant) a3 a4' <- (fromVariant . Variant) a4 a5' <- (fromVariant . Variant) a5 a6' <- (fromVariant . Variant) a6 a7' <- (fromVariant . Variant) a7 a8' <- (fromVariant . Variant) a8 a9' <- (fromVariant . Variant) a9 a10' <- (fromVariant . Variant) a10 a11' <- (fromVariant . Variant) a11 a12' <- (fromVariant . Variant) a12 a13' <- (fromVariant . Variant) a13 a14' <- (fromVariant . Variant) a14 a15' <- (fromVariant . Variant) a15 return (a1', a2', a3', a4', a5', a6', a7', a8', a9', a10', a11', a12', a13', a14', a15') fromVariant _ = Nothing : \end{comment}