{-# 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 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


--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 <- safePeekUTF8String 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
                  safePeekUTF8String 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 <- safePeekUTF8String 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