module DBus.Address
( Address
, addressMethod
, addressParameters
, mkAddresses
, strAddress
) where
import Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as TL
import Data.Char (ord, chr)
import qualified Data.Map as M
import Text.Printf (printf)
import qualified Text.Parsec as P
import Text.Parsec ((<|>))
import DBus.Util (hexToInt, eitherToMaybe)
optionallyEncoded :: [Char]
optionallyEncoded = ['0'..'9'] ++ ['a'..'z'] ++ ['A'..'Z'] ++ "-_/\\*."
data Address = Address
{ addressMethod :: Text
, addressParameters :: M.Map Text Text
} deriving (Eq)
instance Show Address where
showsPrec d x = showParen (d> 10) $
showString "Address " . shows (strAddress x)
mkAddresses :: Text -> Maybe [Address]
mkAddresses s = eitherToMaybe . P.parse parser "" . TL.unpack $ s where
address = do
method <- P.many (P.noneOf ":;")
P.char ':'
params <- P.sepEndBy param (P.char ',')
return $ Address (TL.pack method) (M.fromList params)
param = do
key <- P.many1 (P.noneOf "=;,")
P.char '='
value <- P.many1 (encodedValue <|> unencodedValue)
return (TL.pack key, TL.pack value)
parser = do
as <- P.sepEndBy1 address (P.char ';')
P.eof
return as
unencodedValue = P.oneOf optionallyEncoded
encodedValue = do
P.char '%'
hex <- P.count 2 P.hexDigit
return . chr . hexToInt $ hex
strAddress :: Address -> Text
strAddress (Address t ps) = TL.concat [t, ":", ps'] where
ps' = TL.intercalate "," $ do
(k, v) <- M.toList ps
return $ TL.concat [k, "=", TL.concatMap encode v]
encode c | elem c optionallyEncoded = TL.singleton c
| otherwise = TL.pack $ printf "%%%02X" (ord c)