{-# LANGUAGE ForeignFunctionInterface #-}

-- Copyright 2010 Evgeniy Vodolazskiy (waterlaz@gmail.com)
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library 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
-- Lesser General Public License for more details.

module Network.XMMS.Config( 
    registerValue,
    setValue,
    getValue,
    listValues,
    broadcastValueChanged
)where

import Foreign
import Foreign.Ptr
import Foreign.C.Types
import Network.XMMS.UTF8Strings
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc

import Network.XMMS.Utilities
import Network.XMMS.Constants
import Network.XMMS.Types



--xmmsc_result_t *xmmsc_config_register_value (xmmsc_connection_t *c, const char *key, const char *value)
foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsc_config_register_value" 
    xmmsc_config_register_value :: Ptr C_xmmsc_connection -> CString -> CString -> IO (Ptr C_xmmsc_result)
-- |Registers a configvalue in the server.
registerValue :: Connection -> String -> String -> IO Result
registerValue connection key value = do
    c_key <- newCString key
    c_value <- newCString value
    res <- wrapCallResult (\c -> xmmsc_config_register_value c c_key c_value) connection
    free c_key
    free c_value
    return res 
    
    
--xmmsc_result_t *xmmsc_config_set_value (xmmsc_connection_t *c, const char *key, const char *val)
foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsc_config_set_value" 
    xmmsc_config_set_value :: Ptr C_xmmsc_connection -> CString -> CString -> IO (Ptr C_xmmsc_result)
-- |Sets a configvalue in the server.
setValue :: Connection -> String -> String -> IO Result
setValue connection key value = do
    c_key <- newCString key
    c_value <- newCString value
    res <- wrapCallResult (\c -> xmmsc_config_set_value c c_key c_value) connection
    free c_key
    free c_value
    return res    


--xmmsc_result_t * 	xmmsc_config_get_value (xmmsc_connection_t *c, const char *key)
foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsc_config_get_value" 
    xmmsc_config_get_value :: Ptr C_xmmsc_connection -> CString -> IO (Ptr C_xmmsc_result)
-- |Retrieves a configvalue from the server. 
getValue :: Connection -> String -> IO Result
getValue connection key = do
    c_key <- newCString key
    res <- wrapCallResult (\c -> xmmsc_config_get_value c c_key) connection
    free c_key
    return res


--xmmsc_result_t *xmmsc_config_list_values (xmmsc_connection_t  *c)
foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsc_config_list_values" 
    xmmsc_config_list_values :: Ptr C_xmmsc_connection -> IO (Ptr C_xmmsc_result)
-- |Lists all configuration values. 
listValues :: Connection -> IO Result
listValues = wrapCallResult xmmsc_config_list_values


--xmmsc_result_t * 	xmmsc_broadcast_config_value_changed (xmmsc_connection_t *c)
foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsc_broadcast_config_value_changed" 
    xmmsc_broadcast_config_value_changed :: Ptr C_xmmsc_connection -> IO (Ptr C_xmmsc_result)
-- |Requests the config_value_changed broadcast. 
broadcastValueChanged :: Connection -> IO Result
broadcastValueChanged = wrapCallResult xmmsc_broadcast_config_value_changed