{-# 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.Medialib( 
    medialibGetInfo
)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_medialib_get_info (xmmsc_connection_t *, int)
foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsc_medialib_get_info" xmmsc_medialib_get_info :: Ptr C_xmmsc_connection -> CInt -> IO (Ptr C_xmmsc_result)
-- |Retrieve information about an entry from the medialib. 
medialibGetInfo :: Connection -> Int -> IO Result
medialibGetInfo = flip $ wrapCallResult.(flip xmmsc_medialib_get_info).fromIntegral