libmpd 0.5.0 → 0.6.0

raw patch · 16 files changed

+569/−479 lines, 16 filesdep ~basedep ~containersdep ~filepathPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, containers, filepath, mtl, network, old-locale, time

API changes (from Hackage documentation)

Files

• ChangeLog +0/−63
• NEWS +71/−0
• Network/MPD/Commands.hs +43/−30
• Network/MPD/Commands/Extensions.hs +2/−5
• Network/MPD/Commands/Parse.hs +136/−242
• Network/MPD/Commands/Types.hs +40/−26
• Network/MPD/Commands/Util.hs +33/−8
• Network/MPD/Core.hs +23/−29
• Network/MPD/Core/Class.hs +2/−4
• Network/MPD/Utils.hs +1/−1
• README.md +107/−26
• libmpd.cabal +17/−22
• tests/Commands.hs +77/−2
• tests/Displayable.hs +15/−19
• tests/Main.hs +1/−1
• tests/Properties.hs +1/−1

@@ -1,63 +0,0 @@-* v0.5.0, 2010-09-08-	- Moved extensions to Network.MPD.Commands.Extensions-	These might be removed in a later version-	- Non-blocking `idle'-	- The API is closer to the MPD spec, by untangling functionality-	- Better MPD API coverage-	- Improved parser implementation, now runs in constant space-	- Constructors of the `Subsystem' type have been renamed-	- Passwords can be changed using `setPassword'-	- The connection handle can be accessed via `getHandle'-	- The version of the MPD server is available via `getVersion'-	- Added support for connecting via unix sockets--* v0.4.1, 2010-08-31-	- Only depend on QuickCheck when building the test target--* v0.4.1, 2010-03-26-	- Fix building test and coverage targets--* v0.4.0, 2010-03-26-	- New maintainer: Joachim Fasting <joachim.fasting@gmail.com>-	- Support QuickCheck 2-	- Better MPD api support-	Should be mostly compatible with mpd 0.16-	- Separated operations on current playlist from those on specific-	playlists-	- Fixed password sending-	- Several minor fixes and cleanups--* v0.3.1, 2008-09-14-	- Now reconnects if MPD closes the connection.--* v0.3.0, 2008-05-06-	- UTF-8 support (now depends on utf8-string package).-	- Fixed corruption by `show' of command parameters.-	- Tidied up `Query' interface.-	- Moved StringConn out of Network.MPD to the tests directory.--* v0.2.1, 2008-04-14-	- Cleaned up libmpd.cabal.--* v0.2.0, 2008-04-14-	- A connection stub for testing purposes.-	- QuickCheck tests for parsing.-	- Partial unit test coverage.-	- Many bug fixes.-	- Precise error handling.-	- Parsing improvements.-	- Code coverage generation.-	- Cabal 1.2 support.-	- Uniform command names.--* v0.1.3, 2007-10-02-	- Bugfixes.--* v0.1.2, 2007-09-29-	- Changed name to libmpd.--* v0.1.1, 2007-09-28-	- Missing files added to the source distribution.--* v0.1, 2007-09-28-	- Initial public release.

@@ -0,0 +1,71 @@+* v0.6.0, 2011-03-31+  - Reverted some changes from 0.5.0 that caused problems,+    most notably the parser improvements have been removed for now.+  - Support for GHC 7+  - Removed support for building against the deprecated base 3 package+  - Added an `Enum' instance for `Metadata'+  - Removed the `old_base' flag++* v0.5.0, 2010-09-08+	- Moved extensions to Network.MPD.Commands.Extensions+	These might be removed in a later version+	- Non-blocking `idle'+	- The API is closer to the MPD spec, by untangling functionality+	- Better MPD API coverage+	- Improved parser implementation, now runs in constant space+	- Constructors of the `Subsystem' type have been renamed+	- Passwords can be changed using `setPassword'+	- The connection handle can be accessed via `getHandle'+	- The version of the MPD server is available via `getVersion'+	- Added support for connecting via unix sockets++* v0.4.1, 2010-08-31+	- Only depend on QuickCheck when building the test target++* v0.4.1, 2010-03-26+	- Fix building test and coverage targets++* v0.4.0, 2010-03-26+	- New maintainer: Joachim Fasting <joachim.fasting@gmail.com>+	- Support QuickCheck 2+	- Better MPD api support+	Should be mostly compatible with mpd 0.16+	- Separated operations on current playlist from those on specific+	playlists+	- Fixed password sending+	- Several minor fixes and cleanups++* v0.3.1, 2008-09-14+	- Now reconnects if MPD closes the connection.++* v0.3.0, 2008-05-06+	- UTF-8 support (now depends on utf8-string package).+	- Fixed corruption by `show' of command parameters.+	- Tidied up `Query' interface.+	- Moved StringConn out of Network.MPD to the tests directory.++* v0.2.1, 2008-04-14+	- Cleaned up libmpd.cabal.++* v0.2.0, 2008-04-14+	- A connection stub for testing purposes.+	- QuickCheck tests for parsing.+	- Partial unit test coverage.+	- Many bug fixes.+	- Precise error handling.+	- Parsing improvements.+	- Code coverage generation.+	- Cabal 1.2 support.+	- Uniform command names.++* v0.1.3, 2007-10-02+	- Bugfixes.++* v0.1.2, 2007-09-29+	- Changed name to libmpd.++* v0.1.1, 2007-09-28+	- Missing files added to the source distribution.++* v0.1, 2007-09-28+	- Initial public release.

@@ -16,7 +16,7 @@     module Network.MPD.Commands.Query,      -- * Querying MPD's status-    clearError, currentSong, idle, getIdle, noidle, status, stats,+    clearError, currentSong, idle, noidle, status, stats,      -- * Playback options     consume, crossfade, random, repeat, setVolume, single, replayGainMode,@@ -26,9 +26,9 @@     next, pause, play, playId, previous, seek, seekId, stop,      -- * The current playlist-    add, add_, addId, clear, delete, deleteId, move, moveId, playlist,-    playlistId, playlistFind, playlistInfo, playlistSearch, plChanges,-    plChangesPosId, shuffle, swap, swapId,+    add, add_, addId, clear, delete, deleteId, move, moveId, playlist, playlistId,+    playlistFind, playlistInfo, playlistSearch, plChanges, plChangesPosId, shuffle, swap,+    swapId,      -- * Stored playlist     listPlaylist, listPlaylistInfo, listPlaylists, load, playlistAdd,@@ -63,7 +63,6 @@ import Control.Monad (liftM) import Control.Monad.Error (throwError) import Prelude hiding (repeat)-import Data.Maybe  -- -- Querying MPD's status@@ -73,22 +72,30 @@ clearError :: MonadMPD m => m () clearError = getResponse_ "clearerror" --- | Get the current song.-currentSong :: MonadMPD m => m (Maybe Song)-currentSong = getResponse "currentsong" >>= takeSongs >>= return . listToMaybe---- | Make MPD server notify the client if there is a noteworthy change---   in one or more of its subsystems. Note that after running this command---   you can either monitor handle for incoming notifications or cancel this---   by 'noidle'. Any command other than 'noidle' sent to MPD server while---   idle is active will be ignored.-idle :: MonadMPD m => [Subsystem] -> m ()-idle ss = send ("idle" <$> foldr (<++>) (Args []) ss)+-- | Get the currently playing song.+currentSong :: (Functor m, MonadMPD m) => m (Maybe Song)+currentSong = do+    cs <- status+    if stState cs == Stopped+       then return Nothing+       else getResponse1 "currentsong" >>=+            fmap Just . runParser parseSong . toAssocList --- | Get idle notifications. If there is no notifications ready---   at the moment, this function will block until they show up.-getIdle :: MonadMPD m => m [Subsystem]-getIdle = getResponse "" >>= return . parseIdle . toAssocList+-- | Wait until there is a noteworthy change in one or more of MPD's+-- susbystems. Note that running this command will block until either 'idle'+-- returns or is cancelled by 'noidle'.+idle :: MonadMPD m => m [Subsystem]+idle =+    mapM (\("changed", system) -> case system of "database" -> return DatabaseS+                                                 "update"   -> return UpdateS+                                                 "stored_playlist" -> return StoredPlaylistS+                                                 "playlist" -> return PlaylistS+                                                 "player" -> return PlayerS+                                                 "mixer" -> return MixerS+                                                 "output" -> return OutputS+                                                 "options" -> return OptionsS+                                                 k -> fail ("Unknown subsystem: " ++ k))+         =<< toAssocList `liftM` getResponse "idle"  -- | Cancel 'idle'. noidle :: MonadMPD m => m ()@@ -96,11 +103,11 @@  -- | Get server statistics. stats :: MonadMPD m => m Stats-stats = getResponse "stats" >>= return . parseStats . toAssocList+stats = getResponse "stats" >>= runParser parseStats  -- | Get the server's status. status :: MonadMPD m => m Status-status = getResponse "status" >>= return . parseStatus . toAssocList+status = getResponse "status" >>= runParser parseStatus  -- -- Playback options@@ -345,7 +352,7 @@  -- | Count the number of entries matching a query. count :: MonadMPD m => Query -> m Count-count query = getResponse ("count" <$>  query) >>= return . parseCount . toAssocList+count query = getResponse ("count" <$>  query) >>= runParser parseCount  -- | Search the database for entries exactly matching a query. find :: MonadMPD m => Query -> m [Song]@@ -366,17 +373,23 @@ listAll path = liftM (map snd . filter ((== "file") . fst) . toAssocList)                      (getResponse $ "listall" <$> path) +-- Helper for lsInfo and listAllInfo.+lsInfo' :: MonadMPD m => String -> Path -> m [Either Path Song]+lsInfo' cmd path =+    liftM (extractEntries (Just . Right, const Nothing, Just . Left)) $+         takeEntries =<< getResponse (cmd <$> path)+ -- | Recursive 'lsInfo'.-listAllInfo :: MonadMPD m => Path -> m [Song]-listAllInfo path = takeSongs =<< getResponse ("listallinfo" <$> path)+listAllInfo :: MonadMPD m => Path -> m [Either Path Song]+listAllInfo = lsInfo' "listallinfo"  -- | Non-recursively list the contents of a database directory.-lsInfo :: MonadMPD m => Path -> m [Entry]-lsInfo path = takeEntries =<< getResponse ("lsinfo" <$> path)+lsInfo :: MonadMPD m => Path -> m [Either Path Song]+lsInfo = lsInfo' "lsinfo"  -- | Search the database using case insensitive matching. search :: MonadMPD m => Query -> m [Song]-search query = takeSongs =<< getResponse ("search" <$> query)+search query = getResponse ("search" <$> query) >>= takeSongs  -- | Update the server's database. -- If no paths are given, all paths will be scanned.@@ -465,8 +478,8 @@ enableOutput = getResponse_ . ("enableoutput" <$>)  -- | Retrieve information for all output devices.-outputs :: MonadMPD m => m [Output]-outputs = getResponse "outputs" >>= return . parseOutputs . toAssocList+outputs :: MonadMPD m => m [Device]+outputs = getResponse "outputs" >>= runParser parseOutputs  -- -- Reflection

@@ -8,15 +8,12 @@  module Network.MPD.Commands.Extensions where +import Network.MPD.Core+import Network.MPD.Commands import Network.MPD.Commands.Arg-import Network.MPD.Commands.Query-import Network.MPD.Commands.Types import Network.MPD.Commands.Util-import Network.MPD.Commands-import Network.MPD.Core  import Control.Monad (liftM)-import Prelude hiding (repeat)  -- | Like 'update', but returns the update job id. updateId :: MonadMPD m => [Path] -> m Integer

@@ -8,266 +8,160 @@ -- -- Parsers for MPD data types. -module Network.MPD.Commands.Parse (-    -- * Parsers for many objects-    parseSongs, parseEntries, parseOutputs,-    -- * Parsers for one object-    parseCount, parseStats, parseStatus,-    -- * Other parsers-    parseIdle,-    -- * Misc utilities-    parse, pair-    ) where+module Network.MPD.Commands.Parse where  import Network.MPD.Commands.Types -import qualified Data.Map as M+import Control.Arrow ((***))+import Control.Monad.Error import Data.Maybe (fromMaybe)-import Control.Arrow (first, (***))-import Network.MPD.Utils -type ItemGen a = [(String, String)] -- ^ list of (key,value) pairs-               -> a                 -- ^ intermediate object-               -> (a, Int)          -- ^ result object along with information-                                    --   about amount of lines it consumed---- | Generate Output object.-parseOutput :: ItemGen Output-parseOutput ls d = f ls d 0-    where f []                d' n = (d', n)-          f ((key, value):ls') d' n =-              case key of-                   "outputname"    -> f ls' d' { outName = value }      (succ n)-                   "outputenabled" -> f ls' (up outenabled' parseBool) (succ n)-                   "outputid"      -> (d', n) -- new output, we're done here-                   _               -> f ls' d' (succ n) -- ignore unknown keys--              where up g parser = maybe d g $ parser value-                    outenabled' v = d' { outEnabled = v }---- | Generate Entry object-parseEntry :: ItemGen Entry-parseEntry ls (SongE s) = first SongE $ parseSong ls s-parseEntry _  d@(DirectoryE _) = (d, 0)-parseEntry ls (PlaylistE p) = first PlaylistE $ parsePlaylist ls p 0-    where parsePlaylist [] s n = (s, n)-          parsePlaylist ((key, value):ls') p' n =-              case key of-                   "Last-Modified" -> parsePlaylist ls' p'-                                        { plLastModified = parseIso8601 value }-                                        (succ n)-                   "playlist"      -> (p', n) -- new playlist, we're done here-                   _               -> parsePlaylist ls' p' (succ n) -- ignore unknown keys---- | Generate Song object-parseSong :: ItemGen Song-parseSong ls s = f ls s 0-    where f []                s' n = (s', n)-          f ((key, value):ls') s' n =-              case key of-                   "Last-Modified" -> f ls' s' { sgLastModified = lm   } (succ n)-                   "Time"          -> f ls' s' { sgLength       = time } (succ n)-                   "Id"            -> f ls' s' { sgIndex        = id'  } (succ n)-                   "Pos"           -> f ls' s' { sgIndex        = pos  } (succ n)-                   "file"          -> (s', n) -- new item, we're done here-                   "playlist"      -> (s', n) -- new item, we're done here-                   -- "directory" is not needed, files are always after dirs-                   _ -> case tagValue key of-                            Just meta -> f ls' s'-                                           { sgTags = M.insertWith' (++)-                                                 meta [value] (sgTags s')-                                           } (succ n)-                            Nothing   -> f ls' s' (succ n) -- ignore unknown keys--              where lm     = parseIso8601 value-                    time   = maybe 0 id $ parseNum value-                    id'    = Just (maybe 0 fst $ sgIndex s', maybe 0 id $ parseNum value)-                    pos    = Just (maybe 0 id $ parseNum value, maybe 0 snd $ sgIndex s')--                    -- Why not just derive instance of Read? Because-                    -- using read is a few times slower than this.-                    tagValue "Artist" = Just Artist-                    tagValue "ArtistSort" = Just ArtistSort-                    tagValue "Album" = Just Album-                    tagValue "AlbumArtist" = Just AlbumArtist-                    tagValue "AlbumArtistSort" = Just AlbumArtistSort-                    tagValue "Title" = Just Title-                    tagValue "Track" = Just Track-                    tagValue "Name" = Just Name-                    tagValue "Genre" = Just Genre-                    tagValue "Date" = Just Date-                    tagValue "Composer" = Just Composer-                    tagValue "Performer" = Just Performer-                    tagValue "Disc" = Just Disc-                    tagValue "MUSICBRAINZ_ARTISTID" = Just MUSICBRAINZ_ARTISTID-                    tagValue "MUSICBRAINZ_ALBUMID" = Just MUSICBRAINZ_ALBUMID-                    tagValue "MUSICBRAINZ_ALBUMARTISTID" = Just MUSICBRAINZ_ALBUMARTISTID-                    tagValue "MUSICBRAINZ_TRACKID" = Just MUSICBRAINZ_TRACKID-                    tagValue _ = Nothing------------------------------------------------------------------------- | Parser generator.-genParser :: [(String, String -> a)] -> ItemGen a -> [(String, String)] -> [a]-genParser _    _      []                = []-genParser ptrs parser ((key, value):ls) =-    case key `lookup` ptrs of-        Just ctr -> let (item, n) = parser ls (ctr value) in-                        item : genParser ptrs parser (drop n ls)-        Nothing  ->            genParser ptrs parser ls---- | Parser for songs.-parseSongs :: [(String, String)] -> [Song]-parseSongs = genParser [ ("file", initSong)-                       ] parseSong--initSong :: String -> Song-initSong filepath =-    Song { sgFilePath = filepath, sgTags = M.empty-         , sgLastModified = Nothing, sgLength = 0-         , sgIndex = Nothing }---- | Parser for database entries.-parseEntries :: [(String, String)] -> [Entry]-parseEntries = genParser [ ("directory", DirectoryE)-                         , ("file", SongE . initSong)-                         , ("playlist", PlaylistE . initPlaylist)-                         ] parseEntry--initPlaylist :: String -> Playlist-initPlaylist name =-    Playlist { plName = name, plLastModified = Nothing }---- | Parser for outputs.-parseOutputs :: [(String, String)] -> [Output]-parseOutputs = genParser [ ("outputid", initOutput . fromMaybe (-1) . parseNum )-                         ] parseOutput--initOutput :: Int -> Output-initOutput id' =-    Output { outID = id', outName = "", outEnabled = False }--------------------------------------------------------------------+import Network.MPD.Utils+import Network.MPD.Core (MonadMPD, MPDError(Unexpected))  -- | Builds a 'Count' instance from an assoc. list.-parseCount :: [(String, String)] -> Count-parseCount = flip parseCount' defaultCount---- | Helper function.-parseCount' :: [(String, String)] -> Count -> Count-parseCount' []                c = c-parseCount' ((key, value):ls) c =-    case key of-        "songs"    -> modify parseNum $ \v -> c { cSongs = v }-        "playtime" -> modify parseNum $ \v -> c { cPlaytime = v }-        _          -> parseCount' ls c--    where modify p f = parseCount' ls $ parse p f c value--defaultCount =-    Count { cSongs = 0, cPlaytime = 0 }+parseCount :: [String] -> Either String Count+parseCount = foldM f defaultCount . toAssocList+        where f :: Count -> (String, String) -> Either String Count+              f a ("songs", x)    = return $ parse parseNum+                                    (\x' -> a { cSongs = x'}) a x+              f a ("playtime", x) = return $ parse parseNum+                                    (\x' -> a { cPlaytime = x' }) a x+              f _ x               = Left $ show x --------------------------------------------------------------------+-- | Builds a list of 'Device' instances from an assoc. list+parseOutputs :: [String] -> Either String [Device]+parseOutputs = mapM (foldM f defaultDevice)+             . splitGroups [("outputid",id)]+             . toAssocList+    where f a ("outputid", x)      = return $ parse parseNum+                                     (\x' -> a { dOutputID = x' }) a x+          f a ("outputname", x)    = return a { dOutputName = x }+          f a ("outputenabled", x) = return $ parse parseBool+                                     (\x' -> a { dOutputEnabled = x'}) a x+          f _ x                    = fail $ show x  -- | Builds a 'Stats' instance from an assoc. list.-parseStats :: [(String, String)] -> Stats-parseStats = flip parseStats' defaultStats---- | Helper function.-parseStats' :: [(String, String)] -> Stats -> Stats-parseStats' []                s = s-parseStats' ((key, value):ls) s =-    case key of-        "artists"     -> modify parseNum $ \v -> s { stsArtists = v }-        "albums"      -> modify parseNum $ \v -> s { stsAlbums = v }-        "songs"       -> modify parseNum $ \v -> s { stsSongs = v }-        "uptime"      -> modify parseNum $ \v -> s { stsUptime = v }-        "playtime"    -> modify parseNum $ \v -> s { stsPlaytime = v }-        "db_playtime" -> modify parseNum $ \v -> s { stsDbPlaytime = v }-        "db_update"   -> modify parseNum $ \v -> s { stsDbUpdate = v }-        _             -> parseStats' ls s--    where modify p f = parseStats' ls $ parse p f s value+parseStats :: [String] -> Either String Stats+parseStats = foldM f defaultStats . toAssocList+    where+        f a ("artists", x)     = return $ parse parseNum+                                 (\x' -> a { stsArtists  = x' }) a x+        f a ("albums", x)      = return $ parse parseNum+                                 (\x' -> a { stsAlbums   = x' }) a x+        f a ("songs", x)       = return $ parse parseNum+                                 (\x' -> a { stsSongs    = x' }) a x+        f a ("uptime", x)      = return $ parse parseNum+                                 (\x' -> a { stsUptime   = x' }) a x+        f a ("playtime", x)    = return $ parse parseNum+                                 (\x' -> a { stsPlaytime = x' }) a x+        f a ("db_playtime", x) = return $ parse parseNum+                                 (\x' -> a { stsDbPlaytime = x' }) a x+        f a ("db_update", x)   = return $ parse parseNum+                                 (\x' -> a { stsDbUpdate = x' }) a x+        f _ x = fail $ show x -defaultStats =-     Stats { stsArtists = 0, stsAlbums = 0, stsSongs = 0, stsUptime = 0-           , stsPlaytime = 0, stsDbPlaytime = 0, stsDbUpdate = 0 }+-- | Builds a 'Song' instance from an assoc. list.+parseSong :: [(String, String)] -> Either String Song+parseSong xs = foldM f defaultSong xs+    where+        f :: Song -> (String, String) -> Either String Song+        f s ("Last-Modified", v) =+            return s { sgLastModified = parseIso8601 v }+        f s ("Time", v) =+            return s { sgLength = fromMaybe 0 $ parseNum v }+        -- We prefer Id...+        f s ("Id", v) =+            return $ parse parseNum (\v' -> s { sgIndex = Just v' }) s v+        -- .. but will make due with Pos+        f s ("Pos", v) =+            maybe (return $ parse parseNum+                                  (\v' -> s { sgIndex = Just v' }) s v)+                  (const $ return s)+                  (sgIndex s)+        f s ("file", v) =+            return s { sgFilePath = v }+        f s (k, v) = return . maybe s (\m -> sgAddTag m v s) $+                     readMeta k --------------------------------------------------------------------+        -- Custom-made Read instance+        readMeta "Artist" = Just Artist+        readMeta "Album" = Just Album+        readMeta "Title" = Just Title+        readMeta "Genre" = Just Genre+        readMeta "Name" = Just Name+        readMeta "Composer" = Just Composer+        readMeta "Performer" = Just Performer+        readMeta "Date" = Just Date+        readMeta "Track" = Just Track+        readMeta "Disc" = Just Disc+        readMeta "MUSICBRAINZ_ARTISTID" = Just MUSICBRAINZ_ARTISTID+        readMeta "MUSICBRAINZ_TRACKID" = Just MUSICBRAINZ_TRACKID+        readMeta _ = Nothing  -- | Builds a 'Status' instance from an assoc. list.-parseStatus :: [(String, String)] -> Status-parseStatus = flip parseStatus' defaultStatus---- | Helper function.-parseStatus' :: [(String, String)] -> Status -> Status-parseStatus' []                s = s-parseStatus' ((key, value):ls) s =-    case key of-       "volume"         -> modify parseNum   $ \v -> s { stVolume = v }-       "repeat"         -> modify parseBool  $ \v -> s { stRepeat = v }-       "random"         -> modify parseBool  $ \v -> s { stRandom = v }-       "single"         -> modify parseBool  $ \v -> s { stSingle = v }-       "consume"        -> modify parseBool  $ \v -> s { stConsume = v }-       "playlist"       -> modify parseNum   $ \v -> s { stPlaylistID = v }-       "playlistlength" -> modify parseNum   $ \v -> s { stPlaylistLength = v }-       "xfade"          -> modify parseNum   $ \v -> s { stXFadeWidth = v }-       "mixrampdb"      -> modify parseFrac  $ \v -> s { stMixRampdB = v }-       "mixrampdelay"   -> modify parseFrac  $ \v -> s { stMixRampDelay = v }-       "state"          -> modify parseState $ \v -> s { stState = v }-       "song"           -> parseStatus' ls s { stSongPos = parseNum value }-       "songid"         -> parseStatus' ls s { stSongID = parseNum value }-       "time"           -> modify parseTime  $ \v -> s { stTime = v }-       "elapsed"        -> modify parseFrac  $ \v -> s { stTime = (v, snd $ stTime s) }-       "bitrate"        -> modify parseNum   $ \v -> s { stBitrate = v }-       "audio"          -> modify parseAudio $ \v -> s { stAudio = v }-       "nextsong"       -> parseStatus' ls s { stNextSongPos = parseNum value }-       "nextsongid"     -> parseStatus' ls s { stNextSongID = parseNum value }-       "error"          -> parseStatus' ls s { stError = Just value }-       _                -> parseStatus' ls s--    where modify p f = parseStatus' ls $ parse p f s value--          parseAudio = parseTriple ':' parseNum--          parseState "play"  = Just Playing-          parseState "pause" = Just Paused-          parseState "stop"  = Just Stopped-          parseState _       = Nothing--          parseTime s' =-              case parseFrac *** parseNum $ breakChar ':' s' of-                 (Just a, Just b) -> Just (a, b)-                 _                -> Nothing+parseStatus :: [String] -> Either String Status+parseStatus = foldM f defaultStatus . toAssocList+    where f a ("state", x)+              = return $ parse state     (\x' -> a { stState = x' }) a x+          f a ("volume", x)+              = return $ parse parseNum  (\x' -> a { stVolume = x' }) a x+          f a ("repeat", x)+              = return $ parse parseBool (\x' -> a { stRepeat = x' }) a x+          f a ("random", x)+              = return $ parse parseBool (\x' -> a { stRandom = x' }) a x+          f a ("playlist", x)+              = return $ parse parseNum  (\x' -> a { stPlaylistVersion = x' }) a x+          f a ("playlistlength", x)+              = return $ parse parseNum  (\x' -> a { stPlaylistLength = x' }) a x+          f a ("xfade", x)+              = return $ parse parseNum  (\x' -> a { stXFadeWidth = x' }) a x+          f a ("mixrampdb", x)+              = return $ parse parseFrac (\x' -> a { stMixRampdB = x' }) a x+          f a ("mixrampdelay", x)+              = return $ parse parseFrac (\x' -> a { stMixRampDelay = x' }) a x+          f a ("song", x)+              = return $ parse parseNum  (\x' -> a { stSongPos = Just x' }) a x+          f a ("songid", x)+              = return $ parse parseNum  (\x' -> a { stSongID = Just x' }) a x+          f a ("time", x)+              = return $ parse time      (\x' -> a { stTime = x' }) a x+          f a ("elapsed", x)+              = return $ parse parseFrac (\x' -> a { stTime = (x', snd $ stTime a) }) a x+          f a ("bitrate", x)+              = return $ parse parseNum  (\x' -> a { stBitrate = x' }) a x+          f a ("audio", x)+              = return $ parse audio     (\x' -> a { stAudio = x' }) a x+          f a ("updating_db", x)+              = return $ parse parseNum  (\x' -> a { stUpdatingDb = x' }) a x+          f a ("error", x)+              = return a { stError = Just x }+          f a ("single", x)+              = return $ parse parseBool (\x' -> a { stSingle = x' }) a x+          f a ("consume", x)+              = return $ parse parseBool (\x' -> a { stConsume = x' }) a x+          f a ("nextsong", x)+              = return $ parse parseNum  (\x' -> a { stNextSongPos = Just x' }) a x+          f a ("nextsongid", x)+              = return $ parse parseNum  (\x' -> a { stNextSongID = Just x' }) a x+          f _ x+              = fail $ show x -defaultStatus =-    Status { stState = Stopped, stVolume = 0, stRepeat = False-           , stRandom = False, stPlaylistID = 0, stPlaylistLength = 0-           , stSongPos = Nothing, stSongID = Nothing, stTime = (0, 0)-           , stNextSongPos = Nothing, stNextSongID = Nothing-           , stBitrate = 0, stXFadeWidth = 0, stMixRampdB = 0-           , stMixRampDelay = 0, stAudio = (0, 0, 0), stUpdatingDb = 0-           , stSingle = False, stConsume = False, stError = Nothing }+          state "play"  = Just Playing+          state "pause" = Just Paused+          state "stop"  = Just Stopped+          state _       = Nothing --------------------------------------------------------------------+          time s = case parseFrac *** parseNum $ breakChar ':' s of+                       (Just a, Just b) -> Just (a, b)+                       _                -> Nothing --- | Builds list of idle subsystems.-parseIdle :: [(String, String)] -> [Subsystem]-parseIdle [] = []-parseIdle (("changed", value):ls) =-    case value of-        "database"        -> DatabaseS       : parseIdle ls-        "update"          -> UpdateS         : parseIdle ls-        "stored_playlist" -> StoredPlaylistS : parseIdle ls-        "playlist"        -> PlaylistS       : parseIdle ls-        "player"          -> PlayerS         : parseIdle ls-        "mixer"           -> MixerS          : parseIdle ls-        "output"          -> OutputS         : parseIdle ls-        "options"         -> OptionsS        : parseIdle ls-        _                 ->                   parseIdle ls-parseIdle (_:ls) = parseIdle ls+          audio = parseTriple ':' parseNum --------------------------------------------------------------------+-- | Run a parser and lift the result into the 'MPD' monad+runParser :: (MonadMPD m, MonadError MPDError m)+          => (input -> Either String a) -> input -> m a+runParser f = either (throwError . Unexpected) return . f  -- | A helper that runs a parser on a string and, depending on the -- outcome, either returns the result of some command applied to the

@@ -32,7 +32,7 @@               | Date | Composer | Performer | Comment | Disc               | MUSICBRAINZ_ARTISTID | MUSICBRAINZ_ALBUMID               | MUSICBRAINZ_ALBUMARTISTID | MUSICBRAINZ_TRACKID-              deriving (Eq, Ord, Show)+              deriving (Eq, Enum, Ord, Show)  instance MPDArg Metadata @@ -84,8 +84,6 @@     prep TrackMode = Args ["track"]     prep AlbumMode = Args ["album"] -------------------------------------------------------------------- -- | Represents the result of running 'count'. data Count =     Count { cSongs    :: Integer -- ^ Number of songs matching the query@@ -93,14 +91,21 @@           }     deriving (Eq, Show) +defaultCount :: Count+defaultCount = Count { cSongs = 0, cPlaytime = 0 }+ -- | Represents an output device.-data Output =-    Output { outID      :: Int    -- ^ Output's ID number-           , outName    :: String -- ^ Output's name as defined in-                                  --   the MPD configuration file-           , outEnabled :: Bool-           } deriving (Eq, Show)+data Device =+    Device { dOutputID      :: Int    -- ^ Output's ID number+           , dOutputName    :: String -- ^ Output's name as defined in the MPD+                                      --   configuration file+           , dOutputEnabled :: Bool }+    deriving (Eq, Show) +defaultDevice :: Device+defaultDevice =+    Device { dOutputID = 0, dOutputName = "", dOutputEnabled = False }+ -- | Represents a single song item. data Song = Song          { sgFilePath     :: String@@ -110,27 +115,22 @@          , sgLastModified :: Maybe UTCTime          -- | Length of the song in seconds          , sgLength       :: Seconds-         -- | Position/ID in playlist-         , sgIndex        :: Maybe (Int, Int)+         -- | Id (preferred) or position in playlist+         , sgIndex        :: Maybe Int          } deriving (Eq, Show)  -- | Get list of specific tag type-sgGet :: Metadata -> Song -> Maybe [String]-sgGet meta s = M.lookup meta $ sgTags s---- | Represents a single playlist item.-data Playlist = Playlist {-               plName         :: String-             , plLastModified :: Maybe UTCTime-             } deriving (Eq, Show)+sgGetTag :: Metadata -> Song -> Maybe [String]+sgGetTag meta s = M.lookup meta $ sgTags s --- | Represents a single item in database.-data Entry = SongE Song-           | PlaylistE Playlist-           | DirectoryE String-           deriving (Eq, Show)+-- | Add metadata tag value.+sgAddTag :: Metadata -> String -> Song -> Song+sgAddTag meta value s = s { sgTags = M.insertWith' (++) meta [value] (sgTags s) } -------------------------------------------------------------------+defaultSong :: Song+defaultSong =+    Song { sgFilePath = "", sgTags = M.empty, sgLastModified = Nothing+         , sgLength = 0, sgIndex = Nothing }  -- | Container for database statistics. data Stats =@@ -145,6 +145,11 @@           }     deriving (Eq, Show) +defaultStats :: Stats+defaultStats =+     Stats { stsArtists = 0, stsAlbums = 0, stsSongs = 0, stsUptime = 0+           , stsPlaytime = 0, stsDbPlaytime = 0, stsDbUpdate = 0 }+ -- | Container for MPD status. data Status =     Status { stState :: State@@ -154,7 +159,7 @@            , stRandom          :: Bool              -- | A value that is incremented by the server every time the              --   playlist changes.-           , stPlaylistID      :: Integer+           , stPlaylistVersion :: Integer              -- | The number of items in the current playlist.            , stPlaylistLength  :: Integer              -- | Current song's position in the playlist.@@ -188,3 +193,12 @@            , stError           :: Maybe String }     deriving (Eq, Show) +defaultStatus :: Status+defaultStatus =+    Status { stState = Stopped, stVolume = 0, stRepeat = False+           , stRandom = False, stPlaylistVersion = 0, stPlaylistLength = 0+           , stSongPos = Nothing, stSongID = Nothing, stTime = (0,0)+           , stNextSongPos = Nothing, stNextSongID = Nothing+           , stBitrate = 0, stXFadeWidth = 0, stMixRampdB = 0+           , stMixRampDelay = 0, stAudio = (0,0,0), stUpdatingDb = 0+           , stSingle = False, stConsume = False, stError = Nothing }

@@ -13,8 +13,9 @@ import Network.MPD.Core import Network.MPD.Utils -import Control.Monad.Error (throwError)+import Control.Monad.Error import Data.List (intersperse)+import Data.Maybe (mapMaybe)  -- Run getResponse but discard the response. getResponse_ :: MonadMPD m => String -> m ()@@ -36,12 +37,36 @@  -- Run 'toAssocList' and return only the values. takeValues :: [String] -> [String]-takeValues = map snd . toAssocList+takeValues = snd . unzip . toAssocList --- Build a list of Song instances from a response.-takeSongs :: MonadMPD m => [String] -> m [Song]-takeSongs = return . parseSongs . toAssocList+data EntryType+    = SongEntry Song+    | PLEntry   String+    | DirEntry  String+      deriving (Eq, Show) --- Build a list of Entry instances from a response.-takeEntries :: MonadMPD m => [String] -> m [Entry]-takeEntries = return . parseEntries . toAssocList+-- Separate the result of an lsinfo\/listallinfo call into directories,+-- playlists, and songs.+takeEntries :: MonadMPD m => [String] -> m [EntryType]+takeEntries = mapM toEntry . splitGroups wrappers . toAssocList+    where+        toEntry xs@(("file",_):_)   = liftM SongEntry $ runParser parseSong xs+        toEntry (("directory",d):_) = return $ DirEntry d+        toEntry (("playlist",pl):_) = return $ PLEntry  pl+        toEntry _ = error "takeEntries: splitGroups is broken"+        wrappers = [("file",id), ("directory",id), ("playlist",id)]++-- Extract a subset of songs, directories, and playlists.+extractEntries :: (Song -> Maybe a, String -> Maybe a, String -> Maybe a)+               -> [EntryType] -> [a]+extractEntries (fSong,fPlayList,fDir) = mapMaybe f+    where+        f (SongEntry s) = fSong s+        f (PLEntry pl)  = fPlayList pl+        f (DirEntry d)  = fDir d++-- Build a list of song instances from a response.+takeSongs :: MonadMPD m => [String] -> m [Song]+takeSongs = mapM (runParser parseSong)+          . splitGroups [("file",id)]+          . toAssocList

@@ -35,7 +35,6 @@ import Network (PortID(..), withSocketsDo, connectTo) import System.IO (Handle, hPutStrLn, hReady, hClose, hFlush) import System.IO.Error (isEOFError)-import System.IO.Unsafe (unsafeInterleaveIO) import qualified System.IO.UTF8 as U  --@@ -74,7 +73,6 @@     open  = mpdOpen     close = mpdClose     send  = mpdSend-    receive = mpdReceive     getHandle = MPD $ get >>= return . stHandle     getPassword = MPD $ get >>= return . stPassword     setPassword pw = MPD $ modify (\st -> st { stPassword = pw })@@ -113,7 +111,7 @@             `catch` const (return Nothing)          checkConn = do-            msg <- mpdReceive >>= checkMsg+            [msg] <- lines <$> send ""             if isPrefixOf "OK MPD" msg                then do                    MPD $ maybe (throwError $ Custom "Couldn't determine MPD version")@@ -122,11 +120,6 @@                    return True                else return False -        checkMsg ls =-            if null ls-               then throwError $ Custom "No welcome message"-               else return $ head ls-         parseVersion = parseTriple '.' parseNum . dropWhile (not . isDigit)  mpdClose :: MPD ()@@ -143,31 +136,31 @@             | isEOFError err = result             | otherwise      = ioError err -mpdSend :: String -> MPD ()-mpdSend str = MPD $ get >>= maybe (throwError NoMPD) go . stHandle+mpdSend :: String -> MPD String+mpdSend str = send' `catchError` handler     where-        go handle =+        handler TimedOut = mpdOpen >> send'+        handler err      = throwError err++        send' = MPD $ get >>= maybe (throwError NoMPD) go . stHandle++        go handle = do             unless (null str) $                 liftIO $ U.hPutStrLn handle str >> hFlush handle--mpdReceive :: MPD [String]-mpdReceive = getHandle >>= maybe (throwError NoMPD) recv-    where-        recv handle = MPD $-            liftIO ((Right <$> getLines handle) `catch` (return . Left))+            liftIO ((Right <$> getLines handle []) `catch` (return . Left))                 >>= either (\err -> if isEOFError err then                                         modify (\st -> st { stHandle = Nothing })                                         >> throwError TimedOut                                       else liftIO (ioError err))                            return -        getLines handle = do+        getLines handle acc = do             l <- U.hGetLine handle             if "OK" `isPrefixOf` l || "ACK" `isPrefixOf` l-                then return [l]-                else do ls <- unsafeInterleaveIO $ getLines handle-                        return (l:ls)+                then return . unlines $ reverse (l:acc)+                else getLines handle (l:acc) + -- -- Other operations. --@@ -183,23 +176,24 @@  -- | Send a command to the MPD server and return the result. getResponse :: (MonadMPD m) => String -> m [String]-getResponse cmd = (send cmd >> receive >>= parseResponse) `catchError` sendpw+getResponse cmd = (send cmd >>= parseResponse) `catchError` sendpw     where         sendpw e@(ACK Auth _) = do             pw <- getPassword-            if null pw-                then throwError e-                else do send ("password " ++ pw) >> receive >>= parseResponse-                        send cmd                 >> receive >>= parseResponse+            if null pw then throwError e+                else send ("password " ++ pw) >>= parseResponse+                  >> send cmd >>= parseResponse         sendpw e =             throwError e  -- Consume response and return a Response.-parseResponse :: (MonadError MPDError m) => [String] -> m [String]-parseResponse xs+parseResponse :: (MonadError MPDError m) => String -> m [String]+parseResponse s     | null xs                    = throwError $ NoMPD-    | isPrefixOf "ACK" (head xs) = throwError $ parseAck (head xs)+    | isPrefixOf "ACK" (head xs) = throwError $ parseAck s     | otherwise                  = return $ Prelude.takeWhile ("OK" /=) xs+    where+        xs = lines s  -- Turn MPD ACK into the corresponding 'MPDError' parseAck :: String -> MPDError

@@ -25,10 +25,8 @@     open  :: m ()     -- | Close the connection.     close :: m ()-    -- | Send a string to the server.-    send  :: String -> m ()-    -- | Get response from the server.-    receive :: m [String]+    -- | Send a string to the server and return its response.+    send  :: String -> m String     -- | Get underlying Handle (or Nothing, if no connection is estabilished)     getHandle :: m (Maybe Handle)     -- | Produce a password to send to the server should it ask for

@@ -64,7 +64,7 @@ parseTriple c f s = let (u, u') = breakChar c s                         (v, w)  = breakChar c u' in     case (f u, f v, f w) of-        (Just x, Just y, Just z) -> Just (x, y, z)+        (Just a, Just b, Just c') -> Just (a, b, c')         _                        -> Nothing  -- Break a string into an key-value pair, separating at the first ':'.

@@ -1,9 +1,8 @@ # libmpd-haskell: a client library for MPD  ## About--libmpd-haskell is a client library for [MPD] written in [Haskell] that <br />-aims to provide a safe and flexible yet consistent and intuitive <br />+libmpd-haskell is a client library for [MPD] written in [Haskell] that+aims to provide a safe and flexible yet consistent and intuitive interface to MPD's external API.  [MPD]: http://www.musicpd.org@@ -13,8 +12,19 @@ * [Latest release] * `git clone git://github.com/joachifm/libmpd-haskell.git` -[Latest release]: http://hackage.haskell.org/package/libmpd+There are packages available on the following systems: +* [Alt Linux](http://sisyphus.ru/en/srpm/Sisyphus/ghc-libmpd "libmpd-haskell for Alt Linux")+* [Arch Linux](http://aur.archlinux.org/packages.php?ID=17759 "libmpd-haskell for Arch Linux")+* [Fedora](https://admin.fedoraproject.org/pkgdb/acls/name/ghc-libmpd "libmpd-haskell for Fedora")+* [FreeBSD](http://www.freebsd.org/cgi/cvsweb.cgi/ports/audio/hs-libmpd/ "libmpd-haskell for FreeBSD")+* [Gentoo Linux](http://code.haskell.org/gentoo/gentoo-haskell/dev-haskell/libmpd/ "libmpd-haskell for Gentoo Linux")+* [Gobo Linux](http://www.gobolinux.org/recipe-store/Haskell-LibMPD--0.3.1-r1--recipe.tar.bz2 "libmpd-haskell for Gobo Linux")++Note that some of these packages are outdated.++[Latest release]: http://hackage.haskell.org/package/libmpd "libmpd-haskell on Hackage"+ ## Building The preferred method of building libmpd-haskell is using [cabal-install], which takes care of dependency resolution and other minutiae.@@ -23,10 +33,6 @@  `cd libmpd-haskell && cabal install` -To use the deprecated base 3, run:--`cabal install -f old_base`- [cabal-install]: http://hackage.haskell.org/package/cabal-install  ## Running tests@@ -43,7 +49,6 @@ any deviation from this is a bug.  ## Usage- With GHCi:      > import Network.MPD@@ -54,51 +59,127 @@  ## Development -To start developing libmpd-haskell you'll first need a clone of the-source code repository:+### Branches -`git clone git://github.com/joachifm/libmpd-haskell.git`+* `master`:+      Stable branch, should never break.+* `trunk`:+      Development branch, turns into master+* `integrate`:+      New, untested stuff -To pull in new changes from upstream, use:+Develop against `trunk` unless the patch is fixing a problem known to exist in `master`. -`git pull origin master`+### Getting started+Create the clone thus: -When writing or modifying code, please try to conform to the-surrounding style. If you introduce new functionality, please include-a test case or at least document the expected behavior.+`git clone git://github.com/joachifm/libmpd-haskell.git trunk` +To pull in new changes from upstream, use:++`git pull origin trunk`+ To set up GIT hooks, see `hooks/README` in the source distribution. +### General guidelines+* When writing or modifying code, please try to conform to the surrounding style++* All bugs that exist in `master` should be fixed there first, and then+  forward-ported to other branches.++* If you introduce new functionality, please include a test case or at least+  document the expected behavior.++* Use -Wall during development and try to eliminate all warnings before+  submitting your patch++* Merge the upstream branch and redo your patch if necessary+  before submitting it++* Merge with upstream on a regular basis for long-running branches++* Before merging `trunk` with `master`, all tests must pass++* When fixing a bug, try to implement a test for it first++* Orphan instances are bad, use `newtype` if at all possible. Otherwise,+  please use `{-# OPTIONS_GHC -fno-warn-orphans #-}` in the affected source+  file and note why it is necessary to use it. This does not apply to the test+  harness++* Branches are cheap, use them+ ### Submitting patches-To submit a patch, use `git format-patch` and email the resulting-file to one of the developers or upload it to the [bug tracker].+To submit a patch, use `git format-patch` and email the resulting file(s) to+one of the developers or upload it to the [bug tracker]. -Alternatively you can create your own fork of the [repository]-and send a pull request.+Alternatively you can create your own fork of the [repository] and send a pull+request.  ### Submitting bug reports-See our [bug tracker].+See our [bug tracker]. Test cases are highly appreciated. +### The release process+This outlines a general process used when cutting a new release:++01. Decide what version component should be bumped+02. Create a topic branch+03. Run the test harness+04. Fix errors+05. Goto 3 unless there were no errors to fix+06. Make sure `README.md` is correct, add any contributors+07. Update the `NEWS`+08. Create a source distribution using `cabal sdist`+09. Unpack the source to a temporary location and make sure it builds and that+no files are missing+10. Goto 8 unless there were no errors to fix+11. Merge topic branch into `master`+12. Tag the release by doing `git tag -a -m vVERSION vVERSION`++In general, patches that fix bugs are the most critical and should be+released quickly (bumping the last version component). Remember, all+deviations from the MPD protocol specification are considered bugs.++In some cases, say when the MPD protocol changes to the point of not+being backwards compatible, a bump in at least the minor version is required.++The same goes for making backwards incompatible API changes (e.g., deletions,+type changes).++The major version indicates "completeness", and after the first 1.0.0 release,+all subsequent API changes must be backwards compatible (that is, only+additions are allowed).++For users this means that restricting dependencies on libmpd-haskell+to only allow changes in the last version component guarantees that+your code will not break due to updates. All users are nonetheless encouraged+to support the latest major/minor release at any given time, because there+is no backporting.+ ### Resources * [API documentation]+* [libmpd-haskell mailing list] * [Protocol reference] * [Using GitHub]-* \#libmpd-haskell @ irc.freenode.net+* \#libmpd-haskell @ irc.freenode.net (defunct) -[bug tracker]: http://trac.haskell.org/libmpd/+[libmpd-haskell mailing list]: http://groups.google.com/group/libmpd-haskell+[bug tracker]: http://github.com/joachifm/libmpd-haskell/issues [GitHub]: http://www.github.com [repository]: http://www.github.com/joachifm/libmpd-haskell-[API documentation]: http://hackage.haskell.org/packages/archive/libmpd/0.4.2/doc/html/Network-MPD.html+[API documentation]: http://hackage.haskell.org/packages/archive/libmpd/0.5.0/doc/html/Network-MPD.html [Protocol reference]: http://www.musicpd.org/doc/protocol/ [Using GitHub]: http://help.github.com  ## License LGPL version 2.1 (see LICENSE) -## Authors+## Contributors (in order of appearance) Ben Sinclair \<ben.d.sinclair@gmail.com\>  Joachim Fasting \<joachim.fasting@gmail.com\>++gwern0 \<gwern0@gmail.com\>  Daniel Schoepe \<daniel.schoepe@googlemail.com\> 

@@ -1,23 +1,23 @@ Name:               libmpd-Version:            0.5.0+Version:            0.6.0 License:            LGPL License-file:       LICENSE-Copyright:          Ben Sinclair 2005-2009, Joachim Fasting 2010+Copyright:          Ben Sinclair 2005-2009, Joachim Fasting 2010, 2011 Author:             Ben Sinclair Maintainer:         Joachim Fasting <joachim.fasting@gmail.com> Stability:          beta Homepage:           http://github.com/joachifm/libmpd-haskell-Bug-reports:        http://trac.haskell.org/libmpd/newticket+Bug-reports:        http://github.com/joachifm/libmpd-haskell/issues Synopsis:           An MPD client library. Description:        A client library for MPD, the Music Player Daemon                     (<http://www.musicpd.org/>). Category:           Network, Sound-Tested-With:        GHC == 6.10.1, GHC == 6.12.1+Tested-With:        GHC == 7.0.2 Build-Type:         Simple Cabal-Version:      >= 1.6-Extra-Source-Files: README.md ChangeLog tests/Properties.hs tests/Commands.hs-                    tests/Main.hs tests/Displayable.hs tests/run-tests.lhs-                    tests/coverage.lhs+Extra-Source-Files: README.md NEWS tests/Properties.hs+                    tests/Commands.hs tests/Main.hs tests/Displayable.hs+                    tests/run-tests.lhs tests/coverage.lhs  flag test     Description: Build test driver@@ -27,26 +27,19 @@     Description: Build driver with hpc instrumentation     Default: False -flag old_base-    Description: Use base version 3-    Default: False- Source-Repository head     type:       git     location:   git://github.com/joachifm/libmpd-haskell.git  Library-    if flag(old_base)-        Build-Depends: base >= 3 && < 4-    else-        Build-Depends: base >= 4 && < 5--    Build-Depends:      network >= 2.1 && < 2.3,-                        mtl >= 1.1 && < 1.2, filepath >= 1.0 && < 1.2,+    Build-Depends:      base >= 4 && < 5,+                        mtl >= 2.0 && < 2.1,+                        network >= 2.1 && < 2.4,+                        filepath >= 1.0 && < 1.3,                         utf8-string >= 0.3.1 && < 0.4,-                        containers >= 0.3 && < 0.4,-                        time >= 1.1 && < 1.2,-                        old-locale >= 1.0 && < 1.1+                        old-locale >= 1.0 && < 2.0,+                        time >= 1.1 && < 2.0,+                        containers >= 0.4 && < 0.5     Exposed-Modules:    Network.MPD, Network.MPD.Commands.Extensions,                         Network.MPD.Core     Other-Modules:      Network.MPD.Core.Class,@@ -58,6 +51,7 @@                         Network.MPD.Commands.Types,                         Network.MPD.Commands.Util,                         Network.MPD.Utils+     ghc-prof-options:   -auto-all -prof      if flag(test)@@ -67,8 +61,9 @@     Hs-Source-Dirs:     . tests     Main-Is:            tests/Main.hs     Build-Depends:      base ==4.*, network, mtl, filepath, utf8-string+    -- Dependencies that are only required by the test-suite:     if flag(test)-        Build-Depends: QuickCheck ==2.1.*+        Build-Depends: QuickCheck ==2.1.*, time, containers     ghc-options:        -Wall -Werror -fno-warn-warnings-deprecations                         -fno-warn-type-defaults 

@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -Wwarn -fno-warn-missing-signatures #-}  -- | -- This module provides a way of verifying that the interface to the MPD@@ -14,6 +14,7 @@ import Arbitrary () import Displayable import Network.MPD.Commands+import Network.MPD.Commands.Extensions import Network.MPD.Core (MPDError(..), Response, ACKType(..)) import StringConn @@ -31,15 +32,21 @@                   ,("update0", testUpdate0)                   ,("update1", testUpdate1)                   ,("updateMany", testUpdateMany)+{-                   ,("prop_find", mycheck prop_find 100)+-}+                  {-                   ,("prop_lsFiles", mycheck prop_lsFiles 100)                   ,("prop_lsDirs", mycheck prop_lsDirs 100)+                  -}                   ,("list(Nothing)", testListNothing)                   ,("list(Just)", testListJust)                   ,("listAll", testListAll)                   ,("lsInfo", testLsInfo)                   ,("listAllInfo", testListAllInfo)+{-                   ,("search", testSearch)+-}                   ,("count", testCount)                   ,("add", testAdd)                   ,("add_", testAdd_)@@ -48,43 +55,67 @@                   ,("clear / playlist", testClearPlaylist)                   ,("clear / current", testClearCurrent)                   ,("plChangesPosId 0", testPlChangesPosId_0)+                  {-                   ,("plChangesPosId 1", testPlChangesPosId_1)+                  -}                   ,("plChangesPosId weird", testPlChangesPosId_Weird)                   ,("currentSong(_)", testCurrentSongStopped)+                  {-                   ,("currentSong(>)", testCurrentSongPlaying)+                  -}+                  {-                   ,("delete0", testDelete0)                   ,("delete1", testDelete1)+                  -}                   ,("delete2", testDelete2)                   ,("load", testLoad)+                  {-                   ,("move0", testMove0)                   ,("move1", testMove1)                   ,("move2", testMove2)+                  -}                   ,("rm", testRm)                   ,("rename", testRename)                   ,("save", testSave)+                  {-                   ,("swap0", testSwap0)                   ,("swap1", testSwap1)+                  -}                   ,("shuffle", testShuffle)+{-                   ,("playlistInfo0", testPlaylistInfo0)+-}+                  {-                   ,("playlistInfo / pos", testPlaylistInfoPos)                   ,("playlistInfo / id", testPlaylistInfoId)+                  -}+{-                   ,("listPlaylistInfo", testListPlaylistInfo)+-}                   ,("listPlaylist", testListPlaylist)+                  {-                   ,("playlist", testPlaylist)+                  -}+{-                   ,("plchanges", testPlChanges)                   ,("playlistFind", testPlaylistFind)                   ,("playlistSearch", testPlaylistSearch)+-}                   ,("crossfade", testCrossfade)                   ,("play", testPlay)+                  {-                   ,("play / pos", testPlayPos)                   ,("play / id", testPlayId)+                  -}                   ,("pause", testPause)                   ,("stop", testStop)                   ,("next", testNext)                   ,("previous", testPrevious)+                  {-                   ,("seek / pos", testSeekPos)                   ,("seek / id", testSeekId)                   ,("seek / current", testSeekCur)+                  -}                   ,("random", testRandom)                   ,("repeat", testRepeat)                   ,("setVolume", testSetVolume)@@ -108,7 +139,9 @@                   ,("toggle / pause", testTogglePause)                   ,("addMany0", testAddMany0)                   ,("addMany1", testAddMany1)+                  {-                   ,("deleteMany1", testDeleteMany1)+                  -}                   ]  test :: (Show a, Eq a)@@ -165,7 +198,8 @@ -- Database commands -- -prop_find :: Song -> Meta -> QC.Property+{-+prop_find :: Song -> Metadata -> QC.Property prop_find song meta = isJust (sgDisc song) ==> result == Ok     where         result = testMPD [("find "++ show meta ++ " \"" ++ query ++ "\""@@ -184,9 +218,13 @@             Composer  -> sgComposer  song             Performer -> sgPerformer song             Disc      -> show $ fromJust $ sgDisc song+            {-             Filename  -> sgFilePath  song             Any       -> "Foo"+            -}+-} +{- XXX: where did these go? prop_lsFiles :: [Song] -> Bool prop_lsFiles ss = result == Ok     where@@ -206,6 +244,7 @@                     (Right $ map (dropWhile isSpace) ds)                     ""                     (lsDirs "")+-}  testListNothing =     test [("list Title", Right "Title: Foo\nTitle: Bar\nOK")]@@ -239,12 +278,14 @@          (Right [Left "Foo", Left "Bar"])          (listAllInfo "") +{- testSearch =     test [("search Artist \"oo\"", Right resp)] (Right [obj])          (search (Artist =? "oo"))     where obj = empty { sgArtist = "Foo", sgTitle = "Bar"                       , sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60 }           resp = display obj ++ "OK"+-}  testCount =     test [("count Title \"Foo\"", Right resp)] (Right obj)@@ -282,10 +323,12 @@          (Right [])          (plChangesPosId 10) +{- XXX: port this? testPlChangesPosId_1 =     test [("plchangesposid 10", Right "cpos: 0\nId: 20\nOK")]          (Right [(Pos 0, ID 20)])          (plChangesPosId 10)+-}  testPlChangesPosId_Weird =     test [("plchangesposid 10", Right "cpos: foo\nId: bar\nOK")]@@ -297,6 +340,7 @@     where obj  = empty { stState = Stopped, stPlaylistVersion = 253 }           resp = display obj ++ "OK" +{- XXX: port this testCurrentSongPlaying =     test [("status", Right resp2)          ,("currentsong", Right resp1)]@@ -316,14 +360,17 @@ testDelete0 = test_ [("delete 1", Right "OK")] (delete (Pos 1))  testDelete1 = test_ [("deleteid 1", Right "OK")] (delete (ID 1))+-}  testDelete2 = test_ [("playlistdelete \"foo\" 1", Right "OK")] (playlistDelete "foo" 1)  testLoad = test_ [("load \"foo\"", Right "OK")] (load "foo") +{- XXX: port this testMove0 = test_ [("move 1 2", Right "OK")] (move (Pos 1) 2)  testMove1 = test_ [("moveid 1 2", Right "OK")] (move (ID 1) 2)+-}  testMove2 = test_ [("playlistmove \"foo\" 1 2", Right "OK")] (playlistMove "foo" 1 2) @@ -333,36 +380,46 @@  testSave = test_ [("save \"foo\"", Right "OK")] (save "foo") +{- testSwap0 = test_ [("swap 1 2", Right "OK")] (swap (Pos 1) (Pos 2))  testSwap1 = test_ [("swapid 1 2", Right "OK")] (swap (ID 1) (ID 2))+-}  testShuffle = test_ [("shuffle", Right "OK")] (shuffle Nothing) +{- testPlaylistInfo0 = test [("playlistinfo", Right resp)] (Right [obj])                     (playlistInfo Nothing)     where obj = empty { sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60                       , sgArtist = "Foo", sgTitle = "Bar" }           resp = display obj ++ "OK"+-} +{- XXX: port this testPlaylistInfoPos = test [("playlistinfo 1", Right resp)] (Right [obj])                       (playlistInfo (Just (Left (Pos 1))))     where obj = empty { sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60                       , sgArtist = "Foo", sgTitle = "Bar" }           resp = display obj ++ "OK"+-} +{- XXX: port this testPlaylistInfoId = test [("playlistid 1", Right resp)] (Right [obj])                      (playlistInfo (Just (Left (ID 1))))     where obj = empty { sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60                       , sgArtist = "Foo", sgTitle = "Bar" }           resp = display obj ++ "OK"+-} +{- testListPlaylistInfo = test [("listplaylistinfo \"foo\"", Right resp)]                        (Right [obj])                        (listPlaylistInfo "foo")     where obj = empty { sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60                       , sgArtist = "Foo", sgTitle = "Bar" }           resp = display obj ++ "OK"+-}  testListPlaylist = test [("listplaylist \"foo\""                          ,Right "file: dir/Foo-bar.ogg\n\@@ -371,6 +428,7 @@                    (Right ["dir/Foo-bar.ogg", "dir/Quux-quuz.ogg"])                    (listPlaylist "foo") +{- testPlaylist = test [("playlist"                      ,Right "1:Foo.ogg\n\                             \2:Bar.ogg\n\@@ -378,23 +436,30 @@                (Right [(Pos 1, "Foo.ogg")                       ,(Pos 2, "Bar.ogg")])                playlist+-} +{- testPlChanges = test [("plchanges 0", Right resp)] (Right [obj]) (plChanges 0)     where obj = empty { sgArtist = "Foo", sgTitle = "Bar"                       , sgFilePath = "foo/bar.ogg" }           resp = display obj ++ "OK"+-} +{- testPlaylistFind = test [("playlistfind Artist \"Foo\"", Right resp)]                    (Right [obj])                    (playlistFind (Artist =? "Foo"))     where obj = empty { sgFilePath = "dir/Foo/Bar.ogg", sgArtist = "Foo" }           resp = display obj ++ "OK"+-} +{- testPlaylistSearch = test [("playlistsearch Artist \"Foo\"", Right resp)]                      (Right [obj])                      (playlistSearch (Artist =? "Foo"))     where obj = empty { sgFilePath = "dir/Foo/Bar.ogg", sgArtist = "Foo" }           resp = display obj ++ "OK"+-}  -- -- Playback commands@@ -404,9 +469,13 @@  testPlay = test_ [("play", Right "OK")] (play Nothing) +{- XXX: port this testPlayPos = test_ [("play 1", Right "OK")] (play . Just $ Pos 1)+-} +{- XXX: port this testPlayId = test_ [("playid 1", Right "OK")] (play . Just $ ID 1)+-}  testPause = test_ [("pause 0", Right "OK")] (pause False) @@ -416,15 +485,19 @@  testPrevious = test_ [("previous", Right "OK")] previous +{- XXX: port this testSeekPos = test_ [("seek 1 10", Right "OK")] (seek (Just $ Pos 1) 10)  testSeekId = test_ [("seekid 1 10", Right "OK")] (seek (Just $ ID 1) 10)+-} +{- XXX: port this testSeekCur = test_ [("status", Right resp)                     ,("seekid 1 10", Right "OK")]               (seek Nothing 10)     where obj = empty { stState = Playing, stSongID = Just (ID 1) }           resp = display obj ++ "OK"+-}  testRandom = test_ [("random 0", Right "OK")] (random False) @@ -529,8 +602,10 @@ testAddMany1 = test_ [("playlistadd \"foo\" \"bar\"", Right "OK")]                (addMany "foo" ["bar"]) +{- XXX: where did this go? testDeleteMany1 = test_ [("playlistdelete \"foo\" 1", Right "OK")]                   (deleteMany "foo" [Pos 1])+-}  testVolume = test_ [("status", Right st), ("setvol 90", Right "OK")] (volume (-10))     where st = display empty { stVolume = 100 }

@@ -1,5 +1,8 @@+{-# OPTIONS_GHC -Wwarn #-}+ module Displayable (Displayable(..)) where +import qualified Data.Map as M import Network.MPD.Commands.Types import Network.MPD.Utils @@ -25,21 +28,16 @@  instance Displayable Song where     empty = defaultSong-    display s = unlines $-        ["file: "      ++ sgFilePath s-        ,"Artist: "    ++ sgArtist s-        ,"Album: "     ++ sgAlbum s-        ,"Title: "     ++ sgTitle s-        ,"Genre: "     ++ sgGenre s-        ,"Name: "      ++ sgName s-        ,"Composer: "  ++ sgComposer s-        ,"Performer: " ++ sgPerformer s-        ,"Date: "      ++ show (sgDate s)-        ,"Track: "     ++ (let (x,y) = sgTrack s in show x++"/"++show y)-        ,"Disc: "      ++ (case sgDisc s of Just (x,y) -> show x++"/"++show y; _ -> "")-        ,"Time: "      ++ show (sgLength s)]-        ++ maybe [] (\x -> [case x of Pos n -> "Pos: " ++ show n-                                      ID  n -> "Id: "  ++ show n]) (sgIndex s)+    display s =+        let fs  = concatMap toF . M.toList $ sgTags s+            idx = maybe [] (\n -> ["Id: " ++ show n]) (sgIndex s)+        in unlines $ ["file: " ++ sgFilePath s]+                  ++ fs+                  ++ ["Last-Modified: " ++ show (sgLastModified s)]+                  ++ idx+        where+            toF (k, vs) = map (toF' k) vs+            toF' k v    = show k ++ ": " ++ v  instance Displayable Stats where     empty = defaultStats@@ -74,7 +72,5 @@         ,"error: " ++ show (stError s)         ,"single: " ++ showBool (stSingle s)         ,"consume: " ++ showBool (stConsume s)]-        ++ maybe [] (\x -> [case x of Pos n -> "song: " ++ show n-                                      _     -> undefined]) (stSongPos s)-        ++ maybe [] (\x -> [case x of ID n  -> "songid: " ++ show n-                                      _     -> undefined]) (stSongID s)+        ++ maybe [] (\n -> ["song: " ++ show n]) (stSongPos s)+        ++ maybe [] (\n -> ["songid: " ++ show n]) (stSongID s)

@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -Wwarn -fno-warn-missing-signatures #-} -- | -- GUTD: The Grand Unified Test Driver. import qualified Commands

@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-methods #-}+{-# OPTIONS_GHC -Wwarn -fno-warn-orphans -fno-warn-missing-methods #-} module Properties (main) where  import Arbitrary