-- 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.Types 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 Network.XMMS.Constants



--xmmsc_connection_t*
type C_xmmsc_connection = ()
type Connection = ForeignPtr C_xmmsc_connection

--xmmsc_result_t*
type C_xmmsc_result = ()
type Result = ForeignPtr C_xmmsc_result

--xmmsv_t*
type C_xmmsc_value = ()
data XMMSCV = XMMSNothing
            | XMMSError { xmmsError :: String }
            | XMMSInt { xmmsInt :: Int }
            | XMMSString { xmmsString :: String }
            | XMMSDict { xmmsDict :: (Map String XMMSCV) }
            | XMMSList { xmmsList :: [XMMSCV] }
--        deriving (Show)

instance Show XMMSCV where
    show XMMSNothing = "XMMSNothing"
    show (XMMSError e) = "Error: " ++ e
    show (XMMSInt i) = show i
    show (XMMSString s) = s
    show (XMMSList l) = show l
    show (XMMSDict d) = show d

data SeekMode = SeekCur
              | SeekSet

fromSeekMode SeekCur = playbackSeekCur
fromSeekMode SeekSet = playbackSeekSet