diff --git a/Network/XMMS/Client.hs b/Network/XMMS/Client.hs --- a/Network/XMMS/Client.hs +++ b/Network/XMMS/Client.hs @@ -37,7 +37,7 @@ import Foreign import Foreign.Ptr import Foreign.C.Types -import Foreign.C.String +import Network.XMMS.UTF8Strings import Foreign.ForeignPtr import Foreign.Marshal.Alloc import Prelude hiding (init) @@ -86,7 +86,7 @@ getLastError connection = withForeignPtr connection ( \ptrCon -> do c_errorMsg <- xmmsc_get_last_error ptrCon - safePeekCString c_errorMsg) + safePeekUTF8String c_errorMsg) @@ -120,11 +120,13 @@ -- |Get the absolute path to the user config dir. -- -- /The Int parameter is the buffer length and should probably go away... / + + userConfigDirGet :: Int -> IO String userConfigDirGet len = do let c = (castCharToCChar 'c') :: CChar bufPtr <- mallocBytes (len * sizeOf c) xmmsc_userconfdir_get bufPtr (fromIntegral len) - res <- safePeekCString bufPtr + res <- safePeekUTF8String bufPtr free bufPtr return res diff --git a/Network/XMMS/Client/Glib.hs b/Network/XMMS/Client/Glib.hs --- a/Network/XMMS/Client/Glib.hs +++ b/Network/XMMS/Client/Glib.hs @@ -31,7 +31,7 @@ --void xmmsc_mainloop_gmain_init (xmmsc_connection_t *connection) -foreign import ccall "xmmsclient/xmmsclient-glib.h xmmsc_mainloop_gmain_init" +foreign import ccall safe "xmmsclient/xmmsclient-glib.h xmmsc_mainloop_gmain_init" xmmsc_mainloop_gmain_init :: Ptr C_xmmsc_connection -> IO () mainLoopGmainInit :: Connection -> IO () mainLoopGmainInit connection = do diff --git a/Network/XMMS/Config.hs b/Network/XMMS/Config.hs --- a/Network/XMMS/Config.hs +++ b/Network/XMMS/Config.hs @@ -23,7 +23,7 @@ import Foreign import Foreign.Ptr import Foreign.C.Types -import Foreign.C.String +import Network.XMMS.UTF8Strings import Foreign.ForeignPtr import Foreign.Marshal.Alloc diff --git a/Network/XMMS/Constants.hsc b/Network/XMMS/Constants.hsc --- a/Network/XMMS/Constants.hsc +++ b/Network/XMMS/Constants.hsc @@ -21,3 +21,13 @@ #{enum CInt ,, playbackSeekCur = XMMS_PLAYBACK_SEEK_CUR, playbackSeekSet = XMMS_PLAYBACK_SEEK_SET } + +#{enum CInt ,, + playlistChangedAdd = XMMS_PLAYLIST_CHANGED_ADD, + playlistChangedInsert = XMMS_PLAYLIST_CHANGED_INSERT, + playlistChangedRemove = XMMS_PLAYLIST_CHANGED_REMOVE, + playlistChangedClear = XMMS_PLAYLIST_CHANGED_CLEAR, + playlistChangedMove = XMMS_PLAYLIST_CHANGED_MOVE, + playlistChangedSort = XMMS_PLAYLIST_CHANGED_SORT, + playlistChangedShuffle = XMMS_PLAYLIST_CHANGED_SHUFFLE, + playlistChangedUpdate = XMMS_PLAYLIST_CHANGED_UPDATE } diff --git a/Network/XMMS/Medialib.hs b/Network/XMMS/Medialib.hs --- a/Network/XMMS/Medialib.hs +++ b/Network/XMMS/Medialib.hs @@ -19,7 +19,7 @@ import Foreign import Foreign.Ptr import Foreign.C.Types -import Foreign.C.String +import Network.XMMS.UTF8Strings import Foreign.ForeignPtr import Foreign.Marshal.Alloc diff --git a/Network/XMMS/Playback.hs b/Network/XMMS/Playback.hs --- a/Network/XMMS/Playback.hs +++ b/Network/XMMS/Playback.hs @@ -43,7 +43,7 @@ import Foreign import Foreign.Ptr import Foreign.C.Types -import Foreign.C.String +import Network.XMMS.UTF8Strings import Foreign.ForeignPtr import Foreign.Marshal.Alloc diff --git a/Network/XMMS/Playlist.hs b/Network/XMMS/Playlist.hs --- a/Network/XMMS/Playlist.hs +++ b/Network/XMMS/Playlist.hs @@ -14,6 +14,8 @@ module Network.XMMS.Playlist( + retrieveChange, + Change (..), currentPos, currentActive, list, @@ -45,7 +47,7 @@ import Foreign import Foreign.Ptr import Foreign.C.Types -import Foreign.C.String +import Network.XMMS.UTF8Strings import Foreign.ForeignPtr import Foreign.Marshal.Alloc @@ -55,7 +57,41 @@ import Network.XMMS.Result import Network.XMMS.Value +import Data.Map (Map) +import qualified Data.Map as Map + +data Change = Add { position :: Int, name :: String, id :: Int } + | Insert { position :: Int, name :: String, id :: Int } + | Remove { position :: Int, name :: String} + | Clear { name :: String } + | Move { position :: Int, newPosition :: Int, name :: String, id :: Int } + | Sort { name :: String } + | Shuffle { name :: String } + | Update { name :: String } + | NoChange + +retrieveChange :: XMMSCV -> Change +retrieveChange (XMMSDict dict) + |changeType == playlistChangedAdd = Add position name id + |changeType == playlistChangedInsert = Insert position name id + |changeType == playlistChangedRemove = Remove position name + |changeType == playlistChangedClear = Clear name + |changeType == playlistChangedMove = Move position newPosition name id + |changeType == playlistChangedSort = Sort name + |changeType == playlistChangedShuffle = Shuffle name + |changeType == playlistChangedUpdate = Update name + |otherwise = NoChange + where convFromJust (Just x) = x + convFromJust _ = error $ "Failed on getting playlist change from dict: " ++ (show dict) + + name = xmmsString $ convFromJust $ Map.lookup "name" dict + position = xmmsInt $ convFromJust $ Map.lookup "position" dict + newPosition = xmmsInt $ convFromJust $ Map.lookup "newposition" dict + id = xmmsInt $ convFromJust $ Map.lookup "id" dict + changeType = fromIntegral $ xmmsInt $ convFromJust $ Map.lookup "type" dict + + --xmmsc_result_t * xmmsc_playlist_current_pos (xmmsc_connection_t *c, const char *playlist) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsc_playlist_current_pos" xmmsc_playlist_current_pos :: Ptr C_xmmsc_connection -> CString -> IO (Ptr C_xmmsc_result) @@ -308,7 +344,7 @@ --xmmsc_result_t *xmmsc_broadcast_playlist_changed (xmmsc_connection_t *c) -foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsc_broadcast_playlist_changed" +foreign import ccall safe "xmmsclient/xmmsclient.h xmmsc_broadcast_playlist_changed" xmmsc_broadcast_playlist_changed :: Ptr C_xmmsc_connection -> IO (Ptr C_xmmsc_result) -- |Request the playlist changed broadcast from the server. broadcastChanged :: Connection -> IO Result diff --git a/Network/XMMS/Result.hs b/Network/XMMS/Result.hs --- a/Network/XMMS/Result.hs +++ b/Network/XMMS/Result.hs @@ -17,7 +17,7 @@ import Foreign import Foreign.Ptr import Foreign.C.Types -import Foreign.C.String +import Network.XMMS.UTF8Strings import Foreign.ForeignPtr import Foreign.Marshal.Alloc @@ -79,7 +79,7 @@ --void xmmsc_result_wait (xmmsc_result_t *res) -foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsc_result_wait" +foreign import ccall safe "xmmsclient/xmmsclient.h xmmsc_result_wait" xmmsc_result_wait :: Ptr C_xmmsc_result -> IO () -- |Block for the reply. resultWait :: Result -> IO () diff --git a/Network/XMMS/UTF8Strings.hs b/Network/XMMS/UTF8Strings.hs new file mode 100644 --- /dev/null +++ b/Network/XMMS/UTF8Strings.hs @@ -0,0 +1,79 @@ +{-# OPTIONS #-} + +module Network.XMMS.UTF8Strings ( + withUTF8String, + withUTF8StringLen, + newUTF8String, + newUTF8StringLen, + peekUTF8String, + peekUTF8StringLen, + newCString, + newCStringLen, + castCharToCChar, + CString () ) +where + +import Data.Bits +import Foreign.C.String +import Foreign.C.Types +import Data.Char +import Foreign +import Foreign.C.String + +----------------- +-- UTF8 versions +----------------- + + +withUTF8String :: String -> (CString -> IO a) -> IO a +withUTF8String hsStr = withCString (toUTF hsStr) + +withUTF8StringLen :: String -> (CStringLen -> IO a) -> IO a +withUTF8StringLen hsStr = withCStringLen (toUTF hsStr) + +newUTF8String :: String -> IO CString +newUTF8String = newCString . toUTF + +newUTF8StringLen :: String -> IO CStringLen +newUTF8StringLen = newCStringLen . toUTF + +peekUTF8String :: CString -> IO String +peekUTF8String strPtr = fmap fromUTF $ peekCString strPtr + +peekUTF8StringLen :: CStringLen -> IO String +peekUTF8StringLen strPtr = fmap fromUTF $ peekCStringLen strPtr + + +-- these should read and write directly from/to memory. +-- A first pass will be needed to determine the size of the allocated region + +toUTF :: String -> String +toUTF [] = [] +toUTF (x:xs) | ord x<=0x007F = x:toUTF xs + | ord x<=0x07FF = chr (0xC0 .|. ((ord x `shift` (-6)) .&. 0x1F)): + chr (0x80 .|. (ord x .&. 0x3F)): + toUTF xs + | otherwise = chr (0xE0 .|. ((ord x `shift` (-12)) .&. 0x0F)): + chr (0x80 .|. ((ord x `shift` (-6)) .&. 0x3F)): + chr (0x80 .|. (ord x .&. 0x3F)): + toUTF xs + +fromUTF :: String -> String +fromUTF [] = [] +fromUTF (all@(x:xs)) | ord x<=0x7F = x:fromUTF xs + | ord x<=0xBF = err + | ord x<=0xDF = twoBytes all + | ord x<=0xEF = threeBytes all + | otherwise = err + where + twoBytes (x1:x2:xs) = chr (((ord x1 .&. 0x1F) `shift` 6) .|. + (ord x2 .&. 0x3F)):fromUTF xs + twoBytes _ = error "fromUTF: illegal two byte sequence" + + threeBytes (x1:x2:x3:xs) = chr (((ord x1 .&. 0x0F) `shift` 12) .|. + ((ord x2 .&. 0x3F) `shift` 6) .|. + (ord x3 .&. 0x3F)):fromUTF xs + threeBytes _ = error "fromUTF: illegal three byte sequence" + + err = error "fromUTF: illegal UTF-8 character" + diff --git a/Network/XMMS/Utilities.hs b/Network/XMMS/Utilities.hs --- a/Network/XMMS/Utilities.hs +++ b/Network/XMMS/Utilities.hs @@ -17,19 +17,20 @@ import Foreign import Foreign.Ptr import Foreign.C.Types -import Foreign.C.String import Foreign.ForeignPtr import Foreign.Marshal.Alloc +import Network.XMMS.UTF8Strings import Network.XMMS.Constants import Network.XMMS.Types ------------------ --Help Functions -safePeekCString cstring = if cstring == nullPtr + +safePeekUTF8String cstring = if cstring == nullPtr then return "" - else peekCString cstring + else peekUTF8String cstring withString :: String -> (CString -> IO (a)) -> IO (a) withString s action |s == "" = action nullPtr diff --git a/Network/XMMS/Value.hs b/Network/XMMS/Value.hs --- a/Network/XMMS/Value.hs +++ b/Network/XMMS/Value.hs @@ -17,7 +17,7 @@ import Foreign import Foreign.Ptr import Foreign.C.Types -import Foreign.C.String +import Network.XMMS.UTF8Strings import Foreign.ForeignPtr import Foreign.Marshal.Alloc import Data.Map (Map) @@ -138,7 +138,7 @@ then return Map.empty else do rest <- marshallDict (plusPtr keys (sizeOf key)) (plusPtr values (sizeOf value)) - keyString <- safePeekCString key + keyString <- safePeekUTF8String key valueHS <- convertValueCtoHs value return $ Map.insert keyString valueHS rest @@ -195,7 +195,7 @@ else do buf <- peek bufPtr free bufPtr - safePeekCString buf + safePeekUTF8String buf --int xmmsv_get_int (xmmsv_t *return_value, int *v) foreign import ccall unsafe "xmmsclient/xmmsclient.h xmmsv_get_int" @@ -219,7 +219,7 @@ if res==0 then return Nothing else do buf <- peek bufPtr - res <- safePeekCString buf + res <- safePeekUTF8String buf free bufPtr return $ Just res diff --git a/XMMS.cabal b/XMMS.cabal --- a/XMMS.cabal +++ b/XMMS.cabal @@ -1,5 +1,5 @@ Name: XMMS -Version: 0.1 +Version: 0.1.1 Description: Provides the haskell client lib for XMMS2 Synopsis: XMMS2 client library. License: LGPL @@ -9,7 +9,7 @@ Build-Type: Simple Cabal-Version: >=1.2 Category: Network, Sound - +Homepage: http://kawais.org.ua/XMMS/ Build-depends: base >= 1.0 && < 5, containers @@ -25,7 +25,7 @@ Other-modules: Network.XMMS.Constants, Network.XMMS.Result, Network.XMMS.Value, Network.XMMS.Types, - Network.XMMS.Utilities + Network.XMMS.Utilities, Network.XMMS.UTF8Strings C-sources: cbits/XMMSUtils.c @@ -38,6 +38,7 @@ Network/XMMS/Value.hs, Network/XMMS/Types.hs, Network/XMMS/Constants.hsc, + Network/XMMS/UTF8Strings.hs, cbits/XMMSUtils.c, cbits/XMMSUtils.h Data-files: diff --git a/example/tut3.hs b/example/tut3.hs --- a/example/tut3.hs +++ b/example/tut3.hs @@ -15,18 +15,25 @@ errorMsg <- getLastError connection putStrLn $ "Connection failed: " ++ errorMsg else do + print "1" result <- currentID connection + print "2" resultWait result + print "3" returnValue <- resultGetValue result + print "4" case returnValue of XMMSError msg -> putStrLn $ "playback start returned error: " ++ msg XMMSInt id -> do putStrLn $ "playing track with ID:" ++ show id result <- medialibGetInfo connection id + print "5" resultWait result + print "6" returnValue <- resultGetValue result + print "7" case returnValue of - XMMSDict dict -> mapM_ (\(key, value) -> putStrLn (key ++ " : " ++ show value)) (assocs $ propdictToDict dict) + XMMSDict dict -> mapM_ (\(key, value) -> print (key ++ " : " ++ show value)) (assocs $ propdictToDict dict) _ -> error "not a dictionary" return ()