module AlsaPlayer where

import Control.Monad.Trans (MonadIO, liftIO)
import Foreign.C.String (CString, peekCString, newCString)
import Foreign.C.Types (CInt, CFloat)
import Foreign.Marshal.Alloc (malloc, free)
import Foreign.Marshal.Array (mallocArray, advancePtr)
import Foreign.Ptr (Ptr)
import Foreign.Storable (peek)

type Session = CInt

class IsCString a where
    to_CString :: a -> IO CString
    from_CString :: CString -> IO a
    used_CString :: a -> CString -> IO ()
    used_CString _ s = free s

instance IsCString CString where
    to_CString s = return s
    from_CString s = return s
    used_CString _ _ = return ()

instance IsCString String where
    to_CString s = newCString s
    from_CString s = peekCString s

session_max, title_max, artist_max, album_max, genre_max, stream_type_max,
 status_max, comment_max, track_number_max, year_max, file_path_max :: Int
session_max      = #const AP_SESSION_MAX
title_max        = #const AP_TITLE_MAX
artist_max       = #const AP_ARTIST_MAX
album_max        = #const AP_ALBUM_MAX
genre_max        = #const AP_GENRE_MAX
stream_type_max  = #const AP_STREAM_TYPE_MAX
status_max       = #const AP_STATUS_MAX
comment_max      = #const AP_COMMENT_MAX
track_number_max = #const AP_TRACK_NUMBER_MAX
year_max         = #const AP_YEAR_MAX
file_path_max    = #const AP_FILE_PATH_MAX

-- Status functions

foreign import ccall "static alsaplayer/control.h ap_find_session"
    ap_find_session
    :: CString -> Ptr CInt -> IO CInt
find_session :: (MonadIO io, IsCString str) => str -> io Session
find_session n
 = liftIO $ do p_i <- malloc
               s <- to_CString n
               check $ ap_find_session s p_i
               used_CString n s
               i <- peek p_i
               free p_i
               return i

foreign import ccall "static alsaplayer/control.h ap_session_running"
    ap_session_running
    :: CInt -> IO CInt
session_running :: MonadIO io => Session -> io Bool
session_running s = liftIO $ do r <- ap_session_running s
                                return (r /= 0)

foreign import ccall "static alsaplayer/control.h ap_version"
    version
    :: CInt

-- State changes

foreign import ccall "static alsaplayer/control.h ap_play" ap_play
    :: CInt -> IO CInt
play :: MonadIO io => Session -> io ()
play session = liftIO $ check $ ap_play session

foreign import ccall "static alsaplayer/control.h ap_stop" ap_stop
    :: CInt -> IO CInt
stop :: MonadIO io => Session -> io ()
stop session = liftIO $ check $ ap_stop session

foreign import ccall "static alsaplayer/control.h ap_pause" ap_pause
    :: CInt -> IO CInt
pause :: MonadIO io => Session -> io ()
pause session = liftIO $ check $ ap_pause session

foreign import ccall "static alsaplayer/control.h ap_unpause" ap_unpause
    :: CInt -> IO CInt
unpause :: MonadIO io => Session -> io ()
unpause session = liftIO $ check $ ap_unpause session

foreign import ccall "static alsaplayer/control.h ap_next" ap_next
    :: CInt -> IO CInt
next :: MonadIO io => Session -> io ()
next session = liftIO $ check $ ap_next session

foreign import ccall "static alsaplayer/control.h ap_prev" ap_prev
    :: CInt -> IO CInt
prev :: MonadIO io => Session -> io ()
prev session = liftIO $ check $ ap_prev session

foreign import ccall "static alsaplayer/control.h ap_ping" ap_ping
    :: CInt -> IO CInt
ping :: MonadIO io => Session -> io ()
ping session = liftIO $ check $ ap_ping session

foreign import ccall "static alsaplayer/control.h ap_quit" ap_quit
    :: CInt -> IO CInt
quit :: MonadIO io => Session -> io ()
quit session = liftIO $ check $ ap_quit session

foreign import ccall "static alsaplayer/control.h ap_clear_playlist"
    ap_clear_playlist
    :: CInt -> IO CInt
clear_playlist :: MonadIO io => Session -> io ()
clear_playlist session = liftIO $ check $ ap_clear_playlist session

foreign import ccall "static alsaplayer/control.h ap_add_path" ap_add_path
    :: CInt -> CString -> IO CInt
add_path :: (MonadIO io, IsCString str) => Session -> str -> io ()
add_path session str
 = liftIO $ do s <- to_CString str
               check $ ap_add_path session s
               used_CString str s

foreign import ccall "static alsaplayer/control.h ap_add_and_play"
    ap_add_and_play
    :: CInt -> CString -> IO CInt
add_and_play :: (MonadIO io, IsCString str) => Session -> str -> io ()
add_and_play session str
 = liftIO $ do s <- to_CString str
               check $ ap_add_and_play session s
               used_CString str s

foreign import ccall "static alsaplayer/control.h ap_add_playlist"
    ap_add_playlist
    :: CInt -> CString -> IO CInt
add_playlist :: (MonadIO io, IsCString str) => Session -> str -> io ()
add_playlist session str
 = liftIO $ do s <- to_CString str
               check $ ap_add_playlist session s
               used_CString str s

foreign import ccall "static alsaplayer/control.h ap_shuffle_playlist"
    ap_shuffle_playlist
    :: CInt -> IO CInt
shuffle_playlist :: MonadIO io => Session -> io ()
shuffle_playlist session = liftIO $ check $ ap_shuffle_playlist session

foreign import ccall "static alsaplayer/control.h ap_save_playlist"
    ap_save_playlist
    :: CInt -> IO CInt
save_playlist :: MonadIO io => Session -> io ()
save_playlist session = liftIO $ check $ ap_save_playlist session

foreign import ccall "static alsaplayer/control.h ap_get_playlist_length"
    ap_get_playlist_length
    :: CInt -> Ptr CInt -> IO CInt
get_playlist_length :: MonadIO io => Session -> io Int
get_playlist_length s = get_int ap_get_playlist_length s

-- Speed, volume, panning

foreign import ccall "static alsaplayer/control.h ap_set_speed"
    ap_set_speed
    :: CInt -> CFloat -> IO CInt
set_speed :: MonadIO io => Session -> Float -> io ()
set_speed session speed
 = liftIO $ check $ ap_set_speed session (realToFrac speed)

foreign import ccall "static alsaplayer/control.h ap_get_speed"
    ap_get_speed
    :: CInt -> Ptr CFloat -> IO CInt
get_speed :: MonadIO io => Session -> io Float
get_speed s = get_float ap_get_speed s

foreign import ccall "static alsaplayer/control.h ap_set_volume"
    ap_set_volume
    :: CInt -> CFloat -> IO CInt
set_volume :: MonadIO io => Session -> Float -> io ()
set_volume session volume
 = liftIO $ check $ ap_set_volume session (realToFrac volume)

foreign import ccall "static alsaplayer/control.h ap_get_volume"
    ap_get_volume
    :: CInt -> Ptr CFloat -> IO CInt
get_volume :: MonadIO io => Session -> io Float
get_volume s = get_float ap_get_volume s

foreign import ccall "static alsaplayer/control.h ap_set_pan"
    ap_set_pan
    :: CInt -> CFloat -> IO CInt
set_pan :: MonadIO io => Session -> Float -> io ()
set_pan session pan
 = liftIO $ check $ ap_set_pan session (realToFrac pan)

foreign import ccall "static alsaplayer/control.h ap_get_pan"
    ap_get_pan
    :: CInt -> Ptr CFloat -> IO CInt
get_pan :: MonadIO io => Session -> io Float
get_pan s = get_float ap_get_pan s

-- Looping

foreign import ccall "static alsaplayer/control.h ap_set_looping"
    ap_set_looping
    :: CInt -> CInt -> IO CInt
set_looping :: MonadIO io => Session -> Bool -> io ()
set_looping session looping
 = liftIO $ check $ ap_set_looping session ci
    where ci = if looping then 1 else 0

foreign import ccall "static alsaplayer/control.h ap_is_looping"
    ap_is_looping
    :: CInt -> Ptr CInt -> IO CInt
is_looping :: MonadIO io => Session -> io Bool
is_looping s = get_bool ap_is_looping s

foreign import ccall "static alsaplayer/control.h ap_set_playlist_looping"
    ap_set_playlist_looping
    :: CInt -> CInt -> IO CInt
set_playlist_looping :: MonadIO io => Session -> Bool -> io ()
set_playlist_looping session playlist_looping
 = liftIO $ check $ ap_set_playlist_looping session ci
    where ci = if playlist_looping then 1 else 0

foreign import ccall "static alsaplayer/control.h ap_is_playlist_looping"
    ap_is_playlist_looping
    :: CInt -> Ptr CInt -> IO CInt
is_playlist_looping :: MonadIO io => Session -> io Bool
is_playlist_looping s = get_bool ap_is_playlist_looping s

-- A couple of random bits

foreign import ccall "static alsaplayer/control.h ap_get_tracks"
    ap_get_tracks
    :: CInt -> Ptr CInt -> IO CInt
get_tracks :: MonadIO io => Session -> io Int
get_tracks s = get_int ap_get_tracks s

foreign import ccall "static alsaplayer/control.h ap_get_session_name"
    ap_get_session_name
    :: CInt -> CString -> IO CInt
get_session_name :: (MonadIO io, IsCString str) => Session -> io str
get_session_name s = get_text (ap_get_session_name s) session_max

-- The text querying functions

foreign import ccall "static alsaplayer/control.h ap_get_title"
    ap_get_title
    :: CInt -> CString -> IO CInt
get_title :: (MonadIO io, IsCString str) => Session -> io str
get_title s = get_text (ap_get_title s) title_max

foreign import ccall "static alsaplayer/control.h ap_get_artist"
    ap_get_artist
    :: CInt -> CString -> IO CInt
get_artist :: (MonadIO io, IsCString str) => Session -> io str
get_artist s = get_text (ap_get_artist s) artist_max

foreign import ccall "static alsaplayer/control.h ap_get_album"
    ap_get_album
    :: CInt -> CString -> IO CInt
get_album :: (MonadIO io, IsCString str) => Session -> io str
get_album s = get_text (ap_get_album s) album_max

foreign import ccall "static alsaplayer/control.h ap_get_genre"
    ap_get_genre
    :: CInt -> CString -> IO CInt
get_genre :: (MonadIO io, IsCString str) => Session -> io str
get_genre s = get_text (ap_get_genre s) genre_max

foreign import ccall "static alsaplayer/control.h ap_get_year"
    ap_get_year
    :: CInt -> CString -> IO CInt
get_year :: (MonadIO io, IsCString str) => Session -> io str
get_year s = get_text (ap_get_year s) year_max

foreign import ccall "static alsaplayer/control.h ap_get_track_number"
    ap_get_track_number
    :: CInt -> CString -> IO CInt
get_track_number :: (MonadIO io, IsCString str) => Session -> io str
get_track_number s = get_text (ap_get_track_number s) track_number_max

foreign import ccall "static alsaplayer/control.h ap_get_comment"
    ap_get_comment
    :: CInt -> CString -> IO CInt
get_comment :: (MonadIO io, IsCString str) => Session -> io str
get_comment s = get_text (ap_get_comment s) comment_max

foreign import ccall "static alsaplayer/control.h ap_get_file_path"
    ap_get_file_path
    :: CInt -> CString -> IO CInt
get_file_path :: (MonadIO io, IsCString str) => Session -> io str
get_file_path s = get_text (ap_get_file_path s) file_path_max

-- The position functions

foreign import ccall "static alsaplayer/control.h ap_set_position"
    ap_set_position
    :: CInt -> CInt -> IO CInt
set_position :: MonadIO io => Session -> Int -> io ()
set_position s i = liftIO $ check $ ap_set_position s (fromIntegral i)

foreign import ccall "static alsaplayer/control.h ap_get_position"
    ap_get_position
    :: CInt -> Ptr CInt -> IO CInt
get_position :: MonadIO io => Session -> io Int
get_position s = get_int ap_get_position s

foreign import ccall "static alsaplayer/control.h ap_set_position_relative"
    ap_set_position_relative
    :: CInt -> CInt -> IO CInt
set_position_relative :: MonadIO io => Session -> Int -> io ()
set_position_relative s i
 = liftIO $ check $ ap_set_position_relative s (fromIntegral i)

foreign import ccall "static alsaplayer/control.h ap_get_length"
    ap_get_length
    :: CInt -> Ptr CInt -> IO CInt
get_length :: MonadIO io => Session -> io Int
get_length s = get_int ap_get_length s

foreign import ccall "static alsaplayer/control.h ap_set_frame"
    ap_set_frame
    :: CInt -> CInt -> IO CInt
set_frame :: MonadIO io => Session -> Int -> io ()
set_frame s i = liftIO $ check $ ap_set_frame s (fromIntegral i)

foreign import ccall "static alsaplayer/control.h ap_get_frame"
    ap_get_frame
    :: CInt -> Ptr CInt -> IO CInt
get_frame :: MonadIO io => Session -> io Int
get_frame s = get_int ap_get_frame s

foreign import ccall "static alsaplayer/control.h ap_get_frames"
    ap_get_frames
    :: CInt -> Ptr CInt -> IO CInt
get_frames :: MonadIO io => Session -> io Int
get_frames s = get_int ap_get_frames s

-- Random bits

foreign import ccall "static alsaplayer/control.h ap_get_stream_type"
    ap_get_stream_type
    :: CInt -> CString -> IO CInt
get_stream_type :: (MonadIO io, IsCString str) => Session -> io str
get_stream_type s = get_text (ap_get_stream_type s) stream_type_max

foreign import ccall "static alsaplayer/control.h ap_get_status"
    ap_get_status
    :: CInt -> CString -> IO CInt
get_status :: (MonadIO io, IsCString str) => Session -> io str
get_status s = get_text (ap_get_status s) status_max

foreign import ccall "static alsaplayer/control.h ap_is_playing"
    ap_is_playing
    :: CInt -> Ptr CInt -> IO CInt
is_playing :: MonadIO io => Session -> io Bool
is_playing s = get_bool ap_is_playing s

foreign import ccall "static alsaplayer/control.h ap_sort"
    ap_sort
    :: CInt -> CString -> IO CInt
sort :: (MonadIO io, IsCString str) => Session -> str -> io ()
sort session sort_str
 = liftIO $ do s <- to_CString sort_str
               check $ ap_sort session s
               used_CString sort_str s

foreign import ccall "static alsaplayer/control.h ap_jump_to"
    ap_jump_to
    :: CInt -> CInt -> IO CInt
jump_to :: MonadIO io => Session -> Int -> io ()
jump_to session pos
 = liftIO $ check $ ap_jump_to session (fromIntegral pos)

-- Playlist functions

foreign import ccall "static alsaplayer/control.h ap_get_playlist_position"
    ap_get_playlist_position
    :: CInt -> Ptr CInt -> IO CInt
get_playlist_position :: MonadIO io => Session -> io Int
get_playlist_position s = get_int ap_get_playlist_position s

foreign import ccall "static alsaplayer/control.h ap_get_file_path_for_track"
    ap_get_file_path_for_track
    :: CInt -> CString -> CInt -> IO CInt
get_file_path_for_track :: (MonadIO io, IsCString str)
                        => Session -> Int -> io str
get_file_path_for_track session pos
 = get_text (\cs -> ap_get_file_path_for_track session cs (fromIntegral pos))
            file_path_max

foreign import ccall "static alsaplayer/control.h ap_insert" ap_insert
    :: CInt -> CString -> CInt -> IO CInt
insert :: (MonadIO io, IsCString str) => Session -> str -> Int -> io ()
insert session str pos
 = liftIO $ do s <- to_CString str
               check $ ap_insert session s (fromIntegral pos)
               used_CString str s

foreign import ccall "static alsaplayer/control.h ap_remove"
    ap_remove
    :: CInt -> CInt -> IO CInt
remove :: MonadIO io => Session -> Int -> io ()
remove session pos
 = liftIO $ check $ ap_remove session (fromIntegral pos)

foreign import ccall "static alsaplayer/control.h ap_set_current"
    ap_set_current
    :: CInt -> CInt -> IO CInt
set_current :: MonadIO io => Session -> Int -> io ()
set_current session pos
 = liftIO $ check $ ap_set_current session (fromIntegral pos)

{-
-- This function doesn't exist yet in my alsaplayer
foreign import ccall "static alsaplayer/control.h ap_get_playlist"
    ap_get_playlist
    :: CInt -> Ptr CInt -> Ptr (Ptr CString) -> IO CInt
get_playlist :: (MonadIO io, IsCString str)
                => Session -> io [str]
get_playlist session
 = liftIO $ do p_i <- malloc
               p_x <- malloc
               check $ ap_get_playlist session p_i p_x
               i <- peek p_i
               x <- peek p_x
               free p_i
               free p_x
               let f offset = do s <- peek (advancePtr x offset)
                                 s' <- from_CString s
                                 used_CString s' s
                                 return s'
               res <- mapM f [0..fromIntegral i - 1]
               free x
               return res
-}

-- Helper functions

get_int :: MonadIO io => (Session -> Ptr CInt -> IO CInt) -> Session -> io Int
get_int f s
 = liftIO $ do p_i <- malloc
               check $ f s p_i
               i <- peek p_i
               free p_i
               return $ fromIntegral i

get_bool :: MonadIO io
         => (CInt -> Ptr CInt -> IO CInt) -> Session -> io Bool
get_bool f s
 = do i <- get_int f s
      return (i /= 0)

get_float :: MonadIO io
          => (CInt -> Ptr CFloat -> IO CInt) -> Session -> io Float
get_float f s
 = liftIO $ do p_x <- malloc
               check $ f s p_x
               x <- peek p_x
               free p_x
               return $ realToFrac x

get_text :: (MonadIO io, IsCString str)
         => (CString -> IO CInt) -> Int -> io str
get_text f m
 = liftIO $ do p_cs <- mallocArray m
               check $ f p_cs
               r <- from_CString p_cs
               used_CString r p_cs
               return r

check :: IO CInt -> IO ()
check c = do r <- c
             return () -- XXX Should do error checking!
-- XXX Should have a check variant that copes with freeing CStrings