{-# 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.Value where import Foreign import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Foreign.ForeignPtr import Foreign.Marshal.Alloc import Data.Map (Map) import Data.Map as Map import Network.XMMS.Utilities import Network.XMMS.Constants import Network.XMMS.Types --xmmsv_t* xmmsc_result_get_value(xmmsc_result_t *result) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsc_result_get_value" xmmsc_result_get_value :: Ptr C_xmmsc_result -> IO (Ptr C_xmmsc_value) resultGetValue :: Result -> IO XMMSCV resultGetValue result = withForeignPtr result (\ptrRes -> do value <- xmmsc_result_get_value ptrRes convertValueCtoHs value ) {-propdictToDict :: [(String, XMMSCV)] -> [(String, XMMSCV)] propdictToDict dict = concat $ Map.map cleanSource dict where cleanSource (key, XMMSDict dict) = zip (repeat key) (map snd dict) cleanSource x = [x] -} propdictToDict :: (Map String XMMSCV) -> (Map String XMMSCV) propdictToDict dict = Map.map cleanSource dict where cleanSource (XMMSDict dict) = head $ elems dict cleanSource _ = error "the dictionary is not a propdict" --void xmmsv_unref (xmmsv_t *val) foreign import ccall unsafe "xmmsclient/xmmsclient.h &xmmsv_unref" xmmsv_unref :: FunPtr (Ptr C_xmmsc_value -> IO ()) --xmmsv_t* xmmsv_new_int (int32_t i) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_new_int" xmmsv_new_int :: CInt -> IO (Ptr C_xmmsc_value) --xmmsv_t* xmmsv_new_string(const char *s) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_new_string" xmmsv_new_string :: CString -> IO (Ptr C_xmmsc_value) --xmmsv_t* xmmsv_new_list (void ) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_new_list" xmmsv_new_list :: IO (Ptr C_xmmsc_value) --int xmmsv_list_append(xmmsv_t *listv, xmmsv_t *val) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_list_append" xmmsv_list_append :: Ptr C_xmmsc_value -> Ptr C_xmmsc_value -> IO CInt convertValueHstoC :: XMMSCV -> IO (ForeignPtr C_xmmsc_value) convertValueHstoC (XMMSInt i) = do ptrValue <- xmmsv_new_int (fromIntegral i) newForeignPtr xmmsv_unref ptrValue convertValueHstoC (XMMSString s) = do cStr <- newCString s ptrValue <- xmmsv_new_string cStr free cStr newForeignPtr xmmsv_unref ptrValue convertValueHstoC (XMMSList l) = do ptrList <- xmmsv_new_list mapM_ (\v -> do fPtr <- convertValueHstoC v withForeignPtr fPtr (\ptrValue -> xmmsv_list_append ptrList ptrValue)) l newForeignPtr xmmsv_unref ptrList convertValueCtoHs :: Ptr C_xmmsc_value -> IO XMMSCV convertValueCtoHs value = do vType <- xmmsv_get_type value convertValueType' vType value where convertValueType' vType value |vType==typeError = do errorMsg <- xmmsVGetError value return $ XMMSError errorMsg |vType==typeInt32 = do maybeIntValue <- xmmsVGetInt value case maybeIntValue of Just intValue -> return $ XMMSInt $ fromIntegral intValue Nothing -> return $ XMMSError "failed to get int value" |vType==typeString = do maybeValue <- xmmsVGetString value case maybeValue of Just stringValue -> return $ XMMSString stringValue Nothing -> return $ XMMSError "failed to get string value" |vType==typeList = do maybeValue <- xmmsVGetList value case maybeValue of Just listValue -> return $ XMMSList listValue Nothing -> return $ XMMSError "failed to get list value" |vType==typeDict = do count <- xmmsv_dict_get_size value keys <- allocate_keys count values <- allocate_values count xmmsv_get_dict keys values value dictValue <- marshallDict keys values free_keys keys free_values values return $ XMMSDict dictValue |vType==typeString = do maybeValue <- xmmsVGetString value case maybeValue of Just stringValue -> return $ XMMSString stringValue Nothing -> return $ XMMSError "failed to get string value" |otherwise = return XMMSNothing marshallDict :: Ptr CString -> Ptr (Ptr C_xmmsc_value) -> IO (Map String XMMSCV) marshallDict keys values = do key <- peek keys value <- peek values if key==nullPtr || value==nullPtr then return Map.empty else do rest <- marshallDict (plusPtr keys (sizeOf key)) (plusPtr values (sizeOf value)) keyString <- safePeekCString key valueHS <- convertValueCtoHs value return $ Map.insert keyString valueHS rest --int xmmsv_list_get_size(xmmsv_t* listv) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_list_get_size" xmmsv_list_get_size :: Ptr C_xmmsc_value -> IO CInt xmmsVListGetSize :: Ptr C_xmmsc_value -> IO Int xmmsVListGetSize value = do size <- xmmsv_list_get_size value return $ fromIntegral size -- int xmmsv_list_get (xmmsv_t *listv, int pos, xmmsv_t **val) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_list_get" xmmsv_list_get :: Ptr C_xmmsc_value -> CInt -> Ptr (Ptr C_xmmsc_value) -> IO Int xmmsVGetList :: Ptr C_xmmsc_value -> IO(Maybe [XMMSCV]) xmmsVGetList value = do size <- xmmsVListGetSize value let retrieve k |k==size = return [] |otherwise = do buf <- malloc xmmsv_list_get value (fromIntegral k) buf bufValue <- peek buf current <- convertValueCtoHs bufValue rest <- retrieve (k+1) return (current:rest) res <- retrieve 0 return (Just res) --void xmmsv_get_dict(char **key, xmmsv_t **value, xmmsv_t *dict) foreign import ccall unsafe "XMMS/XMMSUtils.h xmmsv_get_dict" xmmsv_get_dict :: Ptr CString -> Ptr (Ptr C_xmmsc_value) -> Ptr C_xmmsc_value -> IO () foreign import ccall unsafe "XMMS/XMMSUtils.h allocate_keys" allocate_keys :: CInt -> IO (Ptr CString) foreign import ccall unsafe "XMMS/XMMSUtils.h free_keys" free_keys :: Ptr CString -> IO () foreign import ccall unsafe "XMMS/XMMSUtils.h allocate_values" allocate_values :: CInt -> IO (Ptr (Ptr C_xmmsc_value)) foreign import ccall unsafe "XMMS/XMMSUtils.h free_values" free_values :: Ptr (Ptr C_xmmsc_value) -> IO () --int xmmsv_dict_get_size (xmmsv_t *dictv) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_dict_get_size" xmmsv_dict_get_size :: Ptr C_xmmsc_value -> IO CInt --int xmmsv_get_error (xmmsv_t *return_value, char *err_buf) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_get_error" xmmsv_get_error :: Ptr C_xmmsc_value -> Ptr CString -> IO CInt xmmsVGetError :: Ptr C_xmmsc_value -> IO String xmmsVGetError value = do bufPtr <- malloc res <- xmmsv_get_error value bufPtr if res==0 then return "" else do buf <- peek bufPtr free bufPtr safePeekCString buf --int xmmsv_get_int (xmmsv_t *return_value, int *v) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_get_int" xmmsv_get_int :: Ptr C_xmmsc_value -> Ptr CInt -> IO CInt xmmsVGetInt :: Ptr C_xmmsc_value -> IO (Maybe Int) xmmsVGetInt value = do v <- malloc res <- xmmsv_get_int value v intValue <- peek v free v if res==0 then return Nothing else return $ Just $ fromIntegral intValue --int xmmsv_get_string (xmmsv_t *return_value, int *v) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_get_string" xmmsv_get_string :: Ptr C_xmmsc_value -> Ptr CString -> IO CInt xmmsVGetString :: Ptr C_xmmsc_value -> IO (Maybe String) xmmsVGetString value = do bufPtr <- malloc res <- xmmsv_get_string value bufPtr if res==0 then return Nothing else do buf <- peek bufPtr res <- safePeekCString buf free bufPtr return $ Just res --xmmsv_type_t xmmsv_get_type (xmmsv_t* value) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_get_type" xmmsv_get_type :: Ptr C_xmmsc_value -> IO CInt