From 2632f417037529d3232ec79982f2a072da365a23 Mon Sep 17 00:00:00 2001 From: Nick Breitling Date: Sun, 7 Jun 2026 19:41:43 -0500 Subject: [PATCH 1/8] Support binary responses with ResponseEntry union --- src/Network/MPD/Applicative/Internal.hs | 14 ++++----- src/Network/MPD/Applicative/Status.hs | 5 ++-- src/Network/MPD/Applicative/Util.hs | 7 +++-- src/Network/MPD/Commands/CurrentPlaylist.hs | 4 ++- src/Network/MPD/Commands/Parse.hs | 10 ++++--- src/Network/MPD/Core.hs | 32 +++++++++++++-------- src/Network/MPD/Core/Class.hs | 6 +++- src/Network/MPD/Util.hs | 10 +++++-- tests/ParserSpec.hs | 10 ++++--- tests/StringConn.hs | 19 ++++++++++-- tests/UtilSpec.hs | 3 +- 11 files changed, 80 insertions(+), 40 deletions(-) diff --git a/src/Network/MPD/Applicative/Internal.hs b/src/Network/MPD/Applicative/Internal.hs index d2819429..56d54af7 100644 --- a/src/Network/MPD/Applicative/Internal.hs +++ b/src/Network/MPD/Applicative/Internal.hs @@ -32,16 +32,16 @@ module Network.MPD.Applicative.Internal ) where import Control.Monad -import Data.ByteString.Char8 (ByteString) import Network.MPD.Core hiding (getResponse) +import Network.MPD.Core.Class import qualified Network.MPD.Core as Core import Control.Monad.Except import qualified Control.Monad.Fail as Fail -- | A line-oriented parser that returns a value along with any remaining input. newtype Parser a - = Parser { runParser :: [ByteString] -> Either String (a, [ByteString]) } + = Parser { runParser :: [ResponseEntry] -> Either String (a, [ResponseEntry]) } deriving Functor instance Monad Parser where @@ -56,13 +56,13 @@ instance Applicative Parser where (<*>) = ap -- | Convert a regular parser. -liftParser :: ([ByteString] -> Either String a) -> Parser a -liftParser p = Parser $ \input -> case break (== "list_OK") input of +liftParser :: ([ResponseEntry] -> Either String a) -> Parser a +liftParser p = Parser $ \input -> case break (== Text "list_OK") input of (xs, ys) -> fmap (, drop 1 ys) (p xs) -- | Return everything until the next "list_OK". -getResponse :: Parser [ByteString] -getResponse = Parser $ \input -> case break (== "list_OK") input of +getResponse :: Parser [ResponseEntry] +getResponse = Parser $ \input -> case break (== Text "list_OK") input of (xs, ys) -> Right (xs, drop 1 ys) -- | For commands returning an empty response. @@ -73,7 +73,7 @@ emptyResponse = do unexpected r -- | Fail with unexpected response. -unexpected :: [ByteString] -> Parser a +unexpected :: [ResponseEntry] -> Parser a unexpected = fail . ("unexpected Response: " ++) . show -- | A compound command, comprising a parser for the responses and a diff --git a/src/Network/MPD/Applicative/Status.hs b/src/Network/MPD/Applicative/Status.hs index bd221d66..005a3a7c 100644 --- a/src/Network/MPD/Applicative/Status.hs +++ b/src/Network/MPD/Applicative/Status.hs @@ -28,6 +28,7 @@ import Network.MPD.Applicative.Internal import Network.MPD.Commands.Arg hiding (Command) import Network.MPD.Commands.Parse import Network.MPD.Commands.Types +import Network.MPD.Core.Class import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.UTF8 as UTF8 @@ -40,7 +41,7 @@ clearError = Command emptyResponse ["clearerror"] currentSong :: Command (Maybe Song) currentSong = Command (liftParser parseMaybeSong) ["currentsong"] -takeSubsystems :: [ByteString] -> Either String [Subsystem] +takeSubsystems :: [ResponseEntry] -> Either String [Subsystem] takeSubsystems = mapM f . toAssocList where f :: (ByteString, ByteString) -> Either String Subsystem @@ -84,7 +85,7 @@ status :: Command Status status = Command (liftParser parseStatus) ["status"] where -- Builds a 'Status' instance from an assoc. list. - parseStatus :: [ByteString] -> Either String Status + parseStatus :: [ResponseEntry] -> Either String Status parseStatus = foldM go def . toAssocList where go a p@(k, v) = case k of diff --git a/src/Network/MPD/Applicative/Util.hs b/src/Network/MPD/Applicative/Util.hs index 3c975d63..d1a17f29 100644 --- a/src/Network/MPD/Applicative/Util.hs +++ b/src/Network/MPD/Applicative/Util.hs @@ -5,6 +5,7 @@ module Network.MPD.Applicative.Util where import Network.MPD.Commands.Parse import Network.MPD.Commands.Types import Network.MPD.Util +import Network.MPD.Core.Class import Control.Monad (liftM) @@ -13,7 +14,7 @@ import qualified Data.ByteString.UTF8 as UTF8 -- Separate the result of an lsinfo\/listallinfo call into directories, -- playlists, and songs. -takeEntries :: [ByteString] -> Either String [LsResult] +takeEntries :: [ResponseEntry] -> Either String [LsResult] takeEntries = mapM toEntry . splitGroups groupHeads . toAssocList where toEntry xs@(("file",_):_) = LsSong `liftM` parseSong xs @@ -22,11 +23,11 @@ takeEntries = mapM toEntry . splitGroups groupHeads . toAssocList toEntry _ = error "takeEntries: splitGroups is broken" groupHeads = ["file", "directory", "playlist"] -takeSongs :: [ByteString] -> Either String [Song] +takeSongs :: [ResponseEntry] -> Either String [Song] takeSongs = mapM parseSong . splitGroups ["file"] . toAssocList -- Run 'toAssocList' and return only the values. -takeValues :: [ByteString] -> [ByteString] +takeValues :: [ResponseEntry] -> [ByteString] takeValues = snd . unzip . toAssocList -- an internal helper function diff --git a/src/Network/MPD/Commands/CurrentPlaylist.hs b/src/Network/MPD/Commands/CurrentPlaylist.hs index 6412e111..e58e0c97 100644 --- a/src/Network/MPD/Commands/CurrentPlaylist.hs +++ b/src/Network/MPD/Commands/CurrentPlaylist.hs @@ -46,6 +46,7 @@ import Network.MPD.Commands.Query import Network.MPD.Commands.Types import Network.MPD.Core import Network.MPD.Util +import Network.MPD.Core.Class import Control.Monad.Except (throwError) @@ -96,7 +97,8 @@ moveId i = A.runCommand . A.moveId i -- instead. playlist :: MonadMPD m => m [(Position, Path)] playlist = mapM f =<< getResponse "playlist" - where f s | (pos, name) <- breakChar ':' s + where f s | (Text s') <- s + , (pos, name) <- breakChar ':' s' , Just pos' <- parseNum pos = return (pos', Path name) | otherwise = throwError . Unexpected $ show s diff --git a/src/Network/MPD/Commands/Parse.hs b/src/Network/MPD/Commands/Parse.hs index f53283c9..b905cfbf 100644 --- a/src/Network/MPD/Commands/Parse.hs +++ b/src/Network/MPD/Commands/Parse.hs @@ -12,6 +12,8 @@ module Network.MPD.Commands.Parse where import Network.MPD.Commands.Types +import Network.MPD.Core.Class + import Control.Monad import Control.Monad.Except import Data.Maybe (fromMaybe) @@ -22,7 +24,7 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.UTF8 as UTF8 -- | Builds a 'Count' instance from an assoc. list. -parseCount :: [ByteString] -> Either String Count +parseCount :: [ResponseEntry] -> Either String Count parseCount = foldM f def . toAssocList where f :: Count -> (ByteString, ByteString) -> Either String Count f a ("songs", x) = return $ parse parseNum @@ -32,7 +34,7 @@ parseCount = foldM f def . toAssocList f _ x = Left $ show x -- | Builds a list of 'Device' instances from an assoc. list -parseOutputs :: [ByteString] -> Either String [Device] +parseOutputs :: [ResponseEntry] -> Either String [Device] parseOutputs = mapM (foldM f def) . splitGroups ["outputid"] . toAssocList @@ -44,7 +46,7 @@ parseOutputs = mapM (foldM f def) f _ x = Left $ show x -- | Builds a 'Stats' instance from an assoc. list. -parseStats :: [ByteString] -> Either String Stats +parseStats :: [ResponseEntry] -> Either String Stats parseStats = foldM f def . toAssocList where f a ("artists", x) = return $ parse parseNum @@ -63,7 +65,7 @@ parseStats = foldM f def . toAssocList (\x' -> a { stsDbUpdate = x' }) a x f _ x = Left $ show x -parseMaybeSong :: [ByteString] -> Either String (Maybe Song) +parseMaybeSong :: [ResponseEntry] -> Either String (Maybe Song) parseMaybeSong xs | null xs = Right Nothing | otherwise = Just <$> (parseSong . toAssocList) xs diff --git a/src/Network/MPD/Core.hs b/src/Network/MPD/Core.hs index eb78bb60..6e5ced66 100644 --- a/src/Network/MPD/Core.hs +++ b/src/Network/MPD/Core.hs @@ -52,6 +52,7 @@ import Network.Socket import System.IO (Handle, hPutStrLn, hReady, hClose, hFlush) import System.IO.Error (isEOFError, tryIOError, ioeGetErrorType) import Text.Printf (printf) +import Text.Read (readMaybe) import qualified GHC.IO.Exception as GE import qualified Prelude @@ -140,7 +141,7 @@ mpdOpen = MPD $ do `catchAny` const (return Nothing) checkConn = do singleMsg <- send "" - let [msg] = singleMsg + let [Text msg] = singleMsg if "OK MPD" `isPrefixOf` msg then MPD $ checkVersion $ parseVersion msg else return False @@ -180,14 +181,14 @@ mpdClose = | isEOFError err = return Nothing | otherwise = (return . Just . ConnectionError) err -mpdSend :: String -> MPD [ByteString] +mpdSend :: String -> MPD [ResponseEntry] mpdSend str = send' `catchError` handler where handler err | ConnectionError e <- err, isRetryable e = mpdOpen >> send' | otherwise = throwError err - send' :: MPD [ByteString] + send' :: MPD [ResponseEntry] send' = MPD $ gets stHandle >>= maybe (throwError NoMPD) go go handle = (liftIO . tryIOError $ do @@ -196,12 +197,19 @@ mpdSend str = send' `catchError` handler >>= either (\err -> modify (\st -> st { stHandle = Nothing }) >> throwError (ConnectionError err)) return - getLines :: Handle -> [ByteString] -> IO [ByteString] + getLines :: Handle -> [ResponseEntry] -> IO [ResponseEntry] getLines handle acc = do l <- B.hGetLine handle - if "OK" `isPrefixOf` l || "ACK" `isPrefixOf` l - then (return . reverse) (l:acc) - else getLines handle (l:acc) + let action + | ("binary", nBytesStr) <- toAssoc (Text l) + , Just nBytes <- readMaybe (UTF8.toString nBytesStr) + = do + bytes <- B.hGet handle nBytes + _ <- B.hGetLine handle -- newline after the byte string + return (Bytes bytes:acc) + | "OK" `isPrefixOf` l || "ACK" `isPrefixOf` l = (return . reverse) (Text l:acc) + | otherwise = getLines handle (Text l:acc) + action -- | Re-connect and retry for these Exceptions. isRetryable :: E.IOException -> Bool @@ -221,7 +229,7 @@ kill :: (MonadMPD m) => m () kill = send "kill" >> return () -- | Send a command to the MPD server and return the result. -getResponse :: (MonadMPD m) => String -> m [ByteString] +getResponse :: (MonadMPD m) => String -> m [ResponseEntry] getResponse cmd = (send cmd >>= parseResponse) `catchError` sendpw where sendpw e@(ACK Auth _) = do @@ -233,11 +241,11 @@ getResponse cmd = (send cmd >>= parseResponse) `catchError` sendpw throwError e -- Consume response and return a Response. -parseResponse :: (MonadError MPDError m) => [ByteString] -> m [ByteString] +parseResponse :: (MonadError MPDError m) => [ResponseEntry] -> m [ResponseEntry] parseResponse xs - | null xs = throwError $ NoMPD - | "ACK" `isPrefixOf` x = throwError $ parseAck x - | otherwise = return $ Prelude.takeWhile ("OK" /=) xs + | null xs = throwError $ NoMPD + | Text x' <- x, "ACK" `isPrefixOf` x' = throwError $ parseAck x' + | otherwise = return $ Prelude.takeWhile (Text "OK" /=) xs where x = head xs diff --git a/src/Network/MPD/Core/Class.hs b/src/Network/MPD/Core/Class.hs index 4db6b98d..77b8f9cd 100644 --- a/src/Network/MPD/Core/Class.hs +++ b/src/Network/MPD/Core/Class.hs @@ -18,6 +18,10 @@ import Control.Monad.Except (MonadError) type Password = String +-- | A line of a MPD response. May either be a regular string or a sequence of +-- raw bytes. +data ResponseEntry = Text ByteString | Bytes ByteString deriving (Eq, Show) + -- | A typeclass to allow for multiple implementations of a connection -- to an MPD server. class (Monad m, MonadError MPDError m) => MonadMPD m where @@ -26,7 +30,7 @@ class (Monad m, MonadError MPDError m) => MonadMPD m where -- | Close the connection. close :: m () -- | Send a string to the server and return its response. - send :: String -> m [ByteString] + send :: String -> m [ResponseEntry] -- | Produce a password to send to the server should it ask for -- one. getPassword :: m Password diff --git a/src/Network/MPD/Util.hs b/src/Network/MPD/Util.hs index 288f3faf..95387595 100644 --- a/src/Network/MPD/Util.hs +++ b/src/Network/MPD/Util.hs @@ -25,6 +25,8 @@ import Data.ByteString.Char8 (break, drop, dropWhile, ByteString) import qualified Data.ByteString.UTF8 as UTF8 import Data.String +import Network.MPD.Core.Class + import Control.Applicative import qualified Data.Attoparsec.ByteString.Char8 as A @@ -96,10 +98,12 @@ parseTriple c f s = let (u, u') = breakChar c s _ -> Nothing -- Break a string into a key-value pair, separating at the first ':'. -toAssoc :: ByteString -> (ByteString, ByteString) -toAssoc = second (dropWhile (== ' ') . drop 1) . break (== ':') +-- For binary entries, the key "binary" is used. +toAssoc :: ResponseEntry -> (ByteString, ByteString) +toAssoc (Text x) = second (dropWhile (== ' ') . drop 1) . break (== ':') $ x +toAssoc (Bytes x) = ("binary", x) -toAssocList :: [ByteString] -> [(ByteString, ByteString)] +toAssocList :: [ResponseEntry] -> [(ByteString, ByteString)] toAssocList = map toAssoc -- Takes an association list with recurring keys and groups each cycle of keys diff --git a/tests/ParserSpec.hs b/tests/ParserSpec.hs index a169ee04..ca11a8f4 100644 --- a/tests/ParserSpec.hs +++ b/tests/ParserSpec.hs @@ -12,11 +12,13 @@ import Test.Hspec.QuickCheck (prop) import Network.MPD.Commands.Parse import Network.MPD.Commands.Types import Network.MPD.Util hiding (read) +import Network.MPD.Core.Class import qualified Data.ByteString.UTF8 as UTF8 import Data.List import qualified Data.Map as M import Data.Time +import StringConn main :: IO () main = hspec spec @@ -45,14 +47,14 @@ prop_parseIso8601 :: UTCTime -> Expectation prop_parseIso8601 t = Just t `shouldBe` (parseIso8601 . UTF8.fromString . formatIso8601) t prop_parseCount :: Count -> Expectation -prop_parseCount c = Right c `shouldBe` (parseCount . map UTF8.fromString . lines . unparse) c +prop_parseCount c = Right c `shouldBe` (parseCount . toEntries . UTF8.fromString . unparse) c prop_parseOutputs :: [Device] -> Expectation prop_parseOutputs ds = - Right ds `shouldBe` (parseOutputs . map UTF8.fromString . lines . concatMap unparse) ds + Right ds `shouldBe` (parseOutputs . toEntries . UTF8.fromString . concatMap unparse) ds prop_parseSong :: Song -> Expectation -prop_parseSong s = Right (sortTags s) `shouldBe` sortTags `fmap` (parseSong . toAssocList . map UTF8.fromString . lines . unparse) s +prop_parseSong s = Right (sortTags s) `shouldBe` sortTags `fmap` (parseSong . toAssocList . toEntries . UTF8.fromString . unparse) s where -- We consider lists of tag values equal if they contain the same elements. -- To ensure that two lists with the same elements are equal, we bring the @@ -60,4 +62,4 @@ prop_parseSong s = Right (sortTags s) `shouldBe` sortTags `fmap` (parseSong . to sortTags song = song { sgTags = M.map sort $ sgTags song } prop_parseStats :: Stats -> Expectation -prop_parseStats s = Right s `shouldBe` (parseStats . map UTF8.fromString . lines . unparse) s +prop_parseStats s = Right s `shouldBe` (parseStats . toEntries . UTF8.fromString . unparse) s diff --git a/tests/StringConn.hs b/tests/StringConn.hs index a2178dc9..b1877ba0 100644 --- a/tests/StringConn.hs +++ b/tests/StringConn.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings #-} {-# OPTIONS_GHC -Wwarn #-} -- | @@ -19,9 +19,13 @@ import Control.Monad.Identity import Control.Monad.Reader import Control.Monad.State import Network.MPD.Core +import Network.MPD.Core.Class +import Network.MPD.Util (toAssoc, breakChar) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.UTF8 as UTF8 +import Text.Read (readMaybe) +import Control.Arrow (second) -- | An expected request. type Expect = String @@ -58,7 +62,18 @@ instance MonadMPD StringMPD where when (expected_request /= request) (throwError . Custom $ "unexpected request: " ++ show request ++ ", expected: " ++ show expected_request) put rest - either throwError (return . B.lines . UTF8.fromString) response + either throwError (return . toEntries . UTF8.fromString) response + +-- parse a ByteString into a list of ResponseEntries (similar to in mpdSend) +toEntries :: B.ByteString -> [ResponseEntry] +toEntries xs | B.null xs = [] + | ("binary", nBytesStr) <- toAssoc (Text line) + , Just nBytes <- readMaybe (UTF8.toString nBytesStr) + = let + (bytes, rest') = second (B.drop 1) $ B.splitAt nBytes rest + in Bytes bytes : toEntries rest' + | otherwise = Text line:toEntries rest + where (line, rest) = breakChar '\n' xs testMPD :: (Eq a) => [(Expect, Response String)] -> StringMPD a -> Response a testMPD pairs m = testMPDWithPassword pairs "" m diff --git a/tests/UtilSpec.hs b/tests/UtilSpec.hs index a24aee15..81bab060 100644 --- a/tests/UtilSpec.hs +++ b/tests/UtilSpec.hs @@ -15,6 +15,7 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.UTF8 as UTF8 import Network.MPD.Util +import Network.MPD.Core.Class main :: IO () main = hspec spec @@ -62,7 +63,7 @@ prop_toAssoc_rev :: AssocString -> Bool prop_toAssoc_rev x = k == k' && v == v' where AS str k v = x - (k',v') = toAssoc str + (k',v') = toAssoc (Text str) prop_parseBool_rev :: BoolString -> Bool prop_parseBool_rev (BS x) = showBool (fromJust $ parseBool x) == x From d6f6c2f5e696d882ae5c11007dd55f816f15b999 Mon Sep 17 00:00:00 2001 From: Nick Breitling Date: Sun, 7 Jun 2026 19:43:43 -0500 Subject: [PATCH 2/8] Add albumArt and binaryLimit commands --- src/Network/MPD/Applicative/Connection.hs | 6 ++++++ src/Network/MPD/Applicative/Database.hs | 11 ++++++++++- src/Network/MPD/Commands/Connection.hs | 5 +++++ src/Network/MPD/Commands/Database.hs | 8 +++++++- src/Network/MPD/Commands/Parse.hs | 9 +++++++++ src/Network/MPD/Commands/Types.hs | 16 +++++++++++++++- tests/Arbitrary.hs | 3 +++ tests/Network/MPD/Applicative/ConnectionSpec.hs | 6 ++++++ tests/Network/MPD/Applicative/DatabaseSpec.hs | 14 ++++++++++++++ tests/ParserSpec.hs | 6 ++++++ tests/Unparse.hs | 9 +++++++++ 11 files changed, 90 insertions(+), 3 deletions(-) diff --git a/src/Network/MPD/Applicative/Connection.hs b/src/Network/MPD/Applicative/Connection.hs index 15d553a2..159cf56d 100644 --- a/src/Network/MPD/Applicative/Connection.hs +++ b/src/Network/MPD/Applicative/Connection.hs @@ -15,10 +15,12 @@ Connection settings. module Network.MPD.Applicative.Connection ( password , ping + , binaryLimit ) where import Network.MPD.Applicative.Internal import Network.MPD.Core +import Network.MPD.Commands.Arg hiding (Command) -- | Authenticate session. The password is sent in plain text. password :: Password -> Command () @@ -27,3 +29,7 @@ password pwd = Command emptyResponse ["password " ++ pwd] -- | Ping daemon. ping :: Command () ping = Command emptyResponse ["ping"] + +-- | Set the maximum binary response size (in bytes) for the current connection. +binaryLimit :: Integer -> Command () +binaryLimit limit = Command emptyResponse ["binarylimit" <@> limit] diff --git a/src/Network/MPD/Applicative/Database.hs b/src/Network/MPD/Applicative/Database.hs index 6c706dac..5d52f17c 100644 --- a/src/Network/MPD/Applicative/Database.hs +++ b/src/Network/MPD/Applicative/Database.hs @@ -13,7 +13,8 @@ The music database. -} module Network.MPD.Applicative.Database - ( count + ( albumArt + , count , find , findAdd , list @@ -37,6 +38,14 @@ import Network.MPD.Commands.Types import Network.MPD.Applicative.Internal import Network.MPD.Applicative.Util +-- | Locate album art for the given song and return a chunk of an album art +-- image file at offset 'offset'. +albumArt :: Path -> Integer -> Command AlbumArtChunk +albumArt uri offset = Command p ["albumart" <@> uri <++> offset] + where + p :: Parser AlbumArtChunk + p = liftParser parseAlbumArtChunk + -- | Get a count of songs and their total playtime that exactly match the -- query. count :: Query -> Command Count diff --git a/src/Network/MPD/Commands/Connection.hs b/src/Network/MPD/Commands/Connection.hs index 3e67afec..f8ba0e9c 100644 --- a/src/Network/MPD/Commands/Connection.hs +++ b/src/Network/MPD/Commands/Connection.hs @@ -13,6 +13,7 @@ Connection settings. module Network.MPD.Commands.Connection ( password , ping + , binaryLimit ) where import qualified Network.MPD.Applicative.Internal as A @@ -29,3 +30,7 @@ password = A.runCommand . A.password -- | Check that the server is still responding. ping :: MonadMPD m => m () ping = A.runCommand A.ping + +-- | Set the maximum binary response size (in bytes) for the current connection. +binaryLimit :: MonadMPD m => Integer -> m () +binaryLimit = A.runCommand . A.binaryLimit diff --git a/src/Network/MPD/Commands/Database.hs b/src/Network/MPD/Commands/Database.hs index 3eae8677..dff8c075 100644 --- a/src/Network/MPD/Commands/Database.hs +++ b/src/Network/MPD/Commands/Database.hs @@ -13,7 +13,8 @@ The music database. -} module Network.MPD.Commands.Database - ( count + ( albumArt + , count , find , findAdd , list @@ -34,6 +35,11 @@ import Network.MPD.Commands.Query import Network.MPD.Commands.Types import Network.MPD.Core +-- | Locate album art for the given song and return a chunk of an album art +-- image file at offset 'offset'. +albumArt :: MonadMPD m => Path -> Integer -> m AlbumArtChunk +albumArt uri = A.runCommand . A.albumArt uri + -- | Count the number of entries matching a query. count :: MonadMPD m => Query -> m Count count = A.runCommand . A.count diff --git a/src/Network/MPD/Commands/Parse.hs b/src/Network/MPD/Commands/Parse.hs index b905cfbf..00d5933a 100644 --- a/src/Network/MPD/Commands/Parse.hs +++ b/src/Network/MPD/Commands/Parse.hs @@ -23,6 +23,15 @@ import Network.MPD.Util import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.UTF8 as UTF8 +-- | Builds an 'AlbumArtChunk' instance from an assoc. list. +parseAlbumArtChunk :: [ResponseEntry] -> Either String AlbumArtChunk +parseAlbumArtChunk = foldM f def . toAssocList + where + f a ("size", x) = return $ parse parseNum + (\x' -> a {aacSize = x'}) a x + f a ("binary", x) = return $ a {aacBytes = x} + f _ x = Left $ show x + -- | Builds a 'Count' instance from an assoc. list. parseCount :: [ResponseEntry] -> Either String Count parseCount = foldM f def . toAssocList diff --git a/src/Network/MPD/Commands/Types.hs b/src/Network/MPD/Commands/Types.hs index 936b8538..0e9a3b0d 100644 --- a/src/Network/MPD/Commands/Types.hs +++ b/src/Network/MPD/Commands/Types.hs @@ -23,6 +23,7 @@ module Network.MPD.Commands.Types , PlaybackState(..) , Subsystem(..) , ReplayGainMode(..) + , AlbumArtChunk(..) , Count(..) , LsResult(..) , Device(..) @@ -51,7 +52,7 @@ import Data.String import Data.Text (Text) import qualified Data.Text.Encoding as Text -import Data.ByteString (ByteString) +import Data.ByteString (ByteString, empty) import qualified Data.ByteString.UTF8 as UTF8 -- The purpose of this class is to allow users to choose the optimal @@ -217,6 +218,19 @@ instance MPDArg ReplayGainMode where prep AlbumMode = Args ["album"] prep AutoMode = Args ["auto"] +-- | Represents the result of running 'albumart' +data AlbumArtChunk = + AlbumArtChunk { aacSize :: Integer -- ^ File size of the album art + , aacBytes :: ByteString -- ^ Raw bytes read + } + deriving (Eq, Show) + +defaultAlbumArtChunk :: AlbumArtChunk +defaultAlbumArtChunk = AlbumArtChunk { aacSize = 0, aacBytes = empty } + +instance Default AlbumArtChunk where + def = defaultAlbumArtChunk + -- | Represents the result of running 'count'. data Count = Count { cSongs :: Integer -- ^ Number of songs matching the query diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs index 66224937..42b55084 100644 --- a/tests/Arbitrary.hs +++ b/tests/Arbitrary.hs @@ -115,6 +115,9 @@ instance Arbitrary DateString where (y,m,d) <- three (positive :: Gen Integer) return . DS . UTF8.fromString . concat . intersperse "-" $ map show [y,m,d] +instance Arbitrary AlbumArtChunk where + arbitrary = liftM2 AlbumArtChunk arbitrary arbitrary + instance Arbitrary Count where arbitrary = liftM2 Count arbitrary arbitrary diff --git a/tests/Network/MPD/Applicative/ConnectionSpec.hs b/tests/Network/MPD/Applicative/ConnectionSpec.hs index 2f934bba..745845cb 100644 --- a/tests/Network/MPD/Applicative/ConnectionSpec.hs +++ b/tests/Network/MPD/Applicative/ConnectionSpec.hs @@ -45,3 +45,9 @@ spec = do describe "ping" $ do it "sends a ping" $ do ping `with` [("ping", Right "OK")] `shouldBe` Right () + + describe "binaryLimit" $ do + it "sends a binary limit" $ do + binaryLimit 8 + `with` [("binarylimit 8", Right "OK")] + `shouldBe` Right () diff --git a/tests/Network/MPD/Applicative/DatabaseSpec.hs b/tests/Network/MPD/Applicative/DatabaseSpec.hs index 9596c550..dc8e9bd0 100644 --- a/tests/Network/MPD/Applicative/DatabaseSpec.hs +++ b/tests/Network/MPD/Applicative/DatabaseSpec.hs @@ -13,6 +13,20 @@ main = hspec spec spec :: Spec spec = do + describe "albumArt" $ do + it "returns a chunk of the album artwork" $ do + albumArt "Bar.ogg" 0 + `with` [("albumart \"Bar.ogg\" 0" + , Right "size: 64\nbinary: 6\nfoobar\nOK")] + `shouldBe` Right (AlbumArtChunk 64 "foobar") + + describe "albumArt" $ do + it "returns a chunk of the album artwork at an offset" $ do + albumArt "Bar.ogg" 3 + `with` [("albumart \"Bar.ogg\" 3" + , Right "size: 64\nbinary: 6\nbarbaz\nOK")] + `shouldBe` Right (AlbumArtChunk 64 "barbaz") + describe "count" $ do it "returns a count of entries matching a query" $ do count (Title =? "Foo") diff --git a/tests/ParserSpec.hs b/tests/ParserSpec.hs index ca11a8f4..02e6140c 100644 --- a/tests/ParserSpec.hs +++ b/tests/ParserSpec.hs @@ -28,6 +28,9 @@ spec = do describe "parseIso8601" $ do prop "parses dates in ISO8601 format" prop_parseIso8601 + describe "parseAlbumArtChunk" $ do + prop "parses album art chunks" prop_parseAlbumArtChunk + describe "parseCount" $ do prop "parses counts" prop_parseCount @@ -46,6 +49,9 @@ spec = do prop_parseIso8601 :: UTCTime -> Expectation prop_parseIso8601 t = Just t `shouldBe` (parseIso8601 . UTF8.fromString . formatIso8601) t +prop_parseAlbumArtChunk :: AlbumArtChunk -> Expectation +prop_parseAlbumArtChunk aac = Right aac `shouldBe` (parseAlbumArtChunk . toEntries . UTF8.fromString . unparse) aac + prop_parseCount :: Count -> Expectation prop_parseCount c = Right c `shouldBe` (parseCount . toEntries . UTF8.fromString . unparse) c diff --git a/tests/Unparse.hs b/tests/Unparse.hs index c462899b..67ea35e5 100644 --- a/tests/Unparse.hs +++ b/tests/Unparse.hs @@ -5,6 +5,8 @@ module Unparse (Unparse(..)) where import qualified Data.Map as M import Network.MPD.Commands.Types import Network.MPD.Util +import qualified Data.ByteString.UTF8 as UTF8 +import qualified Data.ByteString as B class Unparse parsed where unparse :: parsed -> String @@ -13,6 +15,13 @@ instance Unparse a => Unparse (Maybe a) where unparse Nothing = "" unparse (Just x) = unparse x +instance Unparse AlbumArtChunk where + unparse aac = unlines + [ "size: " ++ show (aacSize aac) + , "binary: " ++ show (B.length (aacBytes aac)) + , UTF8.toString $ aacBytes aac + ] + instance Unparse Count where unparse x = unlines [ "songs: " ++ show (cSongs x) From d591cbb6373dd2fafe2c9f379d70ecd713f254c2 Mon Sep 17 00:00:00 2001 From: Nick Breitling Date: Sun, 7 Jun 2026 20:29:10 -0500 Subject: [PATCH 3/8] export AlbumArtChunk --- src/Network/MPD/Commands.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Network/MPD/Commands.hs b/src/Network/MPD/Commands.hs index e1d51636..ceb0841d 100644 --- a/src/Network/MPD/Commands.hs +++ b/src/Network/MPD/Commands.hs @@ -28,6 +28,7 @@ module Network.MPD.Commands ( , PlaybackState(..) , Subsystem(..) , ReplayGainMode(..) + , AlbumArtChunk(..) , Count(..) , LsResult(..) , Device(..) From 657b274700de2eaa17af28c98f72709b7a0820f9 Mon Sep 17 00:00:00 2001 From: Nick Breitling Date: Sun, 7 Jun 2026 21:47:32 -0500 Subject: [PATCH 4/8] use parseNum instead of readMaybe --- src/Network/MPD/Core.hs | 2 +- tests/StringConn.hs | 5 ++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Network/MPD/Core.hs b/src/Network/MPD/Core.hs index 6e5ced66..87dad6e7 100644 --- a/src/Network/MPD/Core.hs +++ b/src/Network/MPD/Core.hs @@ -202,7 +202,7 @@ mpdSend str = send' `catchError` handler l <- B.hGetLine handle let action | ("binary", nBytesStr) <- toAssoc (Text l) - , Just nBytes <- readMaybe (UTF8.toString nBytesStr) + , Just nBytes <- parseNum nBytesStr = do bytes <- B.hGet handle nBytes _ <- B.hGetLine handle -- newline after the byte string diff --git a/tests/StringConn.hs b/tests/StringConn.hs index b1877ba0..309eec88 100644 --- a/tests/StringConn.hs +++ b/tests/StringConn.hs @@ -20,11 +20,10 @@ import Control.Monad.Reader import Control.Monad.State import Network.MPD.Core import Network.MPD.Core.Class -import Network.MPD.Util (toAssoc, breakChar) +import Network.MPD.Util import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.UTF8 as UTF8 -import Text.Read (readMaybe) import Control.Arrow (second) -- | An expected request. @@ -68,7 +67,7 @@ instance MonadMPD StringMPD where toEntries :: B.ByteString -> [ResponseEntry] toEntries xs | B.null xs = [] | ("binary", nBytesStr) <- toAssoc (Text line) - , Just nBytes <- readMaybe (UTF8.toString nBytesStr) + , Just nBytes <- parseNum nBytesStr = let (bytes, rest') = second (B.drop 1) $ B.splitAt nBytes rest in Bytes bytes : toEntries rest' From 9e2bcccf8a9c3b2bdcff9ae466e69715a5b05544 Mon Sep 17 00:00:00 2001 From: Nick Breitling Date: Sun, 7 Jun 2026 23:59:48 -0500 Subject: [PATCH 5/8] fix missing recursive call after bytes --- src/Network/MPD/Core.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Network/MPD/Core.hs b/src/Network/MPD/Core.hs index 87dad6e7..3c492a9e 100644 --- a/src/Network/MPD/Core.hs +++ b/src/Network/MPD/Core.hs @@ -206,7 +206,7 @@ mpdSend str = send' `catchError` handler = do bytes <- B.hGet handle nBytes _ <- B.hGetLine handle -- newline after the byte string - return (Bytes bytes:acc) + getLines handle (Bytes bytes:acc) | "OK" `isPrefixOf` l || "ACK" `isPrefixOf` l = (return . reverse) (Text l:acc) | otherwise = getLines handle (Text l:acc) action From 2417ef4f43c77cce992596fb6afa99854bb3b143 Mon Sep 17 00:00:00 2001 From: Nick Breitling Date: Wed, 24 Jun 2026 16:31:50 -0500 Subject: [PATCH 6/8] readPicture command --- src/Network/MPD/Applicative/Database.hs | 15 +++++++++++++++ src/Network/MPD/Commands/Database.hs | 12 ++++++++++++ tests/Network/MPD/Applicative/DatabaseSpec.hs | 14 ++++++++++++++ 3 files changed, 41 insertions(+) diff --git a/src/Network/MPD/Applicative/Database.hs b/src/Network/MPD/Applicative/Database.hs index 5d52f17c..88d23216 100644 --- a/src/Network/MPD/Applicative/Database.hs +++ b/src/Network/MPD/Applicative/Database.hs @@ -14,6 +14,7 @@ The music database. module Network.MPD.Applicative.Database ( albumArt + , readPicture , count , find , findAdd @@ -40,12 +41,26 @@ import Network.MPD.Applicative.Util -- | Locate album art for the given song and return a chunk of an album art -- image file at offset 'offset'. +-- +-- This is currently implemented by searching the directory the file resides in +-- for a file called cover.png, cover.jpg, cover.jxl, or cover.webp. albumArt :: Path -> Integer -> Command AlbumArtChunk albumArt uri offset = Command p ["albumart" <@> uri <++> offset] where p :: Parser AlbumArtChunk p = liftParser parseAlbumArtChunk +-- | Locate a picture for the given song and return a chunk of the image file at +-- offset 'offset'. +-- +-- This is usually implemented by reading embedded pictures from binary tags +-- (e.g. ID3v2’s APIC tag). +readPicture :: Path -> Integer -> Command AlbumArtChunk +readPicture uri offset = Command p ["readpicture" <@> uri <++> offset] + where + p :: Parser AlbumArtChunk + p = liftParser parseAlbumArtChunk + -- | Get a count of songs and their total playtime that exactly match the -- query. count :: Query -> Command Count diff --git a/src/Network/MPD/Commands/Database.hs b/src/Network/MPD/Commands/Database.hs index dff8c075..383520b9 100644 --- a/src/Network/MPD/Commands/Database.hs +++ b/src/Network/MPD/Commands/Database.hs @@ -14,6 +14,7 @@ The music database. module Network.MPD.Commands.Database ( albumArt + , readPicture , count , find , findAdd @@ -37,9 +38,20 @@ import Network.MPD.Core -- | Locate album art for the given song and return a chunk of an album art -- image file at offset 'offset'. +-- +-- This is currently implemented by searching the directory the file resides in +-- for a file called cover.png, cover.jpg, cover.jxl, or cover.webp. albumArt :: MonadMPD m => Path -> Integer -> m AlbumArtChunk albumArt uri = A.runCommand . A.albumArt uri +-- | Locate a picture for the given song and return a chunk of the image file at +-- offset 'offset'. +-- +-- This is usually implemented by reading embedded pictures from binary tags +-- (e.g. ID3v2’s APIC tag). +readPicture :: MonadMPD m => Path -> Integer -> m AlbumArtChunk +readPicture uri = A.runCommand . A.readPicture uri + -- | Count the number of entries matching a query. count :: MonadMPD m => Query -> m Count count = A.runCommand . A.count diff --git a/tests/Network/MPD/Applicative/DatabaseSpec.hs b/tests/Network/MPD/Applicative/DatabaseSpec.hs index dc8e9bd0..63f43cf2 100644 --- a/tests/Network/MPD/Applicative/DatabaseSpec.hs +++ b/tests/Network/MPD/Applicative/DatabaseSpec.hs @@ -27,6 +27,20 @@ spec = do , Right "size: 64\nbinary: 6\nbarbaz\nOK")] `shouldBe` Right (AlbumArtChunk 64 "barbaz") + describe "readPicture" $ do + it "returns a chunk of the album artwork" $ do + albumArt "Bar.ogg" 0 + `with` [("albumart \"Bar.ogg\" 0" + , Right "size: 64\nbinary: 6\nfoobar\nOK")] + `shouldBe` Right (AlbumArtChunk 64 "foobar") + + describe "readPicture" $ do + it "returns a chunk of the album artwork at an offset" $ do + albumArt "Bar.ogg" 3 + `with` [("albumart \"Bar.ogg\" 3" + , Right "size: 64\nbinary: 6\nbarbaz\nOK")] + `shouldBe` Right (AlbumArtChunk 64 "barbaz") + describe "count" $ do it "returns a count of entries matching a query" $ do count (Title =? "Foo") From 720826ba2829ed1e92609e53925eacd426977b9a Mon Sep 17 00:00:00 2001 From: Nick Breitling Date: Wed, 24 Jun 2026 16:57:48 -0500 Subject: [PATCH 7/8] add MIME type field to AlbumArtChunk --- src/Network/MPD/Commands/Parse.hs | 1 + src/Network/MPD/Commands/Types.hs | 7 ++++--- tests/Arbitrary.hs | 2 +- tests/Network/MPD/Applicative/DatabaseSpec.hs | 15 +++++++++++---- tests/Unparse.hs | 12 +++++++----- 5 files changed, 24 insertions(+), 13 deletions(-) diff --git a/src/Network/MPD/Commands/Parse.hs b/src/Network/MPD/Commands/Parse.hs index 00d5933a..93b3fda3 100644 --- a/src/Network/MPD/Commands/Parse.hs +++ b/src/Network/MPD/Commands/Parse.hs @@ -29,6 +29,7 @@ parseAlbumArtChunk = foldM f def . toAssocList where f a ("size", x) = return $ parse parseNum (\x' -> a {aacSize = x'}) a x + f a ("type", x) = return $ a {aacType = Just $ UTF8.toString x} f a ("binary", x) = return $ a {aacBytes = x} f _ x = Left $ show x diff --git a/src/Network/MPD/Commands/Types.hs b/src/Network/MPD/Commands/Types.hs index 0e9a3b0d..8ff6b5c0 100644 --- a/src/Network/MPD/Commands/Types.hs +++ b/src/Network/MPD/Commands/Types.hs @@ -220,13 +220,14 @@ instance MPDArg ReplayGainMode where -- | Represents the result of running 'albumart' data AlbumArtChunk = - AlbumArtChunk { aacSize :: Integer -- ^ File size of the album art - , aacBytes :: ByteString -- ^ Raw bytes read + AlbumArtChunk { aacSize :: Integer -- ^ File size of the album art + , aacType :: Maybe String -- ^ The file's MIME type (optional, only valid for readPicture) + , aacBytes :: ByteString -- ^ Raw bytes read } deriving (Eq, Show) defaultAlbumArtChunk :: AlbumArtChunk -defaultAlbumArtChunk = AlbumArtChunk { aacSize = 0, aacBytes = empty } +defaultAlbumArtChunk = AlbumArtChunk { aacSize = 0, aacType = Nothing, aacBytes = empty } instance Default AlbumArtChunk where def = defaultAlbumArtChunk diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs index 42b55084..de4cb960 100644 --- a/tests/Arbitrary.hs +++ b/tests/Arbitrary.hs @@ -116,7 +116,7 @@ instance Arbitrary DateString where return . DS . UTF8.fromString . concat . intersperse "-" $ map show [y,m,d] instance Arbitrary AlbumArtChunk where - arbitrary = liftM2 AlbumArtChunk arbitrary arbitrary + arbitrary = liftM3 AlbumArtChunk arbitrary (possibly field) arbitrary instance Arbitrary Count where arbitrary = liftM2 Count arbitrary arbitrary diff --git a/tests/Network/MPD/Applicative/DatabaseSpec.hs b/tests/Network/MPD/Applicative/DatabaseSpec.hs index 63f43cf2..a6d11280 100644 --- a/tests/Network/MPD/Applicative/DatabaseSpec.hs +++ b/tests/Network/MPD/Applicative/DatabaseSpec.hs @@ -18,28 +18,35 @@ spec = do albumArt "Bar.ogg" 0 `with` [("albumart \"Bar.ogg\" 0" , Right "size: 64\nbinary: 6\nfoobar\nOK")] - `shouldBe` Right (AlbumArtChunk 64 "foobar") + `shouldBe` Right (AlbumArtChunk 64 Nothing "foobar") describe "albumArt" $ do it "returns a chunk of the album artwork at an offset" $ do albumArt "Bar.ogg" 3 `with` [("albumart \"Bar.ogg\" 3" , Right "size: 64\nbinary: 6\nbarbaz\nOK")] - `shouldBe` Right (AlbumArtChunk 64 "barbaz") + `shouldBe` Right (AlbumArtChunk 64 Nothing "barbaz") describe "readPicture" $ do it "returns a chunk of the album artwork" $ do albumArt "Bar.ogg" 0 `with` [("albumart \"Bar.ogg\" 0" , Right "size: 64\nbinary: 6\nfoobar\nOK")] - `shouldBe` Right (AlbumArtChunk 64 "foobar") + `shouldBe` Right (AlbumArtChunk 64 Nothing "foobar") describe "readPicture" $ do it "returns a chunk of the album artwork at an offset" $ do albumArt "Bar.ogg" 3 `with` [("albumart \"Bar.ogg\" 3" , Right "size: 64\nbinary: 6\nbarbaz\nOK")] - `shouldBe` Right (AlbumArtChunk 64 "barbaz") + `shouldBe` Right (AlbumArtChunk 64 Nothing "barbaz") + + describe "readPicture" $ do + it "returns the MIME type if it can be determined" $ do + albumArt "Bar.ogg" 3 + `with` [("albumart \"Bar.ogg\" 3" + , Right "size: 64\ntype: image/jpeg\nbinary: 6\nbarbaz\nOK")] + `shouldBe` Right (AlbumArtChunk 64 (Just "image/jpeg") "barbaz") describe "count" $ do it "returns a count of entries matching a query" $ do diff --git a/tests/Unparse.hs b/tests/Unparse.hs index 67ea35e5..6b46b212 100644 --- a/tests/Unparse.hs +++ b/tests/Unparse.hs @@ -16,11 +16,13 @@ instance Unparse a => Unparse (Maybe a) where unparse (Just x) = unparse x instance Unparse AlbumArtChunk where - unparse aac = unlines - [ "size: " ++ show (aacSize aac) - , "binary: " ++ show (B.length (aacBytes aac)) - , UTF8.toString $ aacBytes aac - ] + unparse aac = + let ty = maybe [] (\t -> ["type: " ++ t]) (aacType aac) + in unlines $ ty + ++ [ "size: " ++ show (aacSize aac) + , "binary: " ++ show (B.length (aacBytes aac)) + , UTF8.toString $ aacBytes aac + ] instance Unparse Count where unparse x = unlines From 69a7bc37c17eb00c5df4b46f8b22103a01ca74f7 Mon Sep 17 00:00:00 2001 From: Nick Breitling Date: Thu, 25 Jun 2026 11:34:29 -0500 Subject: [PATCH 8/8] make readPicture return Maybe, improve docs and tests --- src/Network/MPD/Applicative/Database.hs | 19 ++++++++------ src/Network/MPD/Commands/Database.hs | 19 ++++++++------ src/Network/MPD/Commands/Parse.hs | 4 +++ src/Network/MPD/Commands/Types.hs | 4 +-- tests/Network/MPD/Applicative/DatabaseSpec.hs | 25 ++++++++++++------- 5 files changed, 46 insertions(+), 25 deletions(-) diff --git a/src/Network/MPD/Applicative/Database.hs b/src/Network/MPD/Applicative/Database.hs index 88d23216..b8c0b935 100644 --- a/src/Network/MPD/Applicative/Database.hs +++ b/src/Network/MPD/Applicative/Database.hs @@ -40,11 +40,14 @@ import Network.MPD.Applicative.Internal import Network.MPD.Applicative.Util -- | Locate album art for the given song and return a chunk of an album art --- image file at offset 'offset'. +-- image file at an offset. -- -- This is currently implemented by searching the directory the file resides in --- for a file called cover.png, cover.jpg, cover.jxl, or cover.webp. -albumArt :: Path -> Integer -> Command AlbumArtChunk +-- for a file called cover.png, cover.jpg, cover.jxl, or cover.webp. If there is +-- no artwork file present, the returned command will produce 'FileNotFound'. +albumArt :: Path -- ^ Path of the song to locate album art for. + -> Integer -- ^ Byte offset of the beginning of the chunk. + -> Command AlbumArtChunk albumArt uri offset = Command p ["albumart" <@> uri <++> offset] where p :: Parser AlbumArtChunk @@ -54,12 +57,14 @@ albumArt uri offset = Command p ["albumart" <@> uri <++> offset] -- offset 'offset'. -- -- This is usually implemented by reading embedded pictures from binary tags --- (e.g. ID3v2’s APIC tag). -readPicture :: Path -> Integer -> Command AlbumArtChunk +-- (e.g. ID3v2’s APIC tag). If there is no artwork tag present, returns 'Nothing'. +readPicture :: Path -- ^ Path of the song to locate album art for. + -> Integer -- ^ Byte offset of the beginning of the chunk. + -> Command (Maybe AlbumArtChunk) readPicture uri offset = Command p ["readpicture" <@> uri <++> offset] where - p :: Parser AlbumArtChunk - p = liftParser parseAlbumArtChunk + p :: Parser (Maybe AlbumArtChunk) + p = liftParser parseMaybeAlbumArtChunk -- | Get a count of songs and their total playtime that exactly match the -- query. diff --git a/src/Network/MPD/Commands/Database.hs b/src/Network/MPD/Commands/Database.hs index 383520b9..4e69a729 100644 --- a/src/Network/MPD/Commands/Database.hs +++ b/src/Network/MPD/Commands/Database.hs @@ -37,19 +37,24 @@ import Network.MPD.Commands.Types import Network.MPD.Core -- | Locate album art for the given song and return a chunk of an album art --- image file at offset 'offset'. +-- image file at an offset. -- -- This is currently implemented by searching the directory the file resides in --- for a file called cover.png, cover.jpg, cover.jxl, or cover.webp. -albumArt :: MonadMPD m => Path -> Integer -> m AlbumArtChunk +-- for a file called cover.png, cover.jpg, cover.jxl, or cover.webp. If there is +-- no artwork file present, throws 'FileNotFound'. +albumArt :: MonadMPD m => Path -- ^ Path of the song to locate album art for. + -> Integer -- ^ Byte offset of the beginning of the chunk. + -> m AlbumArtChunk albumArt uri = A.runCommand . A.albumArt uri --- | Locate a picture for the given song and return a chunk of the image file at --- offset 'offset'. +-- | Locate embedded album art for the given song and return a chunk of the +-- album art at an offset. -- -- This is usually implemented by reading embedded pictures from binary tags --- (e.g. ID3v2’s APIC tag). -readPicture :: MonadMPD m => Path -> Integer -> m AlbumArtChunk +-- (e.g. ID3v2’s APIC tag). If there is no artwork tag present, returns 'Nothing'. +readPicture :: MonadMPD m => Path -- ^ Path of the song to locate album art for. + -> Integer -- ^ Byte offset of the beginning of the chunk. + -> m (Maybe AlbumArtChunk) readPicture uri = A.runCommand . A.readPicture uri -- | Count the number of entries matching a query. diff --git a/src/Network/MPD/Commands/Parse.hs b/src/Network/MPD/Commands/Parse.hs index 93b3fda3..39f6f084 100644 --- a/src/Network/MPD/Commands/Parse.hs +++ b/src/Network/MPD/Commands/Parse.hs @@ -23,6 +23,10 @@ import Network.MPD.Util import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.UTF8 as UTF8 +parseMaybeAlbumArtChunk :: [ResponseEntry] -> Either String (Maybe AlbumArtChunk) +parseMaybeAlbumArtChunk xs | null xs = Right Nothing + | otherwise = Just <$> parseAlbumArtChunk xs + -- | Builds an 'AlbumArtChunk' instance from an assoc. list. parseAlbumArtChunk :: [ResponseEntry] -> Either String AlbumArtChunk parseAlbumArtChunk = foldM f def . toAssocList diff --git a/src/Network/MPD/Commands/Types.hs b/src/Network/MPD/Commands/Types.hs index 8ff6b5c0..a798fe51 100644 --- a/src/Network/MPD/Commands/Types.hs +++ b/src/Network/MPD/Commands/Types.hs @@ -218,10 +218,10 @@ instance MPDArg ReplayGainMode where prep AlbumMode = Args ["album"] prep AutoMode = Args ["auto"] --- | Represents the result of running 'albumart' +-- | A binary chunk of an album art tag or file, obtained with 'readPicture' or 'albumArt'. data AlbumArtChunk = AlbumArtChunk { aacSize :: Integer -- ^ File size of the album art - , aacType :: Maybe String -- ^ The file's MIME type (optional, only valid for readPicture) + , aacType :: Maybe String -- ^ The file's MIME type (optional; only valid for readPicture) , aacBytes :: ByteString -- ^ Raw bytes read } deriving (Eq, Show) diff --git a/tests/Network/MPD/Applicative/DatabaseSpec.hs b/tests/Network/MPD/Applicative/DatabaseSpec.hs index a6d11280..74ddbf7d 100644 --- a/tests/Network/MPD/Applicative/DatabaseSpec.hs +++ b/tests/Network/MPD/Applicative/DatabaseSpec.hs @@ -29,24 +29,31 @@ spec = do describe "readPicture" $ do it "returns a chunk of the album artwork" $ do - albumArt "Bar.ogg" 0 - `with` [("albumart \"Bar.ogg\" 0" + readPicture "Bar.ogg" 0 + `with` [("readpicture \"Bar.ogg\" 0" , Right "size: 64\nbinary: 6\nfoobar\nOK")] - `shouldBe` Right (AlbumArtChunk 64 Nothing "foobar") + `shouldBe` Right (Just (AlbumArtChunk 64 Nothing "foobar")) describe "readPicture" $ do it "returns a chunk of the album artwork at an offset" $ do - albumArt "Bar.ogg" 3 - `with` [("albumart \"Bar.ogg\" 3" + readPicture "Bar.ogg" 3 + `with` [("readpicture \"Bar.ogg\" 3" , Right "size: 64\nbinary: 6\nbarbaz\nOK")] - `shouldBe` Right (AlbumArtChunk 64 Nothing "barbaz") + `shouldBe` Right (Just (AlbumArtChunk 64 Nothing "barbaz")) describe "readPicture" $ do it "returns the MIME type if it can be determined" $ do - albumArt "Bar.ogg" 3 - `with` [("albumart \"Bar.ogg\" 3" + readPicture "Bar.ogg" 3 + `with` [("readpicture \"Bar.ogg\" 3" , Right "size: 64\ntype: image/jpeg\nbinary: 6\nbarbaz\nOK")] - `shouldBe` Right (AlbumArtChunk 64 (Just "image/jpeg") "barbaz") + `shouldBe` Right (Just (AlbumArtChunk 64 (Just "image/jpeg") "barbaz")) + + describe "readPicture" $ do + it "returns Nothing if no file is found" $ do + readPicture "Bar.ogg" 3 + `with` [("readpicture \"Bar.ogg\" 3" + , Right "OK")] + `shouldBe` Right Nothing describe "count" $ do it "returns a count of entries matching a query" $ do