dbus-core-0.8.4: src/types.anansi

:# Copyright (C) 2009-2010 John Millikin <jmillikin@gmail.com>
:# 
:# 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 <http://www.gnu.org/licenses/>.

\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
	]
: