Add support for binary responses

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]

src/Network/MPD/Applicative/Database.hs

@@ -13,7 +13,9 @@ The music database.
 -}
 
 module Network.MPD.Applicative.Database
-    ( count
+    ( albumArt
+    , readPicture
+    , count
     , find
     , findAdd
     , list
@@ -37,6 +39,33 @@ 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 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. 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
+        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). 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 (Maybe AlbumArtChunk)
+        p = liftParser parseMaybeAlbumArtChunk
+
 -- | Get a count of songs and their total playtime that exactly match the
 -- query.
 count :: Query -> Command Count

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

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

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

src/Network/MPD/Commands.hs

@@ -28,6 +28,7 @@ module Network.MPD.Commands (
     , PlaybackState(..)
     , Subsystem(..)
     , ReplayGainMode(..)
+    , AlbumArtChunk(..)
     , Count(..)
     , LsResult(..)
     , Device(..)

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

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

src/Network/MPD/Commands/Database.hs

@@ -13,7 +13,9 @@ The music database.
 -}
 
 module Network.MPD.Commands.Database
-    ( count
+    ( albumArt
+    , readPicture
+    , count
     , find
     , findAdd
     , list
@@ -34,6 +36,27 @@ 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 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. 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 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). 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.
 count :: MonadMPD m => Query -> m Count
 count = A.runCommand . A.count

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)
@@ -21,8 +23,22 @@ 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
+    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
+
 -- | 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 +48,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 +60,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 +79,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
 

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,20 @@ instance MPDArg ReplayGainMode where
     prep AlbumMode = Args ["album"]
     prep AutoMode = Args ["auto"]
 
+-- | 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)
+                  , aacBytes  :: ByteString   -- ^ Raw bytes read
+                  }
+    deriving (Eq, Show)
+
+defaultAlbumArtChunk :: AlbumArtChunk
+defaultAlbumArtChunk = AlbumArtChunk { aacSize = 0, aacType = Nothing, 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