module MTP (
MTPHandle, Track(..), File(..), Folder(..), Playlist(..), FileType,
MTPException(..),
version,
wav, mp3, wma, ogg, audible, mp4, undef_audio, wmv, avi, mpeg, asf, qt,
undef_video, jpeg, jfif, tiff, bmp, gif, pict, png, vcalendar1,
vcalendar2, vcard2, vcard3, windowsimageformat, winexec, text, html,
firmware, aac, mediacard, flac, mp2, m4a, doc, xml, xls, ppt, mht, jp2,
unknown,
init, getFirstDevice, releaseDevice, resetDevice,
withFirstDevice,
getDeviceVersion, getManufacturerName, getModelName, getSerialNumber,
getFriendlyName, getBatteryLevel, getSupportedFileTypes,
getFileListing,
getFile, sendFile,
hGetFile, hSendFile,
setFileName,
emptyTrack,
doesTrackExist,
getTrackListing,
getTrack,
sendTrack,
hGetTrack, hSendTrack,
updateTrack,
getTrackMetadata,
setTrackName,
createFolder, getFolderList, setFolderName,
getPlaylistList, getPlaylist, createPlaylist, updatePlaylist,
setPlaylistName,
deleteObject, setObjectName,
findFileType
) where
import Foreign.Handle
import MTP.Foreign
import MTP.Handle
import Control.Exception
import Control.Monad
import Data.Maybe
import Data.Typeable
import Foreign
import Foreign.C
import Prelude hiding (init)
import System.FilePath
import System.IO
data MTPException
= NoDevice
| StorageFull
| ConnectionFailed
| Cancelled
| General String
deriving (Eq, Show, Typeable)
instance Exception MTPException where
data File = File
{ fileID :: Int
, fileParentID :: Int
, fileStorageID :: Int
, fileName :: String
, fileSize :: Integer
, fileType :: FileType
} deriving (Eq, Show)
data Track = Track
{ trackID :: Int
, trackParentID :: Int
, trackStorageID :: Int
, trackTitle :: String
, trackArtist :: String
, trackComposer :: String
, trackGenre :: String
, trackAlbum :: String
, trackDate :: String
, trackFileName :: String
, trackNumber :: Int
, trackDuration :: Int
, trackSamplerate :: Int
, trackChannels :: Int
, trackWavecodec :: Int
, trackBitrate :: Int
, trackBitrateType :: Int
, trackRating :: Int
, trackUseCount :: Int
, trackFileSize :: Integer
, trackFileType :: FileType
} deriving (Eq, Show)
data Folder = Folder
{ folderID :: Int
, folderParentID :: Int
, folderStorageID :: Int
, folderName :: String
, folderChild :: Maybe Folder
}
data Playlist = Playlist
{ playlistID :: Int
, playlistParentID :: Int
, playlistStorageID :: Int
, playlistName :: String
, playlistTracks :: [Int]
, playlistNoTracks :: Int
} deriving (Eq, Show)
init :: IO ()
init = c_init
withFirstDevice :: (MTPHandle -> IO a) -> IO a
withFirstDevice = bracket getFirstDevice releaseDevice
checkError :: MTPHandle -> IO ()
checkError h = withMTPHandle h $ \devptr -> do
e_ptr <- c_get_errorstack devptr
unless (e_ptr == nullPtr) $ do
et <- peek e_ptr
es <- peekCString (et_errortext et)
c_clear_errorstack devptr
case ErrorCode (et_errornumber et) of
x | x == general -> throw $ General es
| x == noDevice -> throw NoDevice
| x == storageFull -> throw StorageFull
| x == connectionFailed -> throw ConnectionFailed
| x == cancelled -> throw Cancelled
| otherwise -> error $ "checkError: unhandled error number: " ++
show x
getFirstDevice :: IO MTPHandle
getFirstDevice = do
devptr <- c_get_first_device
if devptr == nullPtr
then throw NoDevice
else open devptr
releaseDevice :: MTPHandle -> IO ()
releaseDevice h = withMTPHandle h c_release_device >> close h
resetDevice :: MTPHandle -> IO ()
resetDevice h = withMTPHandle h $ \devptr -> do
r <- c_reset_device devptr
unless (r == 0) (checkError h)
getManufacturerName :: MTPHandle -> IO String
getManufacturerName h = withMTPHandle h $ \devptr ->
peekCString =<< c_get_manufacturername devptr
getModelName :: MTPHandle -> IO String
getModelName h = withMTPHandle h $ \devptr ->
peekCString =<< c_get_modelname devptr
getSerialNumber :: MTPHandle -> IO String
getSerialNumber h = withMTPHandle h $ \devptr ->
peekCString =<< c_get_serialnumber devptr
getFriendlyName :: MTPHandle -> IO String
getFriendlyName h = withMTPHandle h $ \devptr ->
peekCString =<< c_get_friendlyname devptr
getDeviceVersion :: MTPHandle -> IO String
getDeviceVersion h = withMTPHandle h $ \ptr ->
peekCString =<< c_get_deviceversion ptr
getBatteryLevel :: MTPHandle -> IO (Int, Int)
getBatteryLevel h = withMTPHandle h $ \devptr ->
alloca $ \maxptr ->
alloca $ \curptr -> do
ret <- c_get_batterylevel devptr maxptr curptr
unless (ret == 0) (checkError h)
maxv <- peek maxptr
curv <- peek curptr
return (fromIntegral maxv, fromIntegral curv)
getSupportedFileTypes :: MTPHandle -> IO [FileType]
getSupportedFileTypes h = withMTPHandle h $ \devptr ->
alloca $ \ft_ptr ->
alloca $ \len_ptr -> do
r <- c_get_supported_filetypes devptr ft_ptr len_ptr
unless (r == 0) (checkError h)
len <- peek len_ptr
map FileType `fmap` peekArray (fromIntegral len) ft_ptr
withFilePtr :: File -> (Ptr File_t -> IO a) -> IO a
withFilePtr f = bracket alloc free
where
alloc = do
ptr <- malloc :: IO (Ptr File_t)
ft <- marshall
poke ptr ft
return ptr
marshall =
withCAString (fileName f) $ \name_ptr ->
return File_t { ft_item_id = fromIntegral (fileID f)
, ft_parent_id = fromIntegral (fileParentID f)
, ft_storage_id = fromIntegral (fileStorageID f)
, ft_filename = name_ptr
, ft_filesize = fromIntegral (fileSize f)
, ft_filetype = unFileType (fileType f)
, ft_next = nullPtr
}
getFileListing :: MTPHandle -> IO [File]
getFileListing h = withMTPHandle h $ \ptr ->
toList [] =<< c_get_filelisting ptr nullPtr nullPtr
where
toList acc p =
if p == nullPtr
then return acc
else do
ft <- peek p
fn <- convert ft
free p
toList (fn : acc) (ft_next ft)
convert ft = do
n <- peekCString (ft_filename ft)
return File { fileID = fromIntegral (ft_item_id ft)
, fileParentID = fromIntegral (ft_parent_id ft)
, fileStorageID = fromIntegral (ft_storage_id ft)
, fileName = n
, fileSize = fromIntegral (ft_filesize ft)
, fileType = FileType (ft_filetype ft)
}
getFile :: MTPHandle -> Int -> FilePath -> IO ()
getFile h i n =
withMTPHandle h $ \devptr ->
withCAString n $ \str_ptr -> do
r <- c_get_file_to_file devptr (fromIntegral i) str_ptr nullPtr nullPtr
unless (r == 0) (checkError h)
sendFile :: MTPHandle -> FilePath -> IO ()
sendFile h n =
withMTPHandle h $ \devptr ->
withCAString n $ \str_ptr -> do
r <- c_send_file_from_file devptr str_ptr nullPtr nullPtr
unless (r == 0) (checkError h)
hGetFile :: MTPHandle -> Int -> Handle -> IO ()
hGetFile h i fd = withMTPHandle h $ \devptr -> do
oh <- handleToCFile fd "w"
r <- c_get_file_to_file_descriptor devptr (fromIntegral i) oh nullPtr
nullPtr
fflush oh
fclose oh
unless (r == 0) (checkError h)
hSendFile :: MTPHandle -> Handle -> File -> IO ()
hSendFile h fd f = withMTPHandle h $ \devptr ->
withFilePtr f $ \file_ptr -> do
ih <- handleToCFile fd "r"
r <- c_send_file_from_file_descriptor devptr ih file_ptr nullPtr
nullPtr
fclose ih
unless (r == 0) (checkError h)
setFileName :: MTPHandle -> File -> String -> IO ()
setFileName h f n =
withMTPHandle h $ \devptr ->
withFilePtr f $ \file_ptr ->
withCAString n $ \str_ptr -> do
r <- c_set_file_name devptr file_ptr str_ptr
unless (r == 0) (checkError h)
withTrackPtr :: Track -> (Ptr Track_t -> IO a) -> IO a
withTrackPtr t = bracket alloc free
where
alloc = do
ptr <- malloc :: IO (Ptr Track_t)
tt <- marshall
poke ptr tt
return ptr
marshall =
withCAString (trackTitle t) $ \title_ptr ->
withCAString (trackArtist t) $ \artist_ptr ->
withCAString (trackComposer t) $ \composer_ptr ->
withCAString (trackGenre t) $ \genre_ptr ->
withCAString (trackAlbum t) $ \album_ptr ->
withCAString (trackDate t) $ \date_ptr ->
withCAString (trackFileName t) $ \filename_ptr ->
return Track_t
{ tt_item_id = fromIntegral (trackID t)
, tt_parent_id = fromIntegral (trackParentID t)
, tt_storage_id = fromIntegral (trackStorageID t)
, tt_title = title_ptr
, tt_artist = artist_ptr
, tt_composer = composer_ptr
, tt_genre = genre_ptr
, tt_album = album_ptr
, tt_date = date_ptr
, tt_filename = filename_ptr
, tt_tracknumber = fromIntegral (trackNumber t)
, tt_duration = fromIntegral (trackDuration t)
, tt_samplerate = fromIntegral (trackSamplerate t)
, tt_nochannels = fromIntegral (trackChannels t)
, tt_wavecodec = fromIntegral (trackWavecodec t)
, tt_bitrate = fromIntegral (trackBitrate t)
, tt_bitratetype = fromIntegral (trackBitrateType t)
, tt_rating = fromIntegral (trackRating t)
, tt_usecount = fromIntegral (trackUseCount t)
, tt_filesize = fromIntegral (trackFileSize t)
, tt_filetype = unFileType (trackFileType t)
, tt_next = nullPtr
}
peekTrack :: Ptr Track_t -> IO [Track]
peekTrack = go []
where
go acc p =
if p == nullPtr
then return acc
else do
tt <- peek p
tn <- convert tt
free p
go (tn : acc) (tt_next tt)
convert tt = do
ti <- peekCString (tt_title tt)
ar <- peekCString (tt_artist tt)
cm <- peekCString (tt_composer tt)
ge <- peekCString (tt_genre tt)
al <- peekCString (tt_album tt)
dt <- peekCString (tt_date tt)
fn <- peekCString (tt_filename tt)
return $! Track { trackID = fromIntegral (tt_item_id tt)
, trackParentID = fromIntegral (tt_parent_id tt)
, trackStorageID = fromIntegral (tt_storage_id tt)
, trackTitle = ti
, trackArtist = ar
, trackComposer = cm
, trackGenre = ge
, trackAlbum = al
, trackDate = dt
, trackFileName = fn
, trackNumber = fromIntegral (tt_tracknumber tt)
, trackDuration = fromIntegral (tt_duration tt)
, trackSamplerate = fromIntegral (tt_samplerate tt)
, trackChannels = fromIntegral (tt_nochannels tt)
, trackWavecodec = fromIntegral (tt_wavecodec tt)
, trackBitrate = fromIntegral (tt_bitrate tt)
, trackBitrateType = fromIntegral (tt_bitratetype tt)
, trackRating = fromIntegral (tt_rating tt)
, trackUseCount = fromIntegral (tt_usecount tt)
, trackFileSize = fromIntegral (tt_filesize tt)
, trackFileType = FileType (tt_filetype tt)
}
emptyTrack :: Track
emptyTrack =
Track { trackAlbum = ""
, trackArtist = ""
, trackBitrate = 0
, trackBitrateType = 0
, trackComposer = ""
, trackDate = ""
, trackDuration = 0
, trackFileName = ""
, trackFileSize = 0
, trackGenre = ""
, trackFileType = unknown
, trackID = 0
, trackChannels = 0
, trackParentID = 0
, trackRating = 0
, trackSamplerate = 0
, trackStorageID = 0
, trackTitle = ""
, trackNumber = 0
, trackUseCount = 0
, trackWavecodec = 0
}
doesTrackExist :: MTPHandle -> Int -> IO Bool
doesTrackExist h i = withMTPHandle h $ \devptr -> do
exists <- c_track_exists devptr (fromIntegral i)
return $ exists /= 0
getTrackListing :: MTPHandle -> IO [Track]
getTrackListing h = withMTPHandle h $ \ptr ->
peekTrack =<< c_get_tracklisting ptr nullPtr nullPtr
getTrack :: MTPHandle -> Int -> FilePath -> IO ()
getTrack h i n = withMTPHandle h $ \devptr ->
withCAString n $ \strptr -> do
r <- c_get_track_to_file devptr (fromIntegral i) strptr nullPtr nullPtr
unless (r == 0) (checkError h)
sendTrack :: MTPHandle -> FilePath -> Track -> IO ()
sendTrack h n t = withMTPHandle h $ \devptr ->
withCAString n $ \strptr -> withTrackPtr t $ \tt_ptr -> do
r <- c_send_track_from_file devptr strptr tt_ptr nullPtr nullPtr
unless (r == 0) (checkError h)
hGetTrack :: MTPHandle -> Int -> Handle -> IO ()
hGetTrack h i fd = withMTPHandle h $ \devptr -> do
oh <- handleToCFile fd "w"
r <- c_get_track_to_file_descriptor devptr (fromIntegral i) oh nullPtr
nullPtr
fflush oh
fclose oh
unless (r == 0) (checkError h)
hSendTrack :: MTPHandle -> Handle -> Track -> IO ()
hSendTrack h fd t = withMTPHandle h $ \devptr ->
withTrackPtr t $ \track_ptr -> do
ih <- handleToCFile fd "r"
r <- c_send_track_from_file_descriptor devptr ih track_ptr nullPtr
nullPtr
fclose ih
unless (r == 0) (checkError h)
updateTrack :: MTPHandle -> Track -> IO ()
updateTrack h t = withMTPHandle h $ \devptr ->
withTrackPtr t $ \tt_ptr -> do
r <- c_update_track_metadata devptr tt_ptr
unless (r == 0) (checkError h)
getTrackMetadata :: MTPHandle -> Int -> IO (Maybe Track)
getTrackMetadata h i = withMTPHandle h $ \devptr -> do
r <- peekTrack =<< c_get_trackmetadata devptr (fromIntegral i)
return $ listToMaybe r
setTrackName :: MTPHandle -> Track -> String -> IO ()
setTrackName h t n = withMTPHandle h $ \devptr ->
withTrackPtr t $ \track_ptr ->
withCAString n $ \name_ptr -> do
r <- c_set_track_name devptr track_ptr name_ptr
unless (r == 0) (checkError h)
peekFolder :: Ptr Folder_t -> IO [Folder]
peekFolder = go []
where
go acc p =
if p == nullPtr
then return acc
else do
fdt <- peek p
fdn <- convert fdt
free p
go (fdn : acc) (fdt_sibling fdt)
convert fdt = do
name <- peekCString (fdt_name fdt)
child <- if fdt_child fdt == nullPtr
then return Nothing
else peek (fdt_child fdt) >>= convert >>= return . Just
return $! Folder
{ folderID = fromIntegral (fdt_folder_id fdt)
, folderParentID = fromIntegral (fdt_parent_id fdt)
, folderStorageID = fromIntegral (fdt_storage_id fdt)
, folderName = name
, folderChild = child
}
withFolderPtr :: Folder -> (Ptr Folder_t -> IO a) -> IO a
withFolderPtr f = bracket alloc free
where
alloc = do
ptr <- malloc :: IO (Ptr Folder_t)
fdt <- marshall
poke ptr fdt
return ptr
marshall =
withCAString (folderName f) $ \name_ptr ->
return Folder_t
{ fdt_folder_id = fromIntegral (folderID f)
, fdt_parent_id = fromIntegral (folderParentID f)
, fdt_storage_id = fromIntegral (folderStorageID f)
, fdt_name = name_ptr
, fdt_sibling = nullPtr
, fdt_child = nullPtr
}
createFolder :: MTPHandle
-> String
-> Int
-> Int
-> IO Int
createFolder h n pid sid = withMTPHandle h $ \devptr ->
withCAString n $ \name_ptr -> do
r <- c_create_folder devptr name_ptr (fromIntegral pid) (fromIntegral sid)
when (r == 0) (checkError h)
return $ fromIntegral r
getFolderList :: MTPHandle -> IO [Folder]
getFolderList h = withMTPHandle h $ \devptr ->
peekFolder =<< c_folder_list devptr
setFolderName :: MTPHandle -> Folder -> String -> IO ()
setFolderName h f n = withMTPHandle h $ \devptr ->
withFolderPtr f $ \folder_ptr ->
withCAString n $ \name_ptr -> do
r <- c_set_folder_name devptr folder_ptr name_ptr
unless (r == 0) (checkError h)
withPlaylistPtr :: Playlist -> (Ptr Playlist_t -> IO a) -> IO a
withPlaylistPtr pl = bracket alloc free
where
alloc = do
ptr <- malloc :: IO (Ptr Playlist_t)
pt <- marshall
poke ptr pt
return ptr
marshall =
withCAString (playlistName pl) $ \name_ptr ->
withArray (map fromIntegral (playlistTracks pl)) $ \tracks_ptr ->
return Playlist_t
{ pt_playlist_id = fromIntegral (playlistID pl)
, pt_parent_id = fromIntegral (playlistParentID pl)
, pt_storage_id = fromIntegral (playlistStorageID pl)
, pt_name = name_ptr
, pt_tracks = tracks_ptr
, pt_no_tracks = fromIntegral (playlistNoTracks pl)
, pt_next = nullPtr
}
peekPlaylist :: Ptr Playlist_t -> IO [Playlist]
peekPlaylist = go []
where
go acc p =
if p == nullPtr
then return acc
else do
pt <- peek p
pn <- convert pt
free p
go (pn : acc) (pt_next pt)
convert pt = do
name <- peekCString (pt_name pt)
let no_tracks = fromIntegral (pt_no_tracks pt)
tracks <- peekArray no_tracks (pt_tracks pt)
return $! Playlist { playlistID = fromIntegral (pt_playlist_id pt)
, playlistParentID = fromIntegral (pt_parent_id pt)
, playlistStorageID = fromIntegral (pt_storage_id pt)
, playlistName = name
, playlistTracks = map fromIntegral tracks
, playlistNoTracks = no_tracks }
getPlaylistList :: MTPHandle -> IO [Playlist]
getPlaylistList h = withMTPHandle h $ \devptr ->
peekPlaylist =<< c_get_playlist_list devptr
getPlaylist :: MTPHandle -> Int -> IO (Maybe Playlist)
getPlaylist h plid = withMTPHandle h $ \devptr -> do
r <- peekPlaylist =<< c_get_playlist devptr (fromIntegral plid)
return $ listToMaybe r
createPlaylist :: MTPHandle -> Playlist -> IO ()
createPlaylist h pl = withMTPHandle h $ \devptr ->
withPlaylistPtr pl $ \plptr -> do
r <- c_create_new_playlist devptr plptr
unless (r == 0) (checkError h)
updatePlaylist :: MTPHandle -> Playlist -> IO ()
updatePlaylist h pl = withMTPHandle h $ \devptr ->
withPlaylistPtr pl $ \plptr -> do
r <- c_update_playlist devptr plptr
unless (r == 0) (checkError h)
setPlaylistName :: MTPHandle -> Playlist -> String -> IO ()
setPlaylistName h pl name = withMTPHandle h $ \devptr ->
withPlaylistPtr pl $ \plptr ->
withCAString name $ \nameptr -> do
r <- c_set_playlist_name devptr plptr nameptr
unless (r == 0) (checkError h)
deleteObject :: MTPHandle -> Int -> IO ()
deleteObject h i = withMTPHandle h $ \devptr -> do
r <- c_delete_object devptr (fromIntegral i)
unless (r == 0) (checkError h)
setObjectName :: MTPHandle -> Int -> String -> IO ()
setObjectName h i n = withMTPHandle h $ \devptr ->
withCAString n $ \name_ptr -> do
r <- c_set_object_filename devptr (fromIntegral i) name_ptr
unless (r == 0) (checkError h)
findFileType :: FilePath -> FileType
findFileType path =
fromMaybe unknown (lookup (takeExtension path) tbl)
where
tbl = [(".wav", wav), (".mp3", mp3), (".wma", wma), (".ogg", ogg)
,(".aa", audible), (".mp4", mp4), (".wmv", wmv), (".avi", avi)
,(".mpg", mpeg), (".mpeg", mpeg), (".asf", asf), (".qt", qt)
,(".mov", qt), (".jpg", jpeg), (".jpeg", jpeg), (".jfif", jfif)
,(".tif", tiff), (".tiff", tiff), (".bmp", bmp), (".gif", gif)
,(".pict", pict), (".pct", pict), (".pic", pict), (".png", png)
,(".ics", vcalendar2), (".ical", vcalendar2), (".ifb", vcalendar2)
,(".icalendar", vcalendar2), (".vcard", vcard3), (".vcf", vcard3)
,(".wmf", windowsimageformat), (".exe", winexec), (".com", winexec)
,(".bat", winexec), (".dll", winexec), (".sys", winexec), (".txt", text)
,(".html", html), (".bin", firmware), (".aac", aac), (".flac", flac)
,(".mp2", mp2), (".m4a", m4a), (".doc", doc), (".xml", xml), (".xls", xls)
,(".ppt", ppt), (".mht", mht), (".jp2", jp2), (".jpx", jpx)]