module DBus.Signature where
import Control.Applicative ((<$>))
import qualified Data.Attoparsec.ByteString as AP
import qualified Data.Attoparsec.ByteString.Char8 as AP
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Builder as BS
import Data.Char
import qualified Data.IntMap as IMap
import Data.Monoid
import qualified Data.Text as Text
import DBus.Types
stToSignature :: DBusSimpleType -> Char
stToSignature TypeByte = 'y'
stToSignature TypeBoolean = 'b'
stToSignature TypeInt16 = 'n'
stToSignature TypeUInt16 = 'q'
stToSignature TypeInt32 = 'i'
stToSignature TypeUInt32 = 'u'
stToSignature TypeInt64 = 'x'
stToSignature TypeUInt64 = 't'
stToSignature TypeDouble = 'd'
stToSignature TypeUnixFD = 'h'
stToSignature TypeString = 's'
stToSignature TypeObjectPath = 'o'
stToSignature TypeSignature = 'g'
toSignature :: DBusType -> BS.ByteString
toSignature = BS.concat . BSL.toChunks . BS.toLazyByteString . toSignature'
toSignatures :: [DBusType] -> BS.ByteString
toSignatures = BS.concat . BSL.toChunks . BS.toLazyByteString . mconcat . map toSignature'
toSignature' :: DBusType -> BS.Builder
toSignature' (DBusSimpleType t) = BS.char8 $ stToSignature t
toSignature' (TypeArray t) = BS.char8 'a' <> toSignature' t
toSignature' (TypeStruct ts) = BS.char8 '('
<> mconcat (toSignature' <$> ts)
<> BS.char8 ')'
toSignature' (TypeDict kt vt) = BS.string8 "a{"
<> BS.char8 (stToSignature kt)
<> toSignature' vt
<> BS.char8 '}'
toSignature' (TypeDictEntry kt vt) = BS.string8 "e{"
<> BS.char8 (stToSignature kt)
<> toSignature' vt
<> BS.char8 '}'
toSignature' TypeVariant = BS.char8 'v'
toSignature' TypeUnit = ""
simpleTypeMap :: IMap.IntMap DBusSimpleType
simpleTypeMap = IMap.fromList[ (ord 'y', TypeByte )
, (ord 'b', TypeBoolean )
, (ord 'n', TypeInt16 )
, (ord 'q', TypeUInt16 )
, (ord 'i', TypeInt32 )
, (ord 'u', TypeUInt32 )
, (ord 'x', TypeInt64 )
, (ord 't', TypeUInt64 )
, (ord 'd', TypeDouble )
, (ord 'h', TypeUnixFD )
, (ord 's', TypeString )
, (ord 'o', TypeObjectPath )
, (ord 'g', TypeSignature )
]
simpleType :: AP.Parser DBusSimpleType
simpleType = do
c <- AP.anyWord8
case IMap.lookup (fromIntegral c) simpleTypeMap of
Nothing -> fail "not a simple type"
Just t -> return t
dictEntrySignature :: AP.Parser DBusType
dictEntrySignature = do
_ <- AP.char8 '{'
kt <- simpleType
vt <- signature
_ <- AP.string "}"
return $ TypeDictEntry kt vt
arraySignature :: AP.Parser DBusType
arraySignature = do
_ <- AP.char8 'a'
((do TypeDictEntry kt vt <- dictEntrySignature
return $ TypeDict kt vt)
<> (TypeArray <$> signature))
structSignature :: AP.Parser DBusType
structSignature = do
_ <- AP.char '('
TypeStruct <$> AP.manyTill signature (AP.char ')')
signature :: AP.Parser DBusType
signature = AP.choice [ AP.char 'v' >> return TypeVariant
, arraySignature
, structSignature
, DBusSimpleType <$> simpleType
]
eitherParseSig :: BS.ByteString -> Either Text.Text DBusType
eitherParseSig s = case AP.parseOnly signature s of
Left e -> Left $ Text.pack e
Right r -> Right r
parseSig :: BS.ByteString -> Maybe DBusType
parseSig s = case eitherParseSig s of
Left _ -> Nothing
Right r -> Just r
eitherParseSigs :: BS.ByteString -> Either Text.Text [DBusType]
eitherParseSigs s = case AP.parseOnly (AP.many' signature) s of
Left e -> Left $ Text.pack e
Right r -> Right r
parseSigs :: BS.ByteString -> Maybe [DBusType]
parseSigs s = case eitherParseSigs s of
Left _ -> Nothing
Right r -> Just r