module Network.XMMS.Value where
import Foreign
import Foreign.Ptr
import Foreign.C.Types
import Network.XMMS.UTF8Strings
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
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 :: (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"
foreign import ccall unsafe "xmmsclient/xmmsclient.h &xmmsv_unref"
xmmsv_unref :: FunPtr (Ptr C_xmmsc_value -> IO ())
foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_new_int"
xmmsv_new_int :: CInt -> IO (Ptr C_xmmsc_value)
foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_new_string"
xmmsv_new_string :: CString -> IO (Ptr C_xmmsc_value)
foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_new_list"
xmmsv_new_list :: IO (Ptr C_xmmsc_value)
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 <- safePeekUTF8String key
valueHS <- convertValueCtoHs value
return $ Map.insert keyString valueHS rest
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
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)
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 ()
foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_dict_get_size"
xmmsv_dict_get_size :: Ptr C_xmmsc_value -> IO CInt
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
safePeekUTF8String buf
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
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 <- safePeekUTF8String buf
free bufPtr
return $ Just res
foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_get_type"
xmmsv_get_type :: Ptr C_xmmsc_value -> IO CInt