mtp-0.1.1.1: MTP/Foreign.hsc
{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}
-- |
-- Module : MTP.Foreign
-- Copyright : (c) Joachim Fasting 2010
-- License : LGPL
--
-- Maintainer : Joachim Fasting <joachim.fasting@gmail.com>
-- Stability : unstable
-- Portability : not portable
--
-- Bindings to libmtp. Foreign interface.
module MTP.Foreign where
import Foreign
import Foreign.C
#include <libmtp.h>
#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t(y__); }, y__)
------------------------------------------------------------------------------
-- Constants
------------------------------------------------------------------------------
-- | MTP library version.
version :: Integer
version = #const LIBMTP_VERSION_STRING
------------------------------------------------------------------------------
-- Types
------------------------------------------------------------------------------
-- | Filetype enumeration.
newtype FileType = FileType { unFileType :: CInt }
deriving (Eq, Ord, Show)
#{enum FileType, FileType
,wav = LIBMTP_FILETYPE_WAV
,mp3 = LIBMTP_FILETYPE_MP3
,wma = LIBMTP_FILETYPE_WMA
,ogg = LIBMTP_FILETYPE_OGG
,audible = LIBMTP_FILETYPE_AUDIBLE
,mp4 = LIBMTP_FILETYPE_MP4
,undef_audio = LIBMTP_FILETYPE_UNDEF_AUDIO
,wmv = LIBMTP_FILETYPE_WMV
,avi = LIBMTP_FILETYPE_AVI
,mpeg = LIBMTP_FILETYPE_MPEG
,asf = LIBMTP_FILETYPE_ASF
,qt = LIBMTP_FILETYPE_QT
,undef_video = LIBMTP_FILETYPE_UNDEF_VIDEO
,jpeg = LIBMTP_FILETYPE_JPEG
,jfif = LIBMTP_FILETYPE_JFIF
,tiff = LIBMTP_FILETYPE_TIFF
,bmp = LIBMTP_FILETYPE_BMP
,gif = LIBMTP_FILETYPE_GIF
,pict = LIBMTP_FILETYPE_PICT
,png = LIBMTP_FILETYPE_PNG
,vcalendar1 = LIBMTP_FILETYPE_VCALENDAR1
,vcalendar2 = LIBMTP_FILETYPE_VCALENDAR2
,vcard2 = LIBMTP_FILETYPE_VCARD2
,vcard3 = LIBMTP_FILETYPE_VCARD3
,windowsimageformat = LIBMTP_FILETYPE_WINDOWSIMAGEFORMAT
,winexec = LIBMTP_FILETYPE_WINEXEC
,text = LIBMTP_FILETYPE_TEXT
,html = LIBMTP_FILETYPE_HTML
,firmware = LIBMTP_FILETYPE_FIRMWARE
,aac = LIBMTP_FILETYPE_AAC
,mediacard = LIBMTP_FILETYPE_MEDIACARD
,flac = LIBMTP_FILETYPE_FLAC
,mp2 = LIBMTP_FILETYPE_MP2
,m4a = LIBMTP_FILETYPE_M4A
,doc = LIBMTP_FILETYPE_DOC
,xml = LIBMTP_FILETYPE_XML
,xls = LIBMTP_FILETYPE_XLS
,ppt = LIBMTP_FILETYPE_PPT
,mht = LIBMTP_FILETYPE_MHT
,jp2 = LIBMTP_FILETYPE_JP2
,jpx = LIBMTP_FILETYPE_JPX
,album = LIBMTP_FILETYPE_ALBUM
,playlist = LIBMTP_FILETYPE_PLAYLIST
,unknown = LIBMTP_FILETYPE_UNKNOWN
}
-- Error code enumeration.
newtype ErrorCode = ErrorCode { unErrorCode :: CInt }
deriving (Eq, Show)
#{enum ErrorCode, ErrorCode
,general = LIBMTP_ERROR_GENERAL
,noDevice = LIBMTP_ERROR_NO_DEVICE_ATTACHED
,storageFull = LIBMTP_ERROR_STORAGE_FULL
,connectionFailed = LIBMTP_ERROR_CONNECTING
,cancelled = LIBMTP_ERROR_CANCELLED
}
-- Opaque types, only passed around between C funcs, but never
-- dereferenced on the Haskell side.
data MTPDevice
data Data
data Callback
-- An intermediate structure for the LIBMTP_error_t struct.
data Error_t = Error_t
{ et_errornumber :: CInt
, et_errortext :: CString
, et_next :: Ptr Error_t
}
instance Storable Error_t where
sizeOf _ = #{size LIBMTP_error_t}
alignment _ = #{alignment LIBMTP_error_t}
peek ptr = do
en <- #{peek LIBMTP_error_t, errornumber} ptr
et <- #{peek LIBMTP_error_t, error_text} ptr
next <- #{peek LIBMTP_error_t, next} ptr
return $! Error_t { et_errornumber = en
, et_errortext = et
, et_next = next
}
-- An intermediate structure for the LIBMTP_file_t struct.
-- We need this because LIBMPT_file_t is recursive.
data File_t = File_t
{ ft_item_id :: CInt
, ft_parent_id :: CInt
, ft_storage_id :: CInt
, ft_filename :: CString
, ft_filesize :: CInt
, ft_filetype :: CInt
, ft_next :: Ptr File_t
}
instance Storable File_t where
sizeOf _ = #{size LIBMTP_file_t}
alignment _ = #{alignment LIBMTP_file_t}
peek ptr = do
fid <- #{peek LIBMTP_file_t, item_id} ptr
pid <- #{peek LIBMTP_file_t, parent_id} ptr
sid <- #{peek LIBMTP_file_t, storage_id} ptr
name <- #{peek LIBMTP_file_t, filename} ptr
size <- #{peek LIBMTP_file_t, filesize} ptr
typ <- #{peek LIBMTP_file_t, filetype} ptr
next <- #{peek LIBMTP_file_t, next} ptr
return $! File_t fid pid sid name size typ next
poke ptr ft = do
#{poke LIBMTP_file_t, item_id} ptr (ft_item_id ft)
#{poke LIBMTP_file_t, parent_id} ptr (ft_parent_id ft)
#{poke LIBMTP_file_t, filename} ptr (ft_filename ft)
#{poke LIBMTP_file_t, filesize} ptr (ft_filesize ft)
#{poke LIBMTP_file_t, next} ptr (ft_next ft)
-- An intermediate structure for the LIBMTP_track_t struct.
-- We need this because LIBMTP_track_t is recursive.
data Track_t = Track_t
{ tt_item_id :: CInt
, tt_parent_id :: CInt
, tt_storage_id :: CInt
, tt_title :: CString
, tt_artist :: CString
, tt_composer :: CString
, tt_genre :: CString
, tt_album :: CString
, tt_date :: CString
, tt_filename :: CString
, tt_tracknumber :: CInt
, tt_duration :: CInt
, tt_samplerate :: CInt
, tt_nochannels :: CInt
, tt_wavecodec :: CInt
, tt_bitrate :: CInt
, tt_bitratetype :: CInt
, tt_rating :: CInt
, tt_usecount :: CInt
, tt_filesize :: CInt
, tt_filetype :: CInt
, tt_next :: Ptr Track_t
}
instance Storable Track_t where
sizeOf _ = #{size LIBMTP_track_t}
alignment _ = #{alignment LIBMTP_track_t}
peek ptr = do
iid <- #{peek LIBMTP_track_t, item_id} ptr
pid <- #{peek LIBMTP_track_t, parent_id} ptr
sid <- #{peek LIBMTP_track_t, storage_id} ptr
title <- #{peek LIBMTP_track_t, title} ptr
artist <- #{peek LIBMTP_track_t, artist} ptr
composer <- #{peek LIBMTP_track_t, composer} ptr
genre <- #{peek LIBMTP_track_t, genre} ptr
alb <- #{peek LIBMTP_track_t, album} ptr
date <- #{peek LIBMTP_track_t, date} ptr
fname <- #{peek LIBMTP_track_t, filename} ptr
trackno <- #{peek LIBMTP_track_t, tracknumber} ptr
dur <- #{peek LIBMTP_track_t, duration} ptr
srate <- #{peek LIBMTP_track_t, samplerate} ptr
chans <- #{peek LIBMTP_track_t, nochannels} ptr
codec <- #{peek LIBMTP_track_t, wavecodec} ptr
brate <- #{peek LIBMTP_track_t, bitrate} ptr
bratetype <- #{peek LIBMTP_track_t, bitratetype} ptr
rating <- #{peek LIBMTP_track_t, rating} ptr
count <- #{peek LIBMTP_track_t, usecount} ptr
fsize <- #{peek LIBMTP_track_t, filesize} ptr
ftype <- #{peek LIBMTP_track_t, filetype} ptr
next <- #{peek LIBMTP_track_t, next} ptr
return $! Track_t iid pid sid title artist composer genre alb
date fname trackno dur srate chans codec brate
bratetype rating count fsize ftype next
poke ptr tt = do
#{poke LIBMTP_track_t, item_id} ptr (tt_item_id tt)
#{poke LIBMTP_track_t, parent_id} ptr (tt_parent_id tt)
#{poke LIBMTP_track_t, storage_id} ptr (tt_storage_id tt)
#{poke LIBMTP_track_t, title} ptr (tt_title tt)
#{poke LIBMTP_track_t, artist} ptr (tt_artist tt)
#{poke LIBMTP_track_t, composer} ptr (tt_composer tt)
#{poke LIBMTP_track_t, genre} ptr (tt_genre tt)
#{poke LIBMTP_track_t, album} ptr (tt_album tt)
#{poke LIBMTP_track_t, date} ptr (tt_date tt)
#{poke LIBMTP_track_t, filename} ptr (tt_filename tt)
#{poke LIBMTP_track_t, tracknumber} ptr (tt_tracknumber tt)
#{poke LIBMTP_track_t, duration} ptr (tt_duration tt)
#{poke LIBMTP_track_t, samplerate} ptr (tt_samplerate tt)
#{poke LIBMTP_track_t, nochannels} ptr (tt_nochannels tt)
#{poke LIBMTP_track_t, wavecodec} ptr (tt_wavecodec tt)
#{poke LIBMTP_track_t, bitrate} ptr (tt_bitrate tt)
#{poke LIBMTP_track_t, bitratetype} ptr (tt_bitratetype tt)
#{poke LIBMTP_track_t, rating} ptr (tt_rating tt)
#{poke LIBMTP_track_t, usecount} ptr (tt_usecount tt)
#{poke LIBMTP_track_t, filesize} ptr (tt_filesize tt)
#{poke LIBMTP_track_t, filetype} ptr (tt_filetype tt)
#{poke LIBMTP_track_t, next} ptr (tt_next tt)
-- An intermediate structure for the LIBMTP_folder_t struct.
-- We need this because LIBMTP_folder_t is recursive.
data Folder_t = Folder_t
{ fdt_folder_id :: CInt
, fdt_parent_id :: CInt
, fdt_storage_id :: CInt
, fdt_name :: CString
, fdt_sibling :: Ptr Folder_t
, fdt_child :: Ptr Folder_t
}
instance Storable Folder_t where
sizeOf _ = #{size LIBMTP_folder_t}
alignment _ = #{alignment LIBMTP_folder_t}
peek ptr = do
fid <- #{peek LIBMTP_folder_t, folder_id} ptr
pid <- #{peek LIBMTP_folder_t, parent_id} ptr
sid <- #{peek LIBMTP_folder_t, storage_id} ptr
name <- #{peek LIBMTP_folder_t, name} ptr
sibling <- #{peek LIBMTP_folder_t, sibling} ptr
child <- #{peek LIBMTP_folder_t, child} ptr
return $! Folder_t { fdt_folder_id = fid
, fdt_parent_id = pid
, fdt_storage_id = sid
, fdt_name = name
, fdt_sibling = sibling
, fdt_child = child
}
poke ptr fdt = do
#{poke LIBMTP_folder_t, folder_id} ptr (fdt_folder_id fdt)
#{poke LIBMTP_folder_t, parent_id} ptr (fdt_parent_id fdt)
#{poke LIBMTP_folder_t, storage_id} ptr (fdt_storage_id fdt)
#{poke LIBMTP_folder_t, name} ptr (fdt_name fdt)
#{poke LIBMTP_folder_t, sibling} ptr (fdt_sibling fdt)
#{poke LIBMTP_folder_t, child} ptr (fdt_child fdt)
-- An intermediate structure for the LIBMTP_playlist_t struct.
-- We need this because LIBMTP_playlist_t is recursive.
data Playlist_t = Playlist_t
{ pt_playlist_id :: CInt
, pt_parent_id :: CInt
, pt_storage_id :: CInt
, pt_name :: CString
, pt_tracks :: Ptr CInt
, pt_no_tracks :: CInt
, pt_next :: Ptr Playlist_t
}
instance Storable Playlist_t where
sizeOf _ = #{size LIBMTP_playlist_t}
alignment _ = #{alignment LIBMTP_playlist_t}
peek ptr = do
plid <- #{peek LIBMTP_playlist_t, playlist_id} ptr
pid <- #{peek LIBMTP_playlist_t, parent_id} ptr
sid <- #{peek LIBMTP_playlist_t, storage_id} ptr
name <- #{peek LIBMTP_playlist_t, name} ptr
tracks <- #{peek LIBMTP_playlist_t, tracks} ptr
ntracks <- #{peek LIBMTP_playlist_t, no_tracks} ptr
next <- #{peek LIBMTP_playlist_t, next} ptr
return $ Playlist_t plid pid sid name tracks ntracks next
poke ptr pt = do
#{poke LIBMTP_playlist_t, playlist_id} ptr (pt_playlist_id pt)
#{poke LIBMTP_playlist_t, parent_id} ptr (pt_parent_id pt)
#{poke LIBMTP_playlist_t, storage_id} ptr (pt_storage_id pt)
#{poke LIBMTP_playlist_t, name} ptr (pt_name pt)
#{poke LIBMTP_playlist_t, tracks} ptr (pt_tracks pt)
#{poke LIBMTP_playlist_t, no_tracks} ptr (pt_no_tracks pt)
#{poke LIBMTP_playlist_t, next} ptr (pt_next pt)
------------------------------------------------------------------------------
-- Foreign imports
------------------------------------------------------------------------------
foreign import ccall unsafe "LIBMTP_Init" c_init :: IO ()
foreign import ccall unsafe "LIBMTP_Get_First_Device" c_get_first_device
:: IO (Ptr MTPDevice)
foreign import ccall unsafe "LIBMTP_Release_Device" c_release_device
:: Ptr MTPDevice -> IO ()
foreign import ccall unsafe "LIBMTP_Reset_Device" c_reset_device
:: Ptr MTPDevice
-> IO CInt
foreign import ccall unsafe "LIBMTP_Get_Errorstack" c_get_errorstack
:: Ptr MTPDevice
-> IO (Ptr Error_t)
foreign import ccall unsafe "LIBMTP_Clear_Errorstack" c_clear_errorstack
:: Ptr MTPDevice
-> IO ()
foreign import ccall unsafe "LIBMTP_Get_Manufacturername"
c_get_manufacturername :: Ptr MTPDevice -> IO CString
foreign import ccall unsafe "LIBMTP_Get_Modelname"
c_get_modelname :: Ptr MTPDevice -> IO CString
foreign import ccall unsafe "LIBMTP_Get_Serialnumber"
c_get_serialnumber :: Ptr MTPDevice -> IO CString
foreign import ccall unsafe "LIBMTP_Get_Friendlyname"
c_get_friendlyname :: Ptr MTPDevice -> IO CString
foreign import ccall unsafe "LIBMTP_Get_Deviceversion" c_get_deviceversion
:: Ptr MTPDevice -> IO CString
foreign import ccall unsafe "LIBMTP_Get_Batterylevel" c_get_batterylevel
:: Ptr MTPDevice
-> Ptr CInt
-> Ptr CInt
-> IO CInt
foreign import ccall unsafe "LIBMTP_Get_Supported_Filetypes"
c_get_supported_filetypes :: Ptr MTPDevice
-> Ptr CInt
-> Ptr CInt
-> IO CInt
foreign import ccall unsafe "LIBMTP_Get_Filelisting_With_Callback" c_get_filelisting
:: Ptr MTPDevice
-> Ptr Callback
-> Ptr Data
-> IO (Ptr File_t)
foreign import ccall unsafe "LIBMTP_Track_Exists" c_track_exists
:: Ptr MTPDevice
-> CInt
-> IO CInt
foreign import ccall unsafe "LIBMTP_Get_File_To_File" c_get_file_to_file
:: Ptr MTPDevice
-> CInt
-> CString
-> Ptr Callback
-> Ptr Data
-> IO CInt
foreign import ccall unsafe "LIBMTP_Send_File_From_File" c_send_file_from_file
:: Ptr MTPDevice
-> CString
-> Ptr Callback
-> Ptr Data
-> IO CInt
foreign import ccall unsafe "LIBMTP_Get_File_To_File_Descriptor"
c_get_file_to_file_descriptor :: Ptr MTPDevice
-> CInt
-> Ptr CFile
-> Ptr Callback
-> Ptr Data
-> IO CInt
foreign import ccall unsafe "LIBMTP_Send_File_From_File_Descriptor"
c_send_file_from_file_descriptor :: Ptr MTPDevice
-> Ptr CFile
-> Ptr File_t
-> Ptr Callback
-> Ptr Data
-> IO CInt
foreign import ccall unsafe "LIBMTP_Set_File_Name" c_set_file_name
:: Ptr MTPDevice
-> Ptr File_t
-> CString
-> IO CInt
foreign import ccall unsafe "LIBMTP_Get_Tracklisting_With_Callback" c_get_tracklisting
:: Ptr MTPDevice
-> Ptr Callback
-> Ptr Data
-> IO (Ptr Track_t)
foreign import ccall unsafe "LIBMTP_Get_Track_To_File" c_get_track_to_file
:: Ptr MTPDevice
-> CInt
-> CString
-> Ptr Callback
-> Ptr Data
-> IO CInt
foreign import ccall unsafe "LIBMTP_Send_Track_From_File" c_send_track_from_file
:: Ptr MTPDevice
-> CString
-> (Ptr Track_t)
-> Ptr Callback
-> Ptr Data
-> IO CInt
foreign import ccall unsafe "LIBMTP_Send_Track_From_File_Descriptor"
c_send_track_from_file_descriptor :: Ptr MTPDevice
-> Ptr CFile
-> Ptr Track_t
-> Ptr Callback
-> Ptr Data
-> IO CInt
foreign import ccall unsafe "LIBMTP_Get_Track_To_File_Descriptor"
c_get_track_to_file_descriptor :: Ptr MTPDevice
-> CInt
-> Ptr CFile
-> Ptr Callback
-> Ptr Data
-> IO CInt
foreign import ccall unsafe "LIBMTP_Get_Trackmetadata"
c_get_trackmetadata :: Ptr MTPDevice
-> CInt
-> IO (Ptr Track_t)
foreign import ccall unsafe "LIBMTP_Update_Track_Metadata"
c_update_track_metadata :: Ptr MTPDevice
-> Ptr Track_t
-> IO CInt
foreign import ccall unsafe "LIBMTP_Set_Track_Name" c_set_track_name
:: Ptr MTPDevice
-> Ptr Track_t
-> CString
-> IO CInt
foreign import ccall unsafe "LIBMTP_Create_Folder" c_create_folder
:: Ptr MTPDevice
-> CString
-> CInt
-> CInt
-> IO CInt
foreign import ccall unsafe "LIBMTP_Get_Folder_List" c_folder_list
:: Ptr MTPDevice
-> IO (Ptr Folder_t)
foreign import ccall unsafe "LIBMTP_Set_Folder_Name" c_set_folder_name
:: Ptr MTPDevice
-> Ptr Folder_t
-> CString
-> IO CInt
foreign import ccall unsafe "LIBMTP_Get_Playlist_List"
c_get_playlist_list :: Ptr MTPDevice
-> IO (Ptr Playlist_t)
foreign import ccall unsafe "LIBMTP_Get_Playlist"
c_get_playlist :: Ptr MTPDevice
-> CInt
-> IO (Ptr Playlist_t)
foreign import ccall unsafe "LIBMTP_Create_New_Playlist"
c_create_new_playlist :: Ptr MTPDevice
-> Ptr Playlist_t
-> IO CInt
foreign import ccall unsafe "LIBMTP_Update_Playlist"
c_update_playlist :: Ptr MTPDevice
-> Ptr Playlist_t
-> IO CInt
foreign import ccall unsafe "LIBMTP_Set_Playlist_Name"
c_set_playlist_name :: Ptr MTPDevice
-> Ptr Playlist_t
-> CString
-> IO CInt
foreign import ccall unsafe "LIBMTP_Delete_Object"
c_delete_object :: Ptr MTPDevice
-> CInt
-> IO CInt
foreign import ccall unsafe "LIBMTP_Set_Object_Filename"
c_set_object_filename :: Ptr MTPDevice
-> CInt
-> CString
-> IO CInt