-- 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/>.
{-# LANGUAGE OverloadedStrings #-}
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.ParserCombinators.Parsec as P
import Text.ParserCombinators.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)