libmpd 0.2.1 → 0.3.0
raw patch · 14 files changed
+292/−409 lines, 14 filesdep +utf8-stringdep ~basesetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies added: utf8-string
Dependency ranges changed: base
API changes (from Hackage documentation)
- Network.MPD: MultiQuery :: [Query] -> Query
- Network.MPD: Query :: Meta -> String -> Query
- Network.MPD: data Query
+ Network.MPD: Match :: Meta -> String -> Match
+ Network.MPD: data Match
+ Network.MPD: type Query = [Match]
- Network.MPD: list :: Meta -> Maybe Query -> MPD [String]
+ Network.MPD: list :: Meta -> Query -> MPD [String]
Files
- ChangeLog +7/−0
- Network/MPD.hs +5/−20
- Network/MPD/Commands.hs +158/−124
- Network/MPD/Core.hs +2/−19
- Network/MPD/Parse.hs +3/−107
- Network/MPD/SocketConn.hs +4/−22
- Network/MPD/StringConn.hs +0/−80
- Network/MPD/Types.hs +94/−0
- Network/MPD/Utils.hs +2/−21
- Setup.lhs +0/−2
- libmpd.cabal +3/−3
- tests/Commands.hs +9/−9
- tests/Displayable.hs +1/−1
- tests/Properties.hs +4/−1
ChangeLog view
@@ -1,5 +1,12 @@+* v0.2.2, 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.
Network/MPD.hs view
@@ -1,31 +1,16 @@-{-- libmpd for Haskell, an MPD client library.- Copyright (C) 2005-2008 Ben Sinclair <bsinclai@turing.une.edu.au>-- This library is free software; you can redistribute it and/or- modify it under the terms of the GNU Lesser General Public- License as published by the Free Software Foundation; either- version 2.1 of the License, or (at your option) any later version.-- This library is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU- Lesser General Public License for more details.-- You should have received a copy of the GNU Lesser General Public- License along with this library; if not, write to the Free Software- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA--}- -- | Module : Network.MPD -- Copyright : (c) Ben Sinclair 2005-2008--- License : LGPL+-- License : LGPL (see LICENSE) -- Maintainer : bsinclai@turing.une.edu.au -- Stability : alpha -- Portability : Haskell 98 -- -- An MPD client library. MPD is a daemon for playing music that is -- controlled over a network socket. Its site is at <http://www.musicpd.org/>.+--+-- To avoid name clashes with the standard Prelude functions, do:+--+-- > import qualified Network.MPD as MPD module Network.MPD ( -- * Basic data types
Network/MPD/Commands.hs view
@@ -1,39 +1,19 @@-{-# LANGUAGE PatternGuards #-}-{-- libmpd for Haskell, an MPD client library.- Copyright (C) 2005-2008 Ben Sinclair <bsinclai@turing.une.edu.au>-- This library is free software; you can redistribute it and/or- modify it under the terms of the GNU Lesser General Public- License as published by the Free Software Foundation; either- version 2.1 of the License, or (at your option) any later version.-- This library is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU- Lesser General Public License for more details.-- You should have received a copy of the GNU Lesser General Public- License along with this library; if not, write to the Free Software- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA--}+{-# LANGUAGE PatternGuards, TypeSynonymInstances #-} -- | Module : Network.MPD.Commands -- Copyright : (c) Ben Sinclair 2005-2008--- License : LGPL+-- License : LGPL (see LICENSE) -- Maintainer : bsinclai@turing.une.edu.au -- Stability : alpha--- Portability : unportable (uses PatternGuards)+-- Portability : unportable (uses PatternGuards and TypeSynonymInstances) -- -- Interface to the user commands supported by MPD. module Network.MPD.Commands ( -- * Command related data types- State(..), Status(..), Stats(..),- Device(..),- Query(..), Meta(..),- Artist, Album, Title, Seconds, PlaylistName, Path,- PLIndex(..), Song(..), Count(..),+ Artist, Album, Title, PlaylistName, Path,+ Meta(..), Match(..), Query,+ module Network.MPD.Types, -- * Admin commands disableOutput, enableOutput, kill, outputs, update,@@ -65,6 +45,7 @@ import Network.MPD.Core import Network.MPD.Utils import Network.MPD.Parse+import Network.MPD.Types import Control.Monad (liftM, unless) import Control.Monad.Error (throwError)@@ -77,6 +58,53 @@ -- Data types -- +-- Arguments for getResponse are accumulated as strings in values of+-- this type after being converted from whatever type (an instance of+-- MPDArg) they were to begin with.+newtype Args = Args [String]+ deriving Show++-- A uniform interface for argument preparation+-- The basic idea is that one should be able+-- to magically prepare an argument for use with+-- an MPD command, without necessarily knowing/\caring+-- how it needs to be represented internally.+class Show a => MPDArg a where+ prep :: a -> Args+ -- Note that because of this, we almost+ -- never have to actually provide+ -- an implementation of 'prep'+ prep = Args . return . show++-- | Groups together arguments to getResponse.+infixl 3 <++>+(<++>) :: (MPDArg a, MPDArg b) => a -> b -> Args+x <++> y = Args $ xs ++ ys+ where Args xs = prep x+ Args ys = prep y++-- | Converts a command name and a string of arguments into the string+-- to hand to getResponse.+infix 2 <$>+(<$>) :: (MPDArg a) => String -> a -> String+x <$> y = x ++ " " ++ unwords (filter (not . null) y')+ where Args y' = prep y++instance MPDArg Args where prep = id++instance MPDArg String where+ -- We do this to avoid mangling+ -- non-ascii characters with 'show'+ prep x = Args ['"' : x ++ "\""]++instance (MPDArg a) => MPDArg (Maybe a) where+ prep Nothing = Args []+ prep (Just x) = prep x++instance MPDArg Int+instance MPDArg Integer+instance MPDArg Bool where prep = Args . return . showBool+ type Artist = String type Album = String type Title = String@@ -95,34 +123,51 @@ | Composer | Performer | Disc | Any | Filename deriving Show --- | A query is composed of a scope modifier and a query string.+instance MPDArg Meta++-- | When searching for specific items in a collection+-- of songs, we need a reliable way to build predicates. Match is+-- one way of achieving this.+-- Each Match is a clause, and by putting matches together in lists, we can+-- compose queries. ----- To match entries where album equals \"Foo\", use:+-- For example, to match any song where the value of artist is \"Foo\", we use: ----- > Query Album "Foo"+-- > Match Artist "Foo" ----- To match entries where album equals \"Foo\" and artist equals \"Bar\", use:+-- In composite matches (queries), all clauses must be satisfied, which means+-- that each additional clause narrows the search. For example, to match+-- any song where the value of artist is \"Foo\" AND the value of album is+-- \"Bar\", we use: ----- > MultiQuery [Query Album "Foo", Query Artist "Bar"]-data Query = Query Meta String -- ^ Simple query.- | MultiQuery [Query] -- ^ Query with multiple conditions.+-- > [Match Artist "Foo", Match Album "Bar"]+--+-- By adding additional clauses we can narrow the search even more, but this+-- is usually not necessary.+data Match = Match Meta String -instance Show Query where- show (Query meta query) = show meta ++ " " ++ show query- show (MultiQuery xs) = show xs+instance Show Match where+ show (Match meta query) = show meta ++ " \"" ++ query ++ "\"" showList xs _ = unwords $ map show xs +-- | A query comprises a list of Match predicates+type Query = [Match]++instance MPDArg Query where+ prep = foldl (<++>) (Args []) . f+ where f = map (\(Match m q) -> Args [show m] <++> q)+ -- -- Admin commands -- -- | Turn off an output device. disableOutput :: Int -> MPD ()-disableOutput = getResponse_ . ("disableoutput " ++) . show+disableOutput = getResponse_ . ("disableoutput" <$>) -- | Turn on an output device. enableOutput :: Int -> MPD ()-enableOutput = getResponse_ . ("enableoutput " ++) . show+enableOutput = getResponse_ . ("enableoutput" <$>) -- | Retrieve information for all output devices. outputs :: MPD [Device]@@ -133,8 +178,8 @@ -- Unreadable or non-existent paths are silently ignored. update :: [Path] -> MPD () update [] = getResponse_ "update"-update [x] = getResponse_ ("update " ++ show x)-update xs = getResponses (map (("update " ++) . show) xs) >> return ()+update [x] = getResponse_ ("update" <$> x)+update xs = getResponses (map ("update" <$>) xs) >> return () -- -- Database commands@@ -142,9 +187,8 @@ -- | List all metadata of metadata (sic). list :: Meta -- ^ Metadata to list- -> Maybe Query -> MPD [String]-list mtype query = liftM takeValues (getResponse cmd)- where cmd = "list " ++ show mtype ++ maybe "" ((" "++) . show) query+ -> Query -> MPD [String]+list mtype query = liftM takeValues $ getResponse ("list" <$> mtype <++> query) -- | Non-recursively list the contents of a database directory. lsInfo :: Path -> MPD [Either Path Song]@@ -153,7 +197,7 @@ -- | List the songs (without metadata) in a database directory recursively. listAll :: Path -> MPD [Path] listAll path = liftM (map snd . filter ((== "file") . fst) . toAssoc)- (getResponse ("listall " ++ show path))+ (getResponse $ "listall" <$> path) -- | Recursive 'lsInfo'. listAllInfo :: Path -> MPD [Either Path Song]@@ -163,19 +207,19 @@ lsInfo' :: String -> Path -> MPD [Either Path Song] lsInfo' cmd path = do liftM (extractEntries (Just . Right, const Nothing, Just . Left)) $- takeEntries =<< getResponse (cmd ++ " " ++ show path)+ takeEntries =<< getResponse (cmd <$> path) -- | Search the database for entries exactly matching a query. find :: Query -> MPD [Song]-find query = getResponse ("find " ++ show query) >>= takeSongs+find query = getResponse ("find" <$> query) >>= takeSongs -- | Search the database using case insensitive matching. search :: Query -> MPD [Song]-search query = getResponse ("search " ++ show query) >>= takeSongs+search query = getResponse ("search" <$> query) >>= takeSongs -- | Count the number of entries matching a query. count :: Query -> MPD Count-count query = getResponse ("count " ++ show query) >>= runParser parseCount+count query = getResponse ("count" <$> query) >>= runParser parseCount -- -- Playlist commands@@ -187,7 +231,7 @@ -- This might do better to throw an exception than silently return 0. -- | Like 'add', but returns a playlist id. addId :: Path -> MPD Integer-addId p = getResponse1 ("addid " ++ show p) >>=+addId p = getResponse1 ("addid" <$> p) >>= parse parseNum id . snd . head . toAssoc -- | Like 'add_' but returns a list of the files added.@@ -198,66 +242,59 @@ -- Adds to current if no playlist is specified. -- Will create a new playlist if the one specified does not already exist. add_ :: PlaylistName -> Path -> MPD ()-add_ "" = getResponse_ . ("add " ++) . show-add_ plname = getResponse_ .- (("playlistadd " ++ show plname ++ " ") ++) . show+add_ "" path = getResponse_ ("add" <$> path)+add_ plname path = getResponse_ ("playlistadd" <$> plname <++> path) -- | Clear a playlist. Clears current playlist if no playlist is specified. -- If the specified playlist does not exist, it will be created. clear :: PlaylistName -> MPD ()-clear = getResponse_ . cmd- where cmd "" = "clear"- cmd pl = "playlistclear " ++ show pl+clear "" = getResponse_ "clear"+clear pl = getResponse_ ("playlistclear" <$> pl) -- | Remove a song from a playlist. -- If no playlist is specified, current playlist is used. -- Note that a playlist position ('Pos') is required when operating on -- playlists other than the current. delete :: PlaylistName -> PLIndex -> MPD ()-delete "" (Pos x) = getResponse_ ("delete " ++ show x)-delete "" (ID x) = getResponse_ ("deleteid " ++ show x)-delete plname (Pos x) =- getResponse_ ("playlistdelete " ++ show plname ++ " " ++ show x)+delete "" (Pos x) = getResponse_ ("delete" <$> x)+delete "" (ID x) = getResponse_ ("deleteid" <$> x)+delete plname (Pos x) = getResponse_ ("playlistdelete" <$> plname <++> x) delete _ _ = fail "'delete' within a playlist doesn't accept a playlist ID" -- | Load an existing playlist. load :: PlaylistName -> MPD ()-load = getResponse_ . ("load " ++) . show+load plname = getResponse_ ("load" <$> plname) -- | Move a song to a given position. -- Note that a playlist position ('Pos') is required when operating on -- playlists other than the current. move :: PlaylistName -> PLIndex -> Integer -> MPD ()-move "" (Pos from) to =- getResponse_ ("move " ++ show from ++ " " ++ show to)-move "" (ID from) to =- getResponse_ ("moveid " ++ show from ++ " " ++ show to)+move "" (Pos from) to = getResponse_ ("move" <$> from <++> to)+move "" (ID from) to = getResponse_ ("moveid" <$> from <++> to) move plname (Pos from) to =- getResponse_ ("playlistmove " ++ show plname ++ " " ++ show from ++- " " ++ show to)+ getResponse_ ("playlistmove" <$> plname <++> from <++> to) move _ _ _ = fail "'move' within a playlist doesn't accept a playlist ID" -- | Delete existing playlist. rm :: PlaylistName -> MPD ()-rm = getResponse_ . ("rm " ++) . show+rm plname = getResponse_ ("rm" <$> plname) -- | Rename an existing playlist. rename :: PlaylistName -- ^ Original playlist -> PlaylistName -- ^ New playlist name -> MPD ()-rename plname new =- getResponse_ ("rename " ++ show plname ++ " " ++ show new)+rename plname new = getResponse_ ("rename" <$> plname <++> new) -- | Save the current playlist. save :: PlaylistName -> MPD ()-save = getResponse_ . ("save " ++) . show+save plname = getResponse_ ("save" <$> plname) -- | Swap the positions of two songs. -- Note that the positions must be of the same type, i.e. mixing 'Pos' and 'ID' -- will result in a no-op. swap :: PLIndex -> PLIndex -> MPD ()-swap (Pos x) (Pos y) = getResponse_ ("swap " ++ show x ++ " " ++ show y)-swap (ID x) (ID y) = getResponse_ ("swapid " ++ show x ++ " " ++ show y)+swap (Pos x) (Pos y) = getResponse_ ("swap" <$> x <++> y)+swap (ID x) (ID y) = getResponse_ ("swapid" <$> x <++> y) swap _ _ = fail "'swap' cannot mix position and ID arguments" -- | Shuffle the playlist.@@ -268,18 +305,19 @@ playlistInfo :: Maybe PLIndex -> MPD [Song] playlistInfo x = getResponse cmd >>= takeSongs where cmd = case x of- Just (Pos x') -> "playlistinfo " ++ show x'- Just (ID x') -> "playlistid " ++ show x'+ Just (Pos x') -> "playlistinfo" <$> x'+ Just (ID x') -> "playlistid" <$> x' Nothing -> "playlistinfo" -- | Retrieve metadata for files in a given playlist. listPlaylistInfo :: PlaylistName -> MPD [Song] listPlaylistInfo plname =- takeSongs =<< (getResponse . ("listplaylistinfo " ++) $ show plname)+ takeSongs =<< getResponse ("listplaylistinfo" <$> plname) -- | Retrieve a list of files in a given playlist. listPlaylist :: PlaylistName -> MPD [Path]-listPlaylist = liftM takeValues . getResponse . ("listplaylist " ++) . show+listPlaylist plname =+ liftM takeValues $ getResponse ("listplaylist" <$> plname) -- | Retrieve file paths and positions of songs in the current playlist. -- Note that this command is only included for completeness sake; it's@@ -295,13 +333,12 @@ -- | Retrieve a list of changed songs currently in the playlist since -- a given playlist version. plChanges :: Integer -> MPD [Song]-plChanges version =- takeSongs =<< (getResponse . ("plchanges " ++) $ show version)+plChanges version = takeSongs =<< getResponse ("plchanges" <$> version) -- | Like 'plChanges' but only returns positions and ids. plChangesPosId :: Integer -> MPD [(PLIndex, PLIndex)] plChangesPosId plver =- getResponse ("plchangesposid " ++ show plver) >>=+ getResponse ("plchangesposid" <$> plver) >>= mapM f . splitGroups [("cpos",id)] . toAssoc where f xs | [("cpos", x), ("Id", y)] <- xs , Just (x', y') <- pair parseNum (x, y)@@ -310,13 +347,12 @@ -- | Search for songs in the current playlist with strict matching. playlistFind :: Query -> MPD [Song]-playlistFind q = takeSongs =<< (getResponse . ("playlistfind " ++) $ show q)+playlistFind q = takeSongs =<< getResponse ("playlistfind" <$> q) -- | Search case-insensitively with partial matches for songs in the -- current playlist. playlistSearch :: Query -> MPD [Song]-playlistSearch q =- takeSongs =<< (getResponse . ("playlistsearch " ++) $ show q)+playlistSearch q = takeSongs =<< getResponse ("playlistsearch" <$> q) -- | Get the currently playing song. currentSong :: MPD (Maybe Song)@@ -333,17 +369,17 @@ -- | Set crossfading between songs. crossfade :: Seconds -> MPD ()-crossfade = getResponse_ . ("crossfade " ++) . show+crossfade secs = getResponse_ ("crossfade" <$> secs) -- | Begin\/continue playing. play :: Maybe PLIndex -> MPD ()-play Nothing = getResponse_ "play"-play (Just (Pos x)) = getResponse_ ("play " ++ show x)-play (Just (ID x)) = getResponse_ ("playid " ++ show x)+play Nothing = getResponse_ "play"+play (Just (Pos x)) = getResponse_ ("play" <$> x)+play (Just (ID x)) = getResponse_ ("playid" <$> x) -- | Pause playing. pause :: Bool -> MPD ()-pause = getResponse_ . ("pause " ++) . showBool+pause = getResponse_ . ("pause" <$>) -- | Stop playing. stop :: MPD ()@@ -360,25 +396,23 @@ -- | Seek to some point in a song. -- Seeks in current song if no position is given. seek :: Maybe PLIndex -> Seconds -> MPD ()-seek (Just (Pos x)) time =- getResponse_ ("seek " ++ show x ++ " " ++ show time)-seek (Just (ID x)) time =- getResponse_ ("seekid " ++ show x ++ " " ++ show time)+seek (Just (Pos x)) time = getResponse_ ("seek" <$> x <++> time)+seek (Just (ID x)) time = getResponse_ ("seekid" <$> x <++> time) seek Nothing time = do st <- status unless (stState st == Stopped) (seek (stSongID st) time) -- | Set random playing. random :: Bool -> MPD ()-random = getResponse_ . ("random " ++) . showBool+random = getResponse_ . ("random" <$>) -- | Set repeating. repeat :: Bool -> MPD ()-repeat = getResponse_ . ("repeat " ++) . showBool+repeat = getResponse_ . ("repeat" <$>) -- | Set the volume (0-100 percent). setVolume :: Int -> MPD ()-setVolume = getResponse_ . ("setvol " ++) . show+setVolume = getResponse_ . ("setvol" <$>) -- | Increase or decrease volume by a given percent, e.g. -- 'volume 10' will increase the volume by 10 percent, while@@ -386,7 +420,7 @@ -- Note that this command is only included for completeness sake ; it's -- deprecated and may disappear at any time, please use 'setVolume' instead. volume :: Int -> MPD ()-volume = getResponse_ . ("volume " ++) . show+volume = getResponse_ . ("volume" <$>) -- -- Miscellaneous commands@@ -412,7 +446,7 @@ urlHandlers :: MPD [String] urlHandlers = liftM takeValues (getResponse "urlhandlers") --- XXX should the password be quoted?+-- XXX should the password be quoted? Change "++" to "<$>" if so. -- | Send password to server to authenticate session. -- Password is sent as plain text. password :: String -> MPD ()@@ -437,10 +471,10 @@ -- | Like 'update', but returns the update job id. updateId :: [Path] -> MPD Integer updateId paths = liftM (read . head . takeValues) cmd- where cmd = case map show paths of- [] -> getResponse "update"- [x] -> getResponse ("update " ++ x)- xs -> getResponses (map ("update " ++) xs)+ where cmd = case paths of+ [] -> getResponse "update"+ [x] -> getResponse ("update" <$> x)+ xs -> getResponses $ map ("update" <$>) xs -- | Toggles play\/pause. Plays if stopped. toggle :: MPD ()@@ -452,9 +486,10 @@ addMany :: PlaylistName -> [Path] -> MPD () addMany _ [] = return () addMany plname [x] = add_ plname x-addMany plname xs = getResponses (map ((cmd ++) . show) xs) >> return ()- where cmd = case plname of "" -> "add "- pl -> "playlistadd " ++ show pl ++ " "+addMany plname xs = getResponses (map cmd xs) >> return ()+ where cmd x = case plname of+ "" -> "add" <$> x+ pl -> "playlistadd" <$> pl <++> x -- | Delete a list of songs from a playlist. -- If there is a duplicate then no further songs will be deleted, so@@ -463,10 +498,10 @@ deleteMany _ [] = return () deleteMany plname [x] = delete plname x deleteMany "" xs = getResponses (map cmd xs) >> return ()- where cmd (Pos x) = "delete " ++ show x- cmd (ID x) = "deleteid " ++ show x+ where cmd (Pos x) = "delete" <$> x+ cmd (ID x) = "deleteid" <$> x deleteMany plname xs = getResponses (map cmd xs) >> return ()- where cmd (Pos x) = "playlistdelete " ++ show plname ++ " " ++ show x+ where cmd (Pos x) = "playlistdelete" <$> plname <++> x cmd _ = "" -- | Returns all songs and directories that match the given partial@@ -494,7 +529,7 @@ -- ensure that no songs are deleted twice with 'max'. ys = case y of Just (Pos p) -> drop (max (fromInteger p) x') pl Just (ID i) -> maybe [] (flip drop pl . max x' . (+1))- (findByID i pl)+ (findByID i pl) Nothing -> [] deleteMany "" . mapMaybe sgIndex $ take x' pl ++ ys where findByID i = findIndex ((==) i . (\(ID j) -> j) . fromJust . sgIndex)@@ -510,38 +545,38 @@ playlistInfo Nothing where dups [] (_, dup) = dup dups (x:xs) (ys, dup)- | x `elem` xs && x `notElem` ys = dups xs (ys, x:dup)- | otherwise = dups xs (x:ys, dup)+ | x `mSong` xs && not (x `mSong` ys) = dups xs (ys, x:dup)+ | otherwise = dups xs (x:ys, dup)+ mSong x = let m = sgFilePath x in any ((==) m . sgFilePath) -- | List directories non-recursively. lsDirs :: Path -> MPD [Path] lsDirs path = liftM (extractEntries (const Nothing,const Nothing, Just)) $- takeEntries =<< getResponse ("lsinfo " ++ show path)+ takeEntries =<< getResponse ("lsinfo" <$> path) -- | List files non-recursively. lsFiles :: Path -> MPD [Path] lsFiles path = liftM (extractEntries (Just . sgFilePath, const Nothing, const Nothing)) $- takeEntries =<< getResponse ("lsinfo " ++ show path)+ takeEntries =<< getResponse ("lsinfo" <$> path) -- | List all playlists. lsPlaylists :: MPD [PlaylistName]-lsPlaylists =- liftM (extractEntries (const Nothing, Just, const Nothing)) $- takeEntries =<< getResponse "lsinfo"+lsPlaylists = liftM (extractEntries (const Nothing, Just, const Nothing)) $+ takeEntries =<< getResponse "lsinfo" -- | Search the database for songs relating to an artist. findArtist :: Artist -> MPD [Song]-findArtist = find . Query Artist+findArtist x = find [Match Artist x] -- | Search the database for songs relating to an album. findAlbum :: Album -> MPD [Song]-findAlbum = find . Query Album+findAlbum x = find [Match Album x] -- | Search the database for songs relating to a song title. findTitle :: Title -> MPD [Song]-findTitle = find . Query Title+findTitle x = find [Match Title x] -- | List the artists in the database. listArtists :: MPD [Artist]@@ -550,25 +585,24 @@ -- | List the albums in the database, optionally matching a given -- artist. listAlbums :: Maybe Artist -> MPD [Album]-listAlbums artist = liftM takeValues (getResponse ("list album" ++- maybe "" ((" artist " ++) . show) artist))+listAlbums artist = liftM takeValues $+ getResponse ("list album" <$> fmap ("artist" <++>) artist) -- | List the songs in an album of some artist. listAlbum :: Artist -> Album -> MPD [Song]-listAlbum artist album = find (MultiQuery [Query Artist artist- ,Query Album album])+listAlbum artist album = find [Match Artist artist, Match Album album] -- | Search the database for songs relating to an artist using 'search'. searchArtist :: Artist -> MPD [Song]-searchArtist = search . Query Artist+searchArtist x = search [Match Artist x] -- | Search the database for songs relating to an album using 'search'. searchAlbum :: Album -> MPD [Song]-searchAlbum = search . Query Album+searchAlbum x = search [Match Album x] -- | Search the database for songs relating to a song title. searchTitle :: Title -> MPD [Song]-searchTitle = search . Query Title+searchTitle x = search [Match Title x] -- | Retrieve the current playlist. -- Equivalent to @playlistinfo Nothing@.
Network/MPD/Core.hs view
@@ -1,26 +1,8 @@ {-# LANGUAGE MultiParamTypeClasses #-}-{-- libmpd for Haskell, an MPD client library.- Copyright (C) 2005-2008 Ben Sinclair <bsinclai@turing.une.edu.au> - This library is free software; you can redistribute it and/or- modify it under the terms of the GNU Lesser General Public- License as published by the Free Software Foundation; either- version 2.1 of the License, or (at your option) any later version.-- This library is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU- Lesser General Public License for more details.-- You should have received a copy of the GNU Lesser General Public- License along with this library; if not, write to the Free Software- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA--}- -- | Module : Network.MPD.Core -- Copyright : (c) Ben Sinclair 2005-2008--- License : LGPL+-- License : LGPL (see LICENSE) -- Maintainer : bsinclai@turing.une.edu.au -- Stability : alpha -- Portability : not Haskell 98 (uses MultiParamTypeClasses)@@ -172,6 +154,7 @@ | otherwise = Right $ takeWhile ("OK" /=) xs where xs = lines s +-- Turn MPD ACK into the corresponding 'MPDError' parseAck :: String -> MPDError parseAck s = ACK ack msg where
Network/MPD/Parse.hs view
@@ -1,25 +1,6 @@-{-- libmpd for Haskell, an MPD client library.- Copyright (C) 2005-2008 Ben Sinclair <bsinclai@turing.une.edu.au>-- This library is free software; you can redistribute it and/or- modify it under the terms of the GNU Lesser General Public- License as published by the Free Software Foundation; either- version 2.1 of the License, or (at your option) any later version.-- This library is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU- Lesser General Public License for more details.-- You should have received a copy of the GNU Lesser General Public- License along with this library; if not, write to the Free Software- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA--}- -- | Module : Network.MPD.Parse -- Copyright : (c) Ben Sinclair 2005-2008--- License : LGPL+-- License : LGPL (see LICENSE) -- Maintainer : bsinclai@turing.une.edu.au -- Stability : alpha -- Portability : Haskell 98@@ -28,31 +9,12 @@ module Network.MPD.Parse where +import Network.MPD.Types+ import Control.Monad.Error import Network.MPD.Utils import Network.MPD.Core (MPD, MPDError(Unexpected)) -type Seconds = Integer---- | Represents a song's playlist index.-data PLIndex = Pos Integer -- ^ A playlist position index (starting from 0)- | ID Integer -- ^ A playlist ID number that more robustly- -- identifies a song.- deriving (Show, Eq)---- | Represents the different playback states.-data State = Playing- | Stopped- | Paused- deriving (Show, Eq)---- | Represents the result of running 'count'.-data Count =- Count { cSongs :: Integer -- ^ Number of songs matching the query- , cPlaytime :: Seconds -- ^ Total play time of matching songs- }- deriving (Eq, Show)- -- | Builds a 'Count' instance from an assoc. list. parseCount :: [String] -> Either String Count parseCount = foldM f empty . toAssoc@@ -63,14 +25,6 @@ f _ x = Left $ show x empty = Count { cSongs = 0, cPlaytime = 0 } --- | Represents an output device.-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)- -- | Builds a list of 'Device' instances from an assoc. list parseOutputs :: [String] -> Either String [Device] parseOutputs = mapM (foldM f empty) . splitGroups [("outputid",id)] . toAssoc@@ -81,19 +35,6 @@ f _ x = fail $ show x empty = Device 0 "" False --- | Container for database statistics.-data Stats =- Stats { stsArtists :: Integer -- ^ Number of artists.- , stsAlbums :: Integer -- ^ Number of albums.- , stsSongs :: Integer -- ^ Number of songs.- , stsUptime :: Seconds -- ^ Daemon uptime in seconds.- , stsPlaytime :: Seconds -- ^ Total playing time.- , stsDbPlaytime :: Seconds -- ^ Total play time of all the songs in- -- the database.- , stsDbUpdate :: Integer -- ^ Last database update in UNIX time.- }- deriving (Eq, Show)- -- | Builds a 'Stats' instance from an assoc. list. parseStats :: [String] -> Either String Stats parseStats = foldM f defaultStats . toAssoc@@ -111,21 +52,7 @@ Stats { stsArtists = 0, stsAlbums = 0, stsSongs = 0, stsUptime = 0 , stsPlaytime = 0, stsDbPlaytime = 0, stsDbUpdate = 0 } --- | Represents a single song item.-data Song =- Song { sgArtist, sgAlbum, sgTitle, sgFilePath, sgGenre, sgName, sgComposer- , sgPerformer :: String- , sgLength :: Seconds -- ^ Length in seconds- , sgDate :: Int -- ^ Year- , sgTrack :: (Int, Int) -- ^ Track number\/total tracks- , sgDisc :: (Int, Int) -- ^ Position in set\/total in set- , sgIndex :: Maybe PLIndex }- deriving Show --- Avoid the need for writing a proper 'elem' for use in 'prune'.-instance Eq Song where- (==) x y = sgFilePath x == sgFilePath y- -- | Builds a 'Song' instance from an assoc. list. parseSong :: [(String, String)] -> Either String Song parseSong xs = foldM f song xs@@ -166,37 +93,6 @@ , sgPerformer = "", sgDate = 0, sgTrack = (0,0) , sgDisc = (0,0), sgFilePath = "", sgLength = 0 , sgIndex = Nothing }---- | Container for MPD status.-data Status =- Status { stState :: State- -- | A percentage (0-100)- , stVolume :: Int- , stRepeat :: Bool- , stRandom :: Bool- -- | A value that is incremented by the server every time the- -- playlist changes.- , stPlaylistVersion :: Integer- -- | The number of items in the current playlist.- , stPlaylistLength :: Integer- -- | Current song's position in the playlist.- , stSongPos :: Maybe PLIndex- -- | Current song's playlist ID.- , stSongID :: Maybe PLIndex- -- | Time elapsed\/total time.- , stTime :: (Seconds, Seconds)- -- | Bitrate (in kilobytes per second) of playing song (if any).- , stBitrate :: Int- -- | Crossfade time.- , stXFadeWidth :: Seconds- -- | Samplerate\/bits\/channels for the chosen output device- -- (see mpd.conf).- , stAudio :: (Int, Int, Int)- -- | Job ID of currently running update (if any).- , stUpdatingDb :: Integer- -- | Last error message (if any).- , stError :: String }- deriving (Eq, Show) -- | Builds a 'Status' instance from an assoc. list. parseStatus :: [String] -> Either String Status
Network/MPD/SocketConn.hs view
@@ -1,25 +1,6 @@-{-- libmpd for Haskell, an MPD client library.- Copyright (C) 2005-2008 Ben Sinclair <bsinclai@turing.une.edu.au>-- This library is free software; you can redistribute it and/or- modify it under the terms of the GNU Lesser General Public- License as published by the Free Software Foundation; either- version 2.1 of the License, or (at your option) any later version.-- This library is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU- Lesser General Public License for more details.-- You should have received a copy of the GNU Lesser General Public- License along with this library; if not, write to the Free Software- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA--}- -- | Module : Network.MPD.SocketConn -- Copyright : (c) Ben Sinclair 2005-2008--- License : LGPL+-- License : LGPL (see LICENSE) -- Maintainer : bsinclai@turing.une.edu.au -- Stability : alpha -- Portability : Haskell 98@@ -36,6 +17,7 @@ import Data.List (isPrefixOf) import System.IO.Error (isEOFError) import Control.Exception (finally)+import qualified System.IO.UTF8 as U -- | Run an MPD action against a server. withMPDEx :: String -- ^ Host name.@@ -68,11 +50,11 @@ case hM of Nothing -> return $ Left NoMPD Just h -> do- unless (null str) (hPutStrLn h str >> hFlush h)+ unless (null str) (U.hPutStrLn h str >> hFlush h) getLines h [] `catch` whenEOF (Left TimedOut) where getLines handle acc = do- l <- hGetLine handle+ l <- U.hGetLine handle if "OK" `isPrefixOf` l || "ACK" `isPrefixOf` l then return . Right . unlines . reverse $ l:acc else getLines handle (l:acc)
− Network/MPD/StringConn.hs
@@ -1,80 +0,0 @@-{-- libmpd for Haskell, an MPD client library.- Copyright (C) 2005-2008 Ben Sinclair <bsinclai@turing.une.edu.au>-- This library is free software; you can redistribute it and/or- modify it under the terms of the GNU Lesser General Public- License as published by the Free Software Foundation; either- version 2.1 of the License, or (at your option) any later version.-- This library is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU- Lesser General Public License for more details.-- You should have received a copy of the GNU Lesser General Public- License along with this library; if not, write to the Free Software- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA--}---- | Module : Network.MPD.StringConn--- Copyright : (c) Ben Sinclair 2005-2008--- License : LGPL--- Maintainer : bsinclai@turing.une.edu.au--- Stability : alpha--- Portability : Haskell 98------ Connection over a network socket.--module Network.MPD.StringConn (Expect, Result(..), testMPD) where--import Control.Monad (liftM)-import Prelude hiding (exp)-import Network.MPD.Core-import Data.IORef---- | An expected request.-type Expect = String--data Result a = Ok | Failure (Response a) [(Expect,String)]- deriving Show---- | Run an action against a set of expected requests and responses,--- and an expected result. The result is Nothing if everything matched--- what was expected. If anything differed the result of the--- computation is returned along with pairs of expected and received--- requests.-testMPD :: (Eq a)- => [(Expect, Response String)] -- ^ The expected requests and their- -- ^ corresponding responses.- -> Response a -- ^ The expected result.- -> IO (Maybe String) -- ^ An action that supplies passwords.- -> MPD a -- ^ The MPD action to run.- -> IO (Result a)-testMPD pairs expected getpw m = do- expectsRef <- newIORef pairs- mismatchesRef <- newIORef ([] :: [(Expect, String)])- let open' = return ()- close' = return ()- send' = send expectsRef mismatchesRef- result <- runMPD m $ Conn open' close' send' getpw- mismatches <- liftM reverse $ readIORef mismatchesRef- return $ if null mismatches && result == expected- then Ok- else Failure result mismatches--send :: IORef [(Expect, Response String)] -- Expected requests and their- -- responses.- -> IORef [(Expect, String)] -- An initially empty list of- -- mismatches between expected and- -- actual requests.- -> String- -> IO (Response String)-send expsR mmsR str = do- xs <- readIORef expsR- case xs of- ((exp,resp):_) | exp == str -> modifyIORef expsR (drop 1) >> return resp- | otherwise -> addMismatch exp- [] -> addMismatch ""- where- addMismatch exp = modifyIORef mmsR ((exp,str):) >> return (Left NoMPD)
+ Network/MPD/Types.hs view
@@ -0,0 +1,94 @@+-- | Module : Network.MPD.Types+-- Copyright : (c) Ben Sinclair 2005-2008+-- License : LGPL (see LICENSE)+-- Maintainer : bsinclai@turing.une.edu.au+-- Stability : alpha+-- Portability : Haskell 98+--+-- Various MPD data structures and types++module Network.MPD.Types where++type Seconds = Integer++-- | Represents a song's playlist index.+data PLIndex = Pos Integer -- ^ A playlist position index (starting from 0)+ | ID Integer -- ^ A playlist ID number that more robustly+ -- identifies a song.+ deriving (Show, Eq)++-- | Represents the different playback states.+data State = Playing+ | Stopped+ | Paused+ deriving (Show, Eq)++-- | Represents the result of running 'count'.+data Count =+ Count { cSongs :: Integer -- ^ Number of songs matching the query+ , cPlaytime :: Seconds -- ^ Total play time of matching songs+ }+ deriving (Eq, Show)++-- | Represents an output device.+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)++-- | Container for database statistics.+data Stats =+ Stats { stsArtists :: Integer -- ^ Number of artists.+ , stsAlbums :: Integer -- ^ Number of albums.+ , stsSongs :: Integer -- ^ Number of songs.+ , stsUptime :: Seconds -- ^ Daemon uptime in seconds.+ , stsPlaytime :: Seconds -- ^ Total playing time.+ , stsDbPlaytime :: Seconds -- ^ Total play time of all the songs in+ -- the database.+ , stsDbUpdate :: Integer -- ^ Last database update in UNIX time.+ }+ deriving (Eq, Show)++-- | Represents a single song item.+data Song =+ Song { sgArtist, sgAlbum, sgTitle, sgFilePath, sgGenre, sgName, sgComposer+ , sgPerformer :: String+ , sgLength :: Seconds -- ^ Length in seconds+ , sgDate :: Int -- ^ Year+ , sgTrack :: (Int, Int) -- ^ Track number\/total tracks+ , sgDisc :: (Int, Int) -- ^ Position in set\/total in set+ , sgIndex :: Maybe PLIndex }+ deriving (Eq, Show)++-- | Container for MPD status.+data Status =+ Status { stState :: State+ -- | A percentage (0-100)+ , stVolume :: Int+ , stRepeat :: Bool+ , stRandom :: Bool+ -- | A value that is incremented by the server every time the+ -- playlist changes.+ , stPlaylistVersion :: Integer+ -- | The number of items in the current playlist.+ , stPlaylistLength :: Integer+ -- | Current song's position in the playlist.+ , stSongPos :: Maybe PLIndex+ -- | Current song's playlist ID.+ , stSongID :: Maybe PLIndex+ -- | Time elapsed\/total time.+ , stTime :: (Seconds, Seconds)+ -- | Bitrate (in kilobytes per second) of playing song (if any).+ , stBitrate :: Int+ -- | Crossfade time.+ , stXFadeWidth :: Seconds+ -- | Samplerate\/bits\/channels for the chosen output device+ -- (see mpd.conf).+ , stAudio :: (Int, Int, Int)+ -- | Job ID of currently running update (if any).+ , stUpdatingDb :: Integer+ -- | Last error message (if any).+ , stError :: String }+ deriving (Eq, Show)
Network/MPD/Utils.hs view
@@ -1,25 +1,6 @@-{-- libmpd for Haskell, an MPD client library.- Copyright (C) 2005-2008 Ben Sinclair <bsinclai@turing.une.edu.au>-- This library is free software; you can redistribute it and/or- modify it under the terms of the GNU Lesser General Public- License as published by the Free Software Foundation; either- version 2.1 of the License, or (at your option) any later version.-- This library is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU- Lesser General Public License for more details.-- You should have received a copy of the GNU Lesser General Public- License along with this library; if not, write to the Free Software- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA--}- -- | Module : Network.MPD.Utils -- Copyright : (c) Ben Sinclair 2005-2008--- License : LGPL+-- License : LGPL (see LICENSE) -- Maintainer : bsinclai@turing.une.edu.au -- Stability : alpha -- Portability : Haskell 98@@ -33,7 +14,7 @@ import Data.Char (isDigit) --- Break a string a character, removing the separator.+-- Break a string by character, removing the separator. breakChar :: Char -> String -> (String, String) breakChar c s = let (x, y) = break (== c) s in (x, drop 1 y)
Setup.lhs view
@@ -1,5 +1,3 @@ #!/usr/bin/env runhaskell-> module Main where > import Distribution.Simple-> main :: IO () > main = defaultMain
libmpd.cabal view
@@ -1,5 +1,5 @@ Name: libmpd-Version: 0.2.1+Version: 0.3.0 License: LGPL License-file: LICENSE Copyright: Ben Sinclair 2005-2008@@ -20,11 +20,11 @@ Library Build-Depends: base >= 2.1.1, network >= 2.0.1, mtl >= 1.0.1,- filepath >= 1.0+ filepath >= 1.0, utf8-string >= 0.3.1 Exposed-Modules: Network.MPD Other-Modules: Network.MPD.Core, Network.MPD.Commands, Network.MPD.Parse, Network.MPD.SocketConn,- Network.MPD.StringConn, Network.MPD.Utils+ Network.MPD.Types, Network.MPD.Utils ghc-options: -Wall ghc-prof-options: -auto-all -prof
tests/Commands.hs view
@@ -14,7 +14,7 @@ import Displayable import Network.MPD.Commands import Network.MPD.Core (Response, MPDError(..))-import Network.MPD.StringConn+import StringConn import Control.Monad import Prelude hiding (repeat)@@ -146,14 +146,14 @@ testFind = test [("find Artist \"Foo\"", Right resp)] (Right [obj])- (find (Query Artist "Foo"))+ (find [Match Artist "Foo"]) where obj = empty { sgArtist = "Foo", sgTitle = "Bar" , sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60 } resp = display obj ++ "OK" testFindComplex = test [("find Artist \"Foo\" Album \"Bar\"", Right resp)] (Right [obj])- (find $ MultiQuery [Query Artist "Foo", Query Album "Bar"])+ (find [Match Artist "Foo", Match Album "Bar"]) where obj = empty { sgFilePath = "dir/Foo/Bar/Baz.ogg", sgArtist = "Foo" , sgAlbum = "Bar", sgTitle = "Baz" } resp = display obj ++ "OK"@@ -161,12 +161,12 @@ testListNothing = test [("list Title", Right "Title: Foo\nTitle: Bar\nOK")] (Right ["Foo", "Bar"])- (list Title Nothing)+ (list Title []) testListJust = test [("list Title Artist \"Muzz\"", Right "Title: Foo\nOK")] (Right ["Foo"])- (list Title (Just $ Query Artist "Muzz"))+ (list Title [Match Artist "Muzz"]) testListAll = test [("listall \"\"", Right "directory: FooBand\n\@@ -189,14 +189,14 @@ testSearch = test [("search Artist \"oo\"", Right resp)] (Right [obj])- (search (Query Artist "oo"))+ (search [Match 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)- (count (Query Title "Foo"))+ (count [Match Title "Foo"]) where obj = Count 1 60 resp = display obj ++ "OK" @@ -335,13 +335,13 @@ testPlaylistFind = test [("playlistfind Artist \"Foo\"", Right resp)] (Right [obj])- (playlistFind $ Query Artist "Foo")+ (playlistFind [Match 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 $ Query Artist "Foo")+ (playlistSearch [Match Artist "Foo"]) where obj = empty { sgFilePath = "dir/Foo/Bar.ogg", sgArtist = "Foo" } resp = display obj ++ "OK"
tests/Displayable.hs view
@@ -1,7 +1,7 @@ module Displayable (Displayable(..)) where import Network.MPD.Utils-import Network.MPD.Parse+import Network.MPD.Types -- | A uniform interface for types that -- can be turned into raw responses
tests/Properties.hs view
@@ -1,8 +1,11 @@ {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-methods #-} module Properties (main) where+ import Displayable-import Network.MPD.Utils+ import Network.MPD.Parse+import Network.MPD.Types+import Network.MPD.Utils import Control.Monad import Data.Char