XMMS 0.1 → 0.1.1

raw patch · 13 files changed

+158/−22 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Network/XMMS/Client.hs +5/−3
• Network/XMMS/Client/Glib.hs +1/−1
• Network/XMMS/Config.hs +1/−1
• Network/XMMS/Constants.hsc +10/−0
• Network/XMMS/Medialib.hs +1/−1
• Network/XMMS/Playback.hs +1/−1
• Network/XMMS/Playlist.hs +38/−2
• Network/XMMS/Result.hs +2/−2
• Network/XMMS/UTF8Strings.hs +79/−0
• Network/XMMS/Utilities.hs +4/−3
• Network/XMMS/Value.hs +4/−4
• XMMS.cabal +4/−3
• example/tut3.hs +8/−1

@@ -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

@@ -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

@@ -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 

@@ -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 }

@@ -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 

@@ -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 

@@ -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

@@ -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 ()

@@ -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"+

@@ -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

@@ -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 

@@ -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:

@@ -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 ()