{-
  Copyright (C) 2009 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.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)