Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
  • 11 commits
  • 6 files changed
  • 0 commit comments
  • 1 contributor
Commits on Apr 25, 2012
@joachifm joachifm N.M.Util: use attoparsec behind the scenes
This is part of a slow migration to attoparsec for parsing.
As of now, all type signatures remain the same, while attoparsec
is used behind the scenes.
4acd966
@joachifm joachifm N.M.Util (parseMaybe): ensure that all input is consumed ed5393a
Commits on Apr 29, 2012
@joachifm joachifm Merge branch 'sol-master' 3723a10
@joachifm joachifm parseDate: handle complex dates
Take the year, discard the rest
3b14307
Commits on Apr 30, 2012
@joachifm joachifm Merge branch 'dev/attoparsec' 8b91a39
Commits on May 01, 2012
@joachifm joachifm Fix issue 36: rename add_ to add, move current add to extensions
The old add has been moved to Network.MPD.Commands.Extensions.addList.
It might get removed at a later date.

See https://github.com/joachifm/libmpd-haskell/issues/36
7eaa36b
@joachifm joachifm Rename playlistAdd_ to playlistAdd, move old version to extensions
Old version has been moved to Network.MPD.Commands.Extensions.playlistAddList.
8d4ed03
@joachifm joachifm Merge branch 'dev/move-add' into next 9aa048c
@joachifm joachifm Rename N.M.C.Args.<$> to <@>
To avoid confusion with Control.Applicative.<$>
4a168c5
@joachifm joachifm Merge branch 'dev/rename-at-operator' into integ-move-add-rename-at-o…
…perator

Conflicts:
	Network/MPD/Commands.hs
cf511f6
@joachifm joachifm Merge branch 'integ-move-add-rename-at-operator' 1fdce3b
View
126 Network/MPD/Commands.hs
@@ -26,13 +26,13 @@ module Network.MPD.Commands (
next, pause, play, playId, previous, seek, seekId, stop,
-- * The current playlist
- add, add_, addId, clear, delete, deleteId, move, moveId, playlist, playlistId,
+ add, addId, clear, delete, deleteId, move, moveId, playlist, playlistId,
playlistFind, playlistInfo, playlistSearch, plChanges, plChangesPosId, shuffle, swap,
swapId,
-- * Stored playlist
- listPlaylist, listPlaylistInfo, listPlaylists, load, playlistAdd,
- playlistAdd_, playlistClear, playlistDelete, playlistMove, rename, rm,
+ listPlaylist, listPlaylistInfo, listPlaylists, load,
+ playlistAdd, playlistClear, playlistDelete, playlistMove, rename, rm,
save,
-- * The music database
@@ -91,7 +91,7 @@ currentSong = getResponse "currentsong" >>= runParser parseMaybeSong . toAssocLi
-- cancelled by 'noidle'.
idle :: MonadMPD m => [Subsystem] -> m [Subsystem]
idle subsystems =
- mapM f =<< toAssocList `liftM` getResponse ("idle" <$> foldr (<++>) (Args []) subsystems)
+ mapM f =<< toAssocList `liftM` getResponse ("idle" <@> foldr (<++>) (Args []) subsystems)
where
f ("changed", system) =
case system of
@@ -124,31 +124,31 @@ status = getResponse "status" >>= runParser parseStatus
-- | Set consume mode
consume :: MonadMPD m => Bool -> m ()
-consume = getResponse_ . ("consume" <$>)
+consume = getResponse_ . ("consume" <@>)
-- | Set crossfading between songs.
crossfade :: MonadMPD m => Seconds -> m ()
-crossfade secs = getResponse_ ("crossfade" <$> secs)
+crossfade secs = getResponse_ ("crossfade" <@> secs)
-- | Set random playing.
random :: MonadMPD m => Bool -> m ()
-random = getResponse_ . ("random" <$>)
+random = getResponse_ . ("random" <@>)
-- | Set repeating.
repeat :: MonadMPD m => Bool -> m ()
-repeat = getResponse_ . ("repeat" <$>)
+repeat = getResponse_ . ("repeat" <@>)
-- | Set the volume (0-100 percent).
setVolume :: MonadMPD m => Int -> m ()
-setVolume = getResponse_ . ("setvol" <$>)
+setVolume = getResponse_ . ("setvol" <@>)
-- | Set single mode
single :: MonadMPD m => Bool -> m ()
-single = getResponse_ . ("single" <$>)
+single = getResponse_ . ("single" <@>)
-- | Set the replay gain mode.
replayGainMode :: MonadMPD m => ReplayGainMode -> m ()
-replayGainMode = getResponse_ . ("replay_gain_mode" <$>)
+replayGainMode = getResponse_ . ("replay_gain_mode" <@>)
-- | Get the replay gain options.
replayGainStatus :: MonadMPD m => m [String]
@@ -164,16 +164,16 @@ next = getResponse_ "next"
-- | Pause playing.
pause :: MonadMPD m => Bool -> m ()
-pause = getResponse_ . ("pause" <$>)
+pause = getResponse_ . ("pause" <@>)
-- | Begin\/continue playing.
play :: MonadMPD m => Maybe Int -> m ()
-play (Just pos) = getResponse_ ("play" <$> pos)
+play (Just pos) = getResponse_ ("play" <@> pos)
play _ = getResponse_ "play"
-- | Play a file with given id.
playId :: MonadMPD m => Id -> m ()
-playId id' = getResponse_ ("playid" <$> id')
+playId id' = getResponse_ ("playid" <@> id')
-- | Play the previous song.
previous :: MonadMPD m => m ()
@@ -181,11 +181,11 @@ previous = getResponse_ "previous"
-- | Seek to some point in a song.
seek :: MonadMPD m => Int -> Seconds -> m ()
-seek pos time = getResponse_ ("seek" <$> pos <++> time)
+seek pos time = getResponse_ ("seek" <@> pos <++> time)
-- | Seek to some point in a song (id version)
seekId :: MonadMPD m => Id -> Seconds -> m ()
-seekId id' time = getResponse_ ("seekid" <$> id' <++> time)
+seekId id' time = getResponse_ ("seekid" <@> id' <++> time)
-- | Stop playing.
stop :: MonadMPD m => m ()
@@ -200,15 +200,11 @@ stop = getResponse_ "stop"
addId :: MonadMPD m => Path -> Maybe Integer -- ^ Optional playlist position
-> m Id
addId p pos = liftM (parse parseNum Id (Id 0) . snd . head . toAssocList)
- $ getResponse1 ("addid" <$> p <++> pos)
-
--- | Like 'add_' but returns a list of the files added.
-add :: MonadMPD m => Path -> m [Path]
-add x = add_ x >> listAll x
+ $ getResponse1 ("addid" <@> p <++> pos)
-- | Add a song (or a whole directory) to the current playlist.
-add_ :: MonadMPD m => Path -> m ()
-add_ path = getResponse_ ("add" <$> path)
+add :: MonadMPD m => Path -> m ()
+add path = getResponse_ ("add" <@> path)
-- | Clear the current playlist.
clear :: MonadMPD m => m ()
@@ -216,20 +212,20 @@ clear = getResponse_ "clear"
-- | Remove a song from the current playlist.
delete :: MonadMPD m => Int -> m ()
-delete pos = getResponse_ ("delete" <$> pos)
+delete pos = getResponse_ ("delete" <@> pos)
-- | Remove a song from the current playlist.
deleteId :: MonadMPD m => Id -> m ()
-deleteId id' = getResponse_ ("deleteid" <$> id')
+deleteId id' = getResponse_ ("deleteid" <@> id')
-- | Move a song to a given position in the current playlist.
move :: MonadMPD m => Int -> Int -> m ()
-move pos to = getResponse_ ("move" <$> pos <++> to)
+move pos to = getResponse_ ("move" <@> pos <++> to)
-- | Move a song from (songid) to (playlist index) in the playlist. If to is
-- negative, it is relative to the current song in the playlist (if there is one).
moveId :: MonadMPD m => Id -> Int -> m ()
-moveId id' to = getResponse_ ("moveid" <$> id' <++> to)
+moveId id' to = getResponse_ ("moveid" <@> id' <++> to)
-- | Retrieve file paths and positions of songs in the current playlist.
-- Note that this command is only included for completeness sake; it's
@@ -244,31 +240,31 @@ playlist = mapM f =<< getResponse "playlist"
-- | Search for songs in the current playlist with strict matching.
playlistFind :: MonadMPD m => Query -> m [Song]
-playlistFind q = takeSongs =<< getResponse ("playlistfind" <$> q)
+playlistFind q = takeSongs =<< getResponse ("playlistfind" <@> q)
-- | Retrieve metadata for songs in the current playlist.
playlistInfo :: MonadMPD m => Maybe (Int, Int) -> m [Song]
-playlistInfo range = takeSongs =<< getResponse ("playlistinfo" <$> range)
+playlistInfo range = takeSongs =<< getResponse ("playlistinfo" <@> range)
-- | Displays a list of songs in the playlist.
-- If id is specified, only its info is returned.
playlistId :: MonadMPD m => Maybe Id -> m [Song]
-playlistId id' = takeSongs =<< getResponse ("playlistinfo" <$> id')
+playlistId id' = takeSongs =<< getResponse ("playlistinfo" <@> id')
-- | Search case-insensitively with partial matches for songs in the
-- current playlist.
playlistSearch :: MonadMPD m => Query -> m [Song]
-playlistSearch q = takeSongs =<< getResponse ("playlistsearch" <$> q)
+playlistSearch q = takeSongs =<< getResponse ("playlistsearch" <@> q)
-- | Retrieve a list of changed songs currently in the playlist since
-- a given playlist version.
plChanges :: MonadMPD m => Integer -> m [Song]
-plChanges version = takeSongs =<< getResponse ("plchanges" <$> version)
+plChanges version = takeSongs =<< getResponse ("plchanges" <@> version)
-- | Like 'plChanges' but only returns positions and ids.
plChangesPosId :: MonadMPD m => Integer -> m [(Int, Id)]
plChangesPosId plver =
- getResponse ("plchangesposid" <$> plver) >>=
+ getResponse ("plchangesposid" <@> plver) >>=
mapM f . splitGroups ["cpos"] . toAssocList
where f xs | [("cpos", x), ("Id", y)] <- xs
, Just (x', y') <- pair parseNum (x, y)
@@ -278,15 +274,15 @@ plChangesPosId plver =
-- | Shuffle the playlist.
shuffle :: MonadMPD m => Maybe (Int, Int) -- ^ Optional range (start, end)
-> m ()
-shuffle range = getResponse_ ("shuffle" <$> range)
+shuffle range = getResponse_ ("shuffle" <@> range)
-- | Swap the positions of two songs.
swap :: MonadMPD m => Int -> Int -> m ()
-swap pos1 pos2 = getResponse_ ("swap" <$> pos1 <++> pos2)
+swap pos1 pos2 = getResponse_ ("swap" <@> pos1 <++> pos2)
-- | Swap the positions of two songs (Id version
swapId :: MonadMPD m => Id -> Id -> m ()
-swapId id1 id2 = getResponse_ ("swapid" <$> id1 <++> id2)
+swapId id1 id2 = getResponse_ ("swapid" <@> id1 <++> id2)
--
-- Stored playlists
@@ -295,12 +291,12 @@ swapId id1 id2 = getResponse_ ("swapid" <$> id1 <++> id2)
-- | Retrieve a list of files in a given playlist.
listPlaylist :: MonadMPD m => PlaylistName -> m [Path]
listPlaylist plname =
- (map Path . takeValues) `liftM` getResponse ("listplaylist" <$> plname)
+ (map Path . takeValues) `liftM` getResponse ("listplaylist" <@> plname)
-- | Retrieve metadata for files in a given playlist.
listPlaylistInfo :: MonadMPD m => PlaylistName -> m [Song]
listPlaylistInfo plname =
- takeSongs =<< getResponse ("listplaylistinfo" <$> plname)
+ takeSongs =<< getResponse ("listplaylistinfo" <@> plname)
-- | Retreive a list of stored playlists.
listPlaylists :: MonadMPD m => m [PlaylistName]
@@ -313,47 +309,43 @@ listPlaylists = (map PlaylistName . go [] . toAssocList) `liftM` getResponse "li
-- | Load an existing playlist.
load :: MonadMPD m => PlaylistName -> m ()
-load plname = getResponse_ ("load" <$> plname)
-
--- | Like 'playlistAdd' but returns a list of the files added.
-playlistAdd :: MonadMPD m => PlaylistName -> Path -> m [Path]
-playlistAdd plname path = playlistAdd_ plname path >> listAll path
+load plname = getResponse_ ("load" <@> plname)
-- | Add a song (or a whole directory) to a stored playlist.
-- Will create a new playlist if the one specified does not already exist.
-playlistAdd_ :: MonadMPD m => PlaylistName -> Path -> m ()
-playlistAdd_ plname path = getResponse_ ("playlistadd" <$> plname <++> path)
+playlistAdd :: MonadMPD m => PlaylistName -> Path -> m ()
+playlistAdd plname path = getResponse_ ("playlistadd" <@> plname <++> path)
-- | Clear a playlist. If the specified playlist does not exist, it will be
-- created.
playlistClear :: MonadMPD m => PlaylistName -> m ()
-playlistClear = getResponse_ . ("playlistclear" <$>)
+playlistClear = getResponse_ . ("playlistclear" <@>)
-- | Remove a song from a playlist.
playlistDelete :: MonadMPD m => PlaylistName
-> Integer -- ^ Playlist position
-> m ()
-playlistDelete name pos = getResponse_ ("playlistdelete" <$> name <++> pos)
+playlistDelete name pos = getResponse_ ("playlistdelete" <@> name <++> pos)
-- | Move a song to a given position in the playlist specified.
playlistMove :: MonadMPD m => PlaylistName -> Integer -> Integer -> m ()
playlistMove name from to =
- getResponse_ ("playlistmove" <$> name <++> from <++> to)
+ getResponse_ ("playlistmove" <@> name <++> from <++> to)
-- | Rename an existing playlist.
rename :: MonadMPD m
=> PlaylistName -- ^ Original playlist
-> PlaylistName -- ^ New playlist name
-> m ()
-rename plname new = getResponse_ ("rename" <$> plname <++> new)
+rename plname new = getResponse_ ("rename" <@> plname <++> new)
-- | Delete existing playlist.
rm :: MonadMPD m => PlaylistName -> m ()
-rm plname = getResponse_ ("rm" <$> plname)
+rm plname = getResponse_ ("rm" <@> plname)
-- | Save the current playlist.
save :: MonadMPD m => PlaylistName -> m ()
-save plname = getResponse_ ("save" <$> plname)
+save plname = getResponse_ ("save" <@> plname)
--
-- The music database
@@ -361,31 +353,31 @@ save plname = getResponse_ ("save" <$> plname)
-- | Count the number of entries matching a query.
count :: MonadMPD m => Query -> m Count
-count query = getResponse ("count" <$> query) >>= runParser parseCount
+count query = getResponse ("count" <@> query) >>= runParser parseCount
-- | Search the database for entries exactly matching a query.
find :: MonadMPD m => Query -> m [Song]
-find query = getResponse ("find" <$> query) >>= takeSongs
+find query = getResponse ("find" <@> query) >>= takeSongs
-- | Adds songs matching a query to the current playlist.
findAdd :: MonadMPD m => Query -> m ()
-findAdd q = getResponse_ ("findadd" <$> q)
+findAdd q = getResponse_ ("findadd" <@> q)
-- | List all tags of the specified type.
list :: MonadMPD m
=> Metadata -- ^ Metadata to list
-> Query -> m [Value]
-list mtype query = (map Value . takeValues) `liftM` getResponse ("list" <$> mtype <++> query)
+list mtype query = (map Value . takeValues) `liftM` getResponse ("list" <@> mtype <++> query)
-- | List the songs (without metadata) in a database directory recursively.
listAll :: MonadMPD m => Path -> m [Path]
listAll path = liftM (map (Path . snd) . filter ((== "file") . fst) . toAssocList)
- (getResponse $ "listall" <$> path)
+ (getResponse $ "listall" <@> path)
-- Helper for lsInfo and listAllInfo.
lsInfo' :: MonadMPD m => Command -> Path -> m [LsResult]
-lsInfo' cmd path = getResponse (cmd <$> path) >>= takeEntries
+lsInfo' cmd path = getResponse (cmd <@> path) >>= takeEntries
-- | Recursive 'lsInfo'.
listAllInfo :: MonadMPD m => Path -> m [LsResult]
@@ -397,7 +389,7 @@ lsInfo = lsInfo' "lsinfo"
-- | Search the database using case insensitive matching.
search :: MonadMPD m => Query -> m [Song]
-search query = getResponse ("search" <$> query) >>= takeSongs
+search query = getResponse ("search" <@> query) >>= takeSongs
-- | Update the server's database.
--
@@ -415,7 +407,7 @@ rescan = update_ "rescan"
-- A helper for `update` and `rescan`.
update_ :: MonadMPD m => Command -> Maybe Path -> m Integer
update_ cmd mPath = do
- r <- getResponse (cmd <$> mPath)
+ r <- getResponse (cmd <@> mPath)
case toAssocList r of
[("updating_db", id_)] -> return (read id_)
_ -> throwError . Unexpected $ show r
@@ -429,7 +421,7 @@ stickerGet :: MonadMPD m => ObjectType
-> String -- ^ Object URI
-> String -- ^ Sticker name
-> m [String]
-stickerGet typ uri name = (map UTF8.toString . takeValues) `liftM` getResponse ("sticker get" <$> typ <++> uri <++> name)
+stickerGet typ uri name = (map UTF8.toString . takeValues) `liftM` getResponse ("sticker get" <@> typ <++> uri <++> name)
-- | Adds a sticker value to the specified object.
stickerSet :: MonadMPD m => ObjectType
@@ -438,7 +430,7 @@ stickerSet :: MonadMPD m => ObjectType
-> String -- ^ Sticker value
-> m ()
stickerSet typ uri name value =
- getResponse_ ("sticker set" <$> typ <++> uri <++> name <++> value)
+ getResponse_ ("sticker set" <@> typ <++> uri <++> name <++> value)
-- | Delete a sticker value from the specified object.
stickerDelete :: MonadMPD m => ObjectType
@@ -446,7 +438,7 @@ stickerDelete :: MonadMPD m => ObjectType
-> String -- ^ Sticker name
-> m ()
stickerDelete typ uri name =
- getResponse_ ("sticker delete" <$> typ <++> uri <++> name)
+ getResponse_ ("sticker delete" <@> typ <++> uri <++> name)
-- an internal helper function
decodePair :: (ByteString, ByteString) -> (String, String)
@@ -457,7 +449,7 @@ stickerList :: MonadMPD m => ObjectType
-> String -- ^ Object URI
-> m [(String, String)] -- ^ Sticker name\/sticker value
stickerList typ uri =
- (map decodePair . toAssocList) `liftM` getResponse ("sticker list" <$> typ <++> uri)
+ (map decodePair . toAssocList) `liftM` getResponse ("sticker list" <@> typ <++> uri)
-- | Searches the sticker database for stickers with the specified name, below
-- the specified path.
@@ -467,13 +459,13 @@ stickerFind :: MonadMPD m => ObjectType
-> m [(String, String)] -- ^ URI\/sticker value
stickerFind typ uri name =
(map decodePair . toAssocList) `liftM`
- getResponse ("sticker find" <$> typ <++> uri <++> name)
+ getResponse ("sticker find" <@> typ <++> uri <++> name)
--
-- Connection
--
--- XXX should the password be quoted? Change "++" to "<$>" if so. If
+-- XXX should the password be quoted? Change "++" to "<@>" if so. If
-- it should, it also needs to be fixed in N.M.Core.
-- | Send password to server to authenticate session.
-- Password is sent as plain text.
@@ -490,11 +482,11 @@ ping = getResponse_ "ping"
-- | Turn off an output device.
disableOutput :: MonadMPD m => Int -> m ()
-disableOutput = getResponse_ . ("disableoutput" <$>)
+disableOutput = getResponse_ . ("disableoutput" <@>)
-- | Turn on an output device.
enableOutput :: MonadMPD m => Int -> m ()
-enableOutput = getResponse_ . ("enableoutput" <$>)
+enableOutput = getResponse_ . ("enableoutput" <@>)
-- | Retrieve information for all output devices.
outputs :: MonadMPD m => m [Device]
View
8 Network/MPD/Commands/Arg.hs
@@ -8,7 +8,7 @@
--
-- Prepare command arguments.
-module Network.MPD.Commands.Arg (Command, Args(..), MPDArg(..), (<++>), (<$>)) where
+module Network.MPD.Commands.Arg (Command, Args(..), MPDArg(..), (<++>), (<@>)) where
import Network.MPD.Util (showBool)
@@ -46,9 +46,9 @@ newtype Command = Command String
-- | Converts a command name and a string of arguments into the string
-- to hand to getResponse.
-infix 2 <$>
-(<$>) :: (MPDArg a) => Command -> a -> String
-Command x <$> y = unwords $ x : filter (not . null) y'
+infix 2 <@>
+(<@>) :: (MPDArg a) => Command -> a -> String
+Command x <@> y = unwords $ x : filter (not . null) y'
where Args y' = prep y
instance MPDArg Args where prep = id
View
28 Network/MPD/Commands/Extensions.hs
@@ -30,12 +30,12 @@ toggle = status >>= \st -> case stState st of Playing -> pause True
-- Should be more efficient than running 'add' many times.
addMany :: MonadMPD m => PlaylistName -> [Path] -> m ()
addMany _ [] = return ()
-addMany "" [x] = add_ x
-addMany plname [x] = playlistAdd_ plname x
+addMany "" [x] = add x
+addMany plname [x] = playlistAdd plname x
addMany plname xs = getResponses (map cmd xs) >> return ()
where cmd x = case plname of
- "" -> "add" <$> x
- pl -> "playlistadd" <$> pl <++> x
+ "" -> "add" <@> x
+ pl -> "playlistadd" <@> pl <++> x
-- | Recursive 'addId'. For directories, it will use the given position
-- for the first file in the directory and use the successor for the remaining
@@ -49,6 +49,14 @@ addIdMany x Nothing = do
fs <- listAll x
mapM (flip addId Nothing) fs
+-- | Like 'add' but returns a list of the files added.
+addList :: MonadMPD m => Path -> m [Path]
+addList x = add x >> listAll x
+
+-- | Like 'playlistAdd' but returns a list of the files added.
+playlistAddList :: MonadMPD m => PlaylistName -> Path -> m [Path]
+playlistAddList plname path = playlistAdd plname path >> listAll path
+
-- | Delete a list of songs from a playlist.
-- If there is a duplicate then no further songs will be deleted, so
-- take care to avoid them (see 'prune' for this).
@@ -56,10 +64,10 @@ addIdMany x Nothing = do
deleteMany _ [] = return ()
deleteMany plname [(Pos x)] = playlistDelete plname x
deleteMany "" xs = getResponses (map cmd xs) >> return ()
- where cmd (Pos x) = "delete" <$> x
- cmd (ID x) = "deleteid" <$> 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" <$> plname <++> x
+ where cmd (Pos x) = "playlistdelete" <@> plname <++> x
cmd _ = ""
-- | Returns all songs and directories that match the given partial
@@ -113,13 +121,13 @@ findDuplicates =
lsDirs :: MonadMPD m => Path -> m [Path]
lsDirs path =
liftM (extractEntries (const Nothing,const Nothing, Just)) $
- takeEntries =<< getResponse ("lsinfo" <$> path)
+ takeEntries =<< getResponse ("lsinfo" <@> path)
-- | List files non-recursively.
lsFiles :: MonadMPD m => Path -> m [Path]
lsFiles path =
liftM (extractEntries (Just . sgFilePath, const Nothing, const Nothing)) $
- takeEntries =<< getResponse ("lsinfo" <$> path)
+ takeEntries =<< getResponse ("lsinfo" <@> path)
-- | List all playlists.
lsPlaylists :: MonadMPD m => m [PlaylistName]
@@ -134,7 +142,7 @@ listArtists = (map Value . takeValues) `liftM` (getResponse "list artist")
-- artist.
listAlbums :: MonadMPD m => Maybe Artist -> m [Album]
listAlbums artist = (map Value . takeValues) `liftM`
- getResponse ("list album" <$> fmap (("artist" :: String) <++>) artist)
+ getResponse ("list album" <@> fmap (("artist" :: String) <++>) artist)
-- | List the songs in an album of some artist.
listAlbum :: MonadMPD m => Artist -> Album -> m [Song]
View
45 Network/MPD/Util.hs
@@ -13,34 +13,33 @@ module Network.MPD.Util (
toAssoc, toAssocList, splitGroups, read
) where
-import Data.Char (isDigit)
import Data.Time.Format (ParseTime, parseTime, FormatTime, formatTime)
import System.Locale (defaultTimeLocale)
import qualified Prelude
-import Prelude hiding (break, take, drop, takeWhile, dropWhile, read, reads)
-import Data.ByteString.Char8 (break, take, drop, takeWhile, dropWhile, ByteString)
+import Prelude hiding (break, take, drop, dropWhile, read)
+import Data.ByteString.Char8 (break, drop, dropWhile, ByteString)
import qualified Data.ByteString.UTF8 as UTF8
import Data.String
+import Control.Applicative
+import qualified Data.Attoparsec.ByteString.Char8 as A
+
-- | Like Prelude.read, but works with ByteString.
read :: Read a => ByteString -> a
read = Prelude.read . UTF8.toString
--- | Like Prelude.reads, but works with ByteString.
-reads :: Read a => ByteString -> [(a, String)]
-reads = Prelude.reads . UTF8.toString
-
-- Break a string by character, removing the separator.
breakChar :: Char -> ByteString -> (ByteString, ByteString)
breakChar c s = let (x, y) = break (== c) s in (x, drop 1 y)
--- XXX: need a more robust date parser.
-- Parse a date value.
-- > parseDate "2008" = Just 2008
-- > parseDate "2008-03-01" = Just 2008
parseDate :: ByteString -> Maybe Int
-parseDate = parseNum . takeWhile isDigit
+parseDate = parseMaybe p
+ where
+ p = A.decimal <* A.skipMany (A.char '-' <|> A.digit)
-- Parse date in iso 8601 format
parseIso8601 :: (ParseTime t) => ByteString -> Maybe t
@@ -54,19 +53,16 @@ iso8601Format = "%FT%TZ"
-- Parse a positive or negative integer value, returning 'Nothing' on failure.
parseNum :: (Read a, Integral a) => ByteString -> Maybe a
-parseNum s = do
- [(x, "")] <- return (reads s)
- return x
+parseNum = parseMaybe (A.signed A.decimal)
-- Parse C style floating point value, returning 'Nothing' on failure.
parseFrac :: (Fractional a, Read a) => ByteString -> Maybe a
-parseFrac s =
- case s of
- "nan" -> return $ Prelude.read "NaN"
- "inf" -> return $ Prelude.read "Infinity"
- "-inf" -> return $ Prelude.read "-Infinity"
- _ -> do [(x, "")] <- return $ reads s
- return x
+parseFrac = parseMaybe p
+ where
+ p = A.string "nan" *> pure (Prelude.read "NaN")
+ <|> A.string "inf" *> pure (Prelude.read "Infinity")
+ <|> A.string "-inf" *> pure (Prelude.read "-Infinity")
+ <|> A.rational
-- Inverts 'parseBool'.
showBool :: IsString a => Bool -> a
@@ -75,10 +71,9 @@ showBool x = if x then "1" else "0"
-- Parse a boolean response value.
parseBool :: ByteString -> Maybe Bool
-parseBool s = case take 1 s of
- "1" -> Just True
- "0" -> Just False
- _ -> Nothing
+parseBool = parseMaybe p
+ where
+ p = A.char '1' *> pure True <|> A.char '0' *> pure False
-- Break a string into triple.
parseTriple :: Char -> (ByteString -> Maybe a) -> ByteString -> Maybe (a, a, a)
@@ -111,3 +106,7 @@ splitGroups groupHeads = go
(x:ys) : go zs
isGroupHead = (`elem` groupHeads) . fst
+
+-- A helper for running a Parser, turning errors into Nothing.
+parseMaybe :: A.Parser a -> ByteString -> Maybe a
+parseMaybe p s = either (const Nothing) Just $ A.parseOnly (p <* A.endOfInput) s
View
6 libmpd.cabal
@@ -49,8 +49,9 @@ Library
, old-locale >= 1.0 && < 2.0
, time >= 1.1 && < 2.0
, containers >= 0.3 && < 0.5
- , bytestring == 0.9.*
- , text == 0.11.*
+ , bytestring >= 0.9 && < 1
+ , text >= 0.11 && < 0.12
+ , attoparsec >= 0.10.1 && < 0.11
Exposed-Modules:
Network.MPD
@@ -87,6 +88,7 @@ Test-Suite specs
, network
, mtl
, text
+ , attoparsec
, containers
, data-default
, unix
View
18 tests/CommandSpec.hs
@@ -80,11 +80,11 @@ spec = do
-- * Playlist commands
- describe "add" $ do
- it "adds a url to the current playlist" $ testAdd
+ describe "addList" $ do
+ it "adds a url to the current playlist, returning a list of added items" $ testAddList
- describe "add_" $ do
- it "adds a url to current playlist, returning nothing" $ testAdd_
+ describe "add" $ do
+ it "adds a url to current playlist" $ testAdd
describe "playlistAdd" $ do
it "adds a url to a stored playlist" $ testPlaylistAdd
@@ -246,18 +246,18 @@ testCount = do
-- Playlist commands
--
-testAdd =
+testAddList =
cmd [("add \"foo\"", Right "OK"),
("listall \"foo\"", Right "file: Foo\nfile: Bar\nOK")]
(Right ["Foo", "Bar"])
- (add "foo")
+ (addList "foo")
-testAdd_ =
- cmd_ [("add \"foo\"", Right "OK")] (add_ "foo")
+testAdd =
+ cmd_ [("add \"foo\"", Right "OK")] (add "foo")
testPlaylistAdd =
cmd_ [("playlistadd \"foo\" \"bar\"", Right "OK")]
- (playlistAdd_ "foo" "bar")
+ (playlistAdd "foo" "bar")
testAddId =
cmd [("addid \"dir/Foo-Bar.ogg\"", Right "Id: 20\nOK")]

No commit comments for this range

Something went wrong with that request. Please try again.