diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,17 @@ +# v2.0 +- Major code rewrite. +- Add command-line flags: + - `-n`: is an alias for `--next` + - `-nn`: is an alias for `--next-only` + - `--next`: Include information about the next queued song in the + output JSON. + - `--next-only`: Print only the next queued song's information, + replacing the `tags` object. +- Add support for multi-value tags such as multiple artists. If a tag + contains multiple values it should be displayed as an array in the + output json. +- Major performance increase. + # v1.5.0.1 - Fix `next_filename` to display correct filename URI. - It was using Id instead of Position. Position is a 0-indexed diff --git a/lib/Network/MPD/JSON.hs b/lib/Network/MPD/JSON.hs new file mode 100644 --- /dev/null +++ b/lib/Network/MPD/JSON.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE OverloadedStrings #-} +module Network.MPD.JSON + ( objectMaybes + , jsonSongTags + , tagFieldToJSON + , (.=?) + ) +where + +import Network.MPD.Parse + ( ExtractedTags(..), TagField(..) ) +import Data.Aeson + ( Value, KeyValue((.=)), ToJSON(toJSON), Key, object ) +import qualified Data.ByteString.Lazy.Char8 as C +import Data.Aeson.Types ( Pair ) +import Data.Maybe ( catMaybes ) + +{- | Helper function for creating an JSON 'Data.Aeson.object' where +'Data.Maybe.catMaybes' won't include items from the @[Maybe +'Data.Aeson.Types.Pair']@ list that return 'Nothing'. + +Meant for using with the '(.=?)' operator to remove JSON values from +the output that would contain @null@ otherwise. +-} +objectMaybes :: [Maybe Pair] -> Value +objectMaybes = object . catMaybes + +-- | Create a 'Data.Aeson.Value' that can be encoded into a +-- @ByteString@ of conventional JSON with 'Data.Aeson.encode'. +jsonSongTags :: ExtractedTags -> Value +jsonSongTags song = objectMaybes + [ "artist" .=? tagFieldToJSON (artist song) + , "artist_sort" .=? tagFieldToJSON (artistSort song) + , "album" .=? tagFieldToJSON (album song) + , "album_sort" .=? tagFieldToJSON (albumSort song) + , "album_artist" .=? tagFieldToJSON (albumArtist song) + , "album_artist_sort" .=? tagFieldToJSON (albumArtistSort song) + , "title" .=? tagFieldToJSON (title song) + , "track" .=? tagFieldToJSON (track song) + , "name" .=? tagFieldToJSON (name song) + , "genre" .=? tagFieldToJSON (genre song) + , "date" .=? tagFieldToJSON (date song) + , "original_date" .=? tagFieldToJSON (originalDate song) + , "composer" .=? tagFieldToJSON (composer song) + , "performer" .=? tagFieldToJSON (performer song) + , "conductor" .=? tagFieldToJSON (conductor song) + , "work" .=? tagFieldToJSON (work song) + , "grouping" .=? tagFieldToJSON (grouping song) + , "comment" .=? tagFieldToJSON (comment song) + , "disc" .=? tagFieldToJSON (disc song) + , "label" .=? tagFieldToJSON (label song) + , "musicbrainz_artistid" .=? tagFieldToJSON (musicbrainz_ArtistId song) + , "musicbrainz_albumid" .=? tagFieldToJSON (musicbrainz_AlbumId song) + , "musicbrainz_albumartistid" .=? tagFieldToJSON (musicbrainz_AlbumartistId song) + , "musicbrainz_trackid" .=? tagFieldToJSON (musicbrainz_TrackId song) + , "musicbrainz_releasetrackid" .=? tagFieldToJSON (musicbrainz_ReleasetrackId song) + , "musicbrainz_workid" .=? tagFieldToJSON (musicbrainz_WorkId song) + ] + +-- | Convert constructor arguments of 'TagField', specially @String@ +-- or @[String]@ under @Maybe@, into a 'Data.Aeson.Value' supported +-- for encoding. Since 'jsonSongTags' expects @Maybe Value@, extract +-- them from 'TagField'. +tagFieldToJSON :: TagField -> Maybe Value +tagFieldToJSON (SingleTagField ms) = toJSON <$> ms +tagFieldToJSON (MultiTagField ml) = toJSON <$> ml + +{- | Check if @Maybe v@ exists and is of type expected by +'Data.Aeson.object' as defined in 'Data.Aeson.Value', if it is return +both the @key@ and @value@ within the @Maybe@ context tied with +'Data.Aeson..='. This gives support to \'optional\' fields using +'Data.Maybe.catMaybes' that discard @Nothing@ values and is meant to +prevent creating JSON key/value pairs with @null@ values, e.g.: + +@ +jsonTags = object . catMaybes $ + [ "artist" .=? artist + , "album" .=? album + , "title" .=? title + ] +@ + +Where if a value on the right is @Nothing@ that key/value pair will +not be included in 'Data.Aeson.object' because of +'Data.Maybe.catMaybes'. +-} +(.=?) :: (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a +key .=? Just value = Just (key .= value) +_ .=? Nothing = Nothing +infixr 8 .=? diff --git a/lib/Network/MPD/Parse.hs b/lib/Network/MPD/Parse.hs --- a/lib/Network/MPD/Parse.hs +++ b/lib/Network/MPD/Parse.hs @@ -1,32 +1,112 @@ module Network.MPD.Parse - ( getStatusField + ( TagField (..) + , ExtractedTags (..) + , getAllTags + , getStatusField , getStatusFieldElement + , SongCurrentOrNext(..) , getTag - , processSong + , songToTagField , maybePathCurrentSong , maybePathNextPlaylistSong - , headMay - , valueToStringMay - , (.=?) - , objectJson + , singleValueToString + , multiValueToString , getStatusIdInt - ) where + ) +where import qualified Network.MPD as MPD import Network.MPD ( Metadata(..), Song, PlaybackState(Stopped, Playing, Paused) ) -import Data.Aeson ( object, Key, KeyValue(..), ToJSON, Value ) -import Data.Aeson.Types ( Pair ) -import Data.Maybe ( catMaybes, fromMaybe ) +import Data.Maybe ( fromMaybe ) +import Data.List ( (!?) ) -{- | Extract a field from the returned MPD.Status data record. +{- | Wrapper for the output of 'getTag', which internally uses +'Network.MPD.sgGetTag' to retrieve @Maybe@ ['Network.MPD.Value'] that +are then converted to @TagField@. This allows handling multi-value +tags like multiple artists. +-} +data TagField = SingleTagField !(Maybe String) + | MultiTagField !(Maybe [String]) + deriving (Show, Eq) -Helper to extract a specific field from the -[Network.MPD.Status](Network.MPD#Status) data record by providing the -corresponding field label. If the input status "@st@" is /not/ @Right a@, -indicating an error, or the field label function is not applicable, it -returns @Nothing@. +{- | Store the parsed output of 'getTag'. +Each field represents a supported MPD tag. +-} +data ExtractedTags = ExtractedTags + { artist :: !TagField + , artistSort :: !TagField + , album :: !TagField + , albumSort :: !TagField + , albumArtist :: !TagField + , albumArtistSort :: !TagField + , title :: !TagField + , track :: !TagField + , name :: !TagField + , genre :: !TagField + , date :: !TagField + , originalDate :: !TagField + , composer :: !TagField + , performer :: !TagField + , conductor :: !TagField + , work :: !TagField + , grouping :: !TagField + , comment :: !TagField + , disc :: !TagField + , label :: !TagField + , musicbrainz_ArtistId :: !TagField + , musicbrainz_AlbumId :: !TagField + , musicbrainz_AlbumartistId :: !TagField + , musicbrainz_TrackId :: !TagField + , musicbrainz_ReleasetrackId :: !TagField + , musicbrainz_WorkId :: !TagField + } + +{- | Assign 'getTag' returned values to 'ExtractedTags'. + +Takes either a song @Current s@ or @Next s@, because their object +format differs, see 'SongCurrentOrNext'. +-} +getAllTags :: SongCurrentOrNext -> ExtractedTags +getAllTags s = ExtractedTags + { artist = f Artist s + , artistSort = f ArtistSort s + , album = f Album s + , albumSort = f AlbumSort s + , albumArtist = f AlbumArtist s + , albumArtistSort = f AlbumArtistSort s + , title = f Title s + , track = f Track s + , name = f Name s + , genre = f Genre s + , date = f Date s + , originalDate = f OriginalDate s + , composer = f Composer s + , performer = f Performer s + , conductor = f Conductor s + , work = f Work s + , grouping = f Grouping s + , comment = f Comment s + , disc = f Disc s + , label = f Label s + , musicbrainz_ArtistId = f MUSICBRAINZ_ARTISTID s + , musicbrainz_AlbumId = f MUSICBRAINZ_ALBUMID s + , musicbrainz_AlbumartistId = f MUSICBRAINZ_ALBUMARTISTID s + , musicbrainz_TrackId = f MUSICBRAINZ_TRACKID s + , musicbrainz_ReleasetrackId = f MUSICBRAINZ_RELEASETRACKID s + , musicbrainz_WorkId = f MUSICBRAINZ_WORKID s + } + where + f = getTag + +{- | Extract a field from the returned 'Network.MPD.Status' data record. + +Helper to extract a specific field from the 'Network.MPD.Status' data +record by providing the corresponding field label. If the input status +"@st@" is /not/ @Right a@, indicating an error, or the field label +function is not applicable, it returns @Nothing@. + ==== __Example__: @ @@ -55,25 +135,64 @@ getStatusFieldElement :: MPD.Response MPD.Status -> (MPD.Status -> Maybe a) -> Maybe a getStatusFieldElement status item = fromMaybe Nothing $ getStatusField status item -{- | @Either@ check for the returned value of 'Network.MPD.currentSong', -then call 'processSong' or return @Nothing@. +-- | Alias for the output of 'Network.MPD.currentSong'. +type CurrentSong = MPD.Response (Maybe Song) + +-- | Alias for the output of 'Network.MPD.playlistInfo'. +type NextSong = MPD.Response [Song] + +-- | Wrapper for 'getTag' to expect either @Maybe Song@ or +-- @[Song]@. This simplifies 'getAllTags'. +data SongCurrentOrNext = Current !CurrentSong + | Next !NextSong + +-- | Retrieve @tag@, which should be one of 'Network.MPD.Metadata', from +-- 'CurrentSong' or 'NextSong'. +getTag :: Metadata -> SongCurrentOrNext -> TagField +getTag tag (Current song) = + case song of + Left _ -> SingleTagField Nothing + Right (Just s) -> songToTagField tag s +getTag tag (Next song) = + case song of + Right [s] -> songToTagField tag s + Left _ -> SingleTagField Nothing + _any -> SingleTagField Nothing + +{- | Extract a @tag@ 'Network.MPD.Value' from 'Network.MPD.Song' using +'Network.MPD.sgGetTag', convert the output to either @Maybe String@ or +@Maybe [String]@ and wrap it in 'TagField'. + +Because 'Network.MPD.sgGetTag' returns @Maybe@ ['Network.MPD.Value'] +where @Value@ is an instance of @ByteString@ it also offers helper +conversion functions, so convert it to @String@ if the field only +contains a list of one value or convert all ['Network.MPD.Value'] list +items to @String@ and return the list. -} -getTag :: Metadata -> Either a (Maybe Song) -> Maybe String -getTag t c = - case c of - Left _ -> Nothing - Right song -> processSong t song +songToTagField :: Metadata -> Song -> TagField +songToTagField tag song = tagSingleOrList (MPD.sgGetTag tag song) + where + tagSingleOrList :: Maybe [MPD.Value] -> TagField + tagSingleOrList val | fmap length val == Just 1 = SingleTagField $ singleValueToString $ (fromMaybe [] val) !? 0 + | fmap length val > Just 1 = MultiTagField $ multiValueToString val + | otherwise = SingleTagField Nothing -{- | Use 'Network.MPD.sgGetTag' to extract a @tag@ from a @song@, safely -get only the head item of the returned @Maybe@ list, then safely -convert it to a string. +{- | Convert 'Network.MPD.Value' to @String@ within a @Maybe@ context. + +'MPD.sgGetTag' returns a @Maybe [Value]@. [libmpd](Network.MPD) also +provides 'Network.MPD.toString' that can also, along with @ByteString@ +and @Text@, convert a 'Network.MPD.Value' to a @String@. -} -processSong :: Metadata -> Maybe Song -> Maybe String -processSong _ Nothing = Nothing -processSong tag (Just song) = do - let tagVal = MPD.sgGetTag tag song - valueToStringMay =<< (headMay =<< tagVal) +singleValueToString :: Maybe MPD.Value -> Maybe String +singleValueToString (Just x) = Just (MPD.toString x) +singleValueToString Nothing = Nothing +-- | Same as 'singleValueToString' but converts all @Value@s in the +-- multi-value-tag list to @String@ and returns the list. +multiValueToString :: Maybe [MPD.Value] -> Maybe [String] +multiValueToString (Just x) = Just $ map MPD.toString x +multiValueToString Nothing = Nothing + {- | Get the current 'Network.MPD.Song' relative path with 'Network.MPD.sgFilePath' -} maybePathCurrentSong :: MPD.Response (Maybe Song) -> Maybe String @@ -93,65 +212,8 @@ maybePathNextPlaylistSong (Right (_:_:_)) = Nothing maybePathNextPlaylistSong (Right [s]) = Just $ MPD.toString $ MPD.sgFilePath s -{- | Safely get the head of a list. Same as [Safe.headMay](Safe#headMay). --} -headMay :: [a] -> Maybe a -headMay [] = Nothing -headMay (x:_) = Just x - -{- | Convert 'Network.MPD.Value' to @String@ within a @Maybe@ context. - -This @Value@ is from 'Network.MPD' and is basically the same as a -@String@ but used internally to store metadata values. - -==== __Example__: - -@ -processSong :: Metadata -> Maybe Song -> Maybe String -processSong _ Nothing = Nothing -processSong tag (Just song) = do - let tagVal = MPD.sgGetTag tag song - valueToStringMay =<< (headMay =<< tagVal) -@ - -'MPD.sgGetTag' returns a @Maybe [Value]@. [libmpd](Network.MPD) also provides -'Network.MPD.toString' that can convert, along other types, a -'Network.MPD.Value' to a @String@. --} -valueToStringMay :: MPD.Value -> Maybe String -valueToStringMay x = Just (MPD.toString x) - -{- | Check if @Maybe v@ exists and is of type expected by -'Data.Aeson.object' as defined in 'Data.Aeson.Value', if it is return -both the @key@ and @value@ within the @Maybe@ context tied with -'Data.Aeson..='. This gives support to \'optional\' fields using -'Data.Maybe.catMaybes' that discard @Nothing@ values and is meant to -prevent creating JSON key/value pairs with @null@ values, e.g.: - -@ -jsonTags = object . catMaybes $ - [ "artist" .=? artist - , "album" .=? album - , "title" .=? title - ] -@ - -Where if a value on the right is @Nothing@ that key/value pair will -not be included in 'Data.Aeson.object' because of -'Data.Maybe.catMaybes'. --} -(.=?) :: (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a -key .=? Just value = Just (key .= value) -_ .=? Nothing = Nothing - --- | Helper function for creating an JSON 'Data.Aeson.object' where --- 'Data.Maybe.catMaybes' won't include items from the '[Maybe Pair]' --- list that return 'Nothing'. -objectJson :: [Maybe Pair] -> Value -objectJson = object . catMaybes - --- | Extracts the 'Int' value from an 'MPD.Id' within 'MPD.Status', if --- present and the 'Either' value is a 'Right'. +-- | Extracts the 'Int' value from an 'Network.MPD.Id' within +-- 'Network.MPD.Status', if present and the 'Either' value is 'Right'. getStatusIdInt :: (MPD.Status -> Maybe MPD.Id) -> Either MPD.MPDError MPD.Status -> Maybe Int getStatusIdInt item status = case m of diff --git a/mpd-current-json.cabal b/mpd-current-json.cabal --- a/mpd-current-json.cabal +++ b/mpd-current-json.cabal @@ -7,9 +7,10 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 1.5.0.1 +version: 2.0.0.0 synopsis: Print current MPD song and status as JSON +tested-with: GHC == { 9.10.1, 9.4.8 } -- A longer description of the package. description: Print currently playing MPD's song metadata and status as JSON homepage: https://codeberg.org/useless-utils/mpd-current-json @@ -31,14 +32,15 @@ type: git location: https://codeberg.org/useless-utils/mpd-current-json --- tested-with: GHC == 9.4.8 - library -- exposed: False exposed-modules: Network.MPD.Parse + Network.MPD.JSON build-depends: base >=4.16 && <5 , libmpd == 0.10.* , aeson == 2.2.* + , aeson-pretty == 0.8.* + , bytestring >=0.11 && <0.13 hs-source-dirs: lib default-language: Haskell2010 @@ -58,9 +60,9 @@ , libmpd , optparse-applicative == 0.18.* , aeson - , bytestring >=0.11 && <0.13 - , aeson-pretty == 0.8.* - , mpd-current-json == 1.5.* + , aeson-pretty + , bytestring + , mpd-current-json -- Directories containing source files. hs-source-dirs: src diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -3,26 +3,28 @@ module Main ( main ) where import qualified Network.MPD as MPD -import Network.MPD - ( Metadata(..), PlaybackState(Stopped, Playing, Paused) ) +import Network.MPD ( PlaybackState(Stopped, Playing, Paused) ) + +import Network.MPD.Parse + ( getAllTags, + getStatusField, + getStatusFieldElement, + getStatusIdInt, + maybePathCurrentSong, + maybePathNextPlaylistSong, + SongCurrentOrNext(..) ) +import Network.MPD.JSON ( objectMaybes, jsonSongTags, (.=?) ) +import Options + ( optsParserInfo, execParser, Opts(..), NextSongFlag(..) ) + import Data.Aeson ( object, KeyValue((.=)) ) import Data.Aeson.Encode.Pretty - ( defConfig, encodePretty', keyOrder, Config(confCompare) ) + ( defConfig, encodePretty', keyOrder, Config(..), Indent(..) ) import qualified Data.ByteString.Lazy.Char8 as C import Text.Printf ( printf ) -import Options - ( optsParserInfo, execParser, Opts(optPass, optHost, optPort) ) -import Network.MPD.Parse ( getStatusField - , getStatusFieldElement - , getTag - , maybePathCurrentSong - , maybePathNextPlaylistSong - , (.=?) - , objectJson - , getStatusIdInt ) - import Text.Read (readMaybe) +import Data.Maybe (fromMaybe) {- | Where the program connects to MPD and uses the helper functions to extract values, organize them into a list of key/value pairs, make them a 'Data.Aeson.Value' using 'Data.Aeson.object', then encode it to @@ -34,52 +36,26 @@ opts <- execParser optsParserInfo let withMpdOpts = MPD.withMPDEx (optHost opts) (optPort opts) (optPass opts) - cs <- withMpdOpts MPD.currentSong + currentSong <- withMpdOpts MPD.currentSong st <- withMpdOpts MPD.status - let artist = getTag Artist cs - artistSort = getTag ArtistSort cs - album = getTag Album cs - albumSort = getTag AlbumSort cs - albumArtist = getTag AlbumArtist cs - albumArtistSort = getTag AlbumArtistSort cs - title = getTag Title cs - track = getTag Track cs - name = getTag Name cs - genre = getTag Genre cs - date = getTag Date cs - originalDate = getTag OriginalDate cs - composer = getTag Composer cs - performer = getTag Performer cs - conductor = getTag Conductor cs - work = getTag Work cs - grouping = getTag Grouping cs - comment = getTag Comment cs - disc = getTag Disc cs - label = getTag Label cs - musicbrainz_Artistid = getTag MUSICBRAINZ_ARTISTID cs - musicbrainz_Albumid = getTag MUSICBRAINZ_ALBUMID cs - musicbrainz_Albumartistid = getTag MUSICBRAINZ_ALBUMARTISTID cs - musicbrainz_Trackid = getTag MUSICBRAINZ_TRACKID cs - musicbrainz_Releasetrackid = getTag MUSICBRAINZ_RELEASETRACKID cs - musicbrainz_Workid = getTag MUSICBRAINZ_WORKID cs - let state :: Maybe String - state = case getStatusField st MPD.stState of - Just ps -> case ps of - Playing -> Just "playing" - Paused -> Just "paused" - Stopped -> Just "stopped" - Nothing -> Nothing + state = playbackStateToString <$> getStatusField st MPD.stState + where + playbackStateToString Playing = "playing" + playbackStateToString Paused = "paused" + playbackStateToString Stopped = "stopped" time = getStatusFieldElement st MPD.stTime elapsed = fst <$> time duration = snd <$> time elapsedPercent :: Maybe Double - elapsedPercent = case time of - Just t1 -> readMaybe $ printf "%.2f" (uncurry (/) t1 * 100) - Nothing -> Just 0.0 + elapsedPercent = readMaybe percentTwoDecimals + where + percentTwoDecimals = printf "%.2f" timeToPercent + timeToPercent = uncurry (/) t * 100 + t = fromMaybe (0,0) time volumeSt :: Maybe Int volumeSt = fromIntegral <$> getStatusFieldElement st MPD.stVolume @@ -92,11 +68,8 @@ audioFormat = getStatusField st MPD.stAudio errorSt = getStatusField st MPD.stError - updatingDbSt = isJust updatingDbMaybe - where - updatingDbMaybe = getStatusFieldElement st MPD.stUpdatingDb -- "Nothing" or "Just 1" - isJust Nothing = Nothing - isJust _ = Just True + updatingDbSt :: Maybe Bool + updatingDbSt = (== 1) <$> getStatusFieldElement st MPD.stUpdatingDb crossfadeSt :: Maybe Int crossfadeSt = fromIntegral <$> getStatusField st MPD.stXFadeWidth @@ -111,42 +84,16 @@ nextId = getStatusIdInt MPD.stNextSongID st playlistLength = getStatusField st MPD.stPlaylistLength - nextPlaylistSong <- withMpdOpts $ MPD.playlistInfo nextPos - let filename = maybePathCurrentSong cs - filenameNext = maybePathNextPlaylistSong nextPlaylistSong + nextSong <- withMpdOpts $ MPD.playlistInfo nextPos + let filename = maybePathCurrentSong currentSong + filenameNext = maybePathNextPlaylistSong nextSong -- sgTags - let jTags = objectJson - [ "artist" .=? artist - , "artist_sort" .=? artistSort - , "album" .=? album - , "album_sort" .=? albumSort - , "album_artist" .=? albumArtist - , "album_artist_sort" .=? albumArtistSort - , "title" .=? title - , "track" .=? track - , "name" .=? name - , "genre" .=? genre - , "date" .=? date - , "original_date" .=? originalDate - , "composer" .=? composer - , "performer" .=? performer - , "conductor" .=? conductor - , "work" .=? work - , "grouping" .=? grouping - , "comment" .=? comment - , "disc" .=? disc - , "label" .=? label - , "musicbrainz_artistid" .=? musicbrainz_Artistid - , "musicbrainz_albumid" .=? musicbrainz_Albumid - , "musicbrainz_albumartistid" .=? musicbrainz_Albumartistid - , "musicbrainz_trackid" .=? musicbrainz_Trackid - , "musicbrainz_releasetrackid" .=? musicbrainz_Releasetrackid - , "musicbrainz_workid" .=? musicbrainz_Workid - ] + let jsonCurrentSongTags = jsonSongTags $ getAllTags $ Current currentSong + jsonNextSongTags = jsonSongTags $ getAllTags $ Next nextSong -- status - let jStatus = objectJson + let jsonStatus = objectMaybes [ "state" .=? state , "repeat" .=? repeatSt , "random" .=? randomSt @@ -165,50 +112,65 @@ , "error" .=? errorSt ] - -- let jFilename = objectJson [ "file" .=? filename ] + -- let jFilename = objectMaybes [ "file" .=? filename ] - let jPlaylist = objectJson - [ "position" .=? pos -- current song position + let jsonPlaylist = objectMaybes + [ "position" .=? pos , "next_position" .=? nextPos - , "id" .=? songId -- current song id + , "id" .=? songId , "next_id" .=? nextId , "length" .=? playlistLength ] - let jObject = object [ "filename" .= filename - , "next_filename" .= filenameNext - , "playlist" .= jPlaylist - , "status" .= jStatus - , "tags" .= jTags - ] + let jsonBaseObject tags = object + $ [ "filename" .= filename + , "next_filename" .= filenameNext + , "playlist" .= jsonPlaylist + , "status" .= jsonStatus + ] ++ tags - C.putStrLn $ encodePretty' customEncodeConf jObject + let printJson tags = C.putStrLn + $ encodePretty' customEncodeConf + $ jsonBaseObject tags + case optNext opts of + NoNextSong -> printJson [ "tags" .= jsonCurrentSongTags ] + + OnlyNextSong -> printJson [ "tags" .= jsonNextSongTags ] + IncludeNextSong -> printJson [ "tags" .= jsonCurrentSongTags + , "next" .= object [ "tags" .= jsonNextSongTags ] ] + customEncodeConf :: Config customEncodeConf = defConfig - { confCompare = keyOrder [ "title", "name" - , "artist", "album_artist", "artist_sort", "album_artist_sort" - , "album", "album_sort" - , "track", "disc" - , "date", "original_date" - , "genre", "composer", "performer", "conductor" - , "work", "grouping", "label" - , "comment" - , "musicbrainz_artistid" - , "musicbrainz_albumid" - , "musicbrainz_albumartistid" - , "musicbrainz_trackid" - , "musicbrainz_releasetrackid" - , "musicbrainz_workid" - -- status - , "state", "repeat", "random", "single", "consume" - , "duration", "elapsed", "elapsed_percent" - , "volume", "audio_format", "bitrate" - , "crossfade", "mixramp_db", "mixramp_delay" - , "updating_db" - , "error" - -- playlist - , "position", "next_position", "id", "next_id" - , "length" - ] - } + { confCompare = + keyOrder + -- top level labels + [ "filename", "next_filename", "status", "playlist", "tags", "next" + -- tags + , "title", "name" + , "artist", "album_artist", "artist_sort", "album_artist_sort" + , "album", "album_sort" + , "track", "disc" + , "date", "original_date" + , "genre", "composer", "performer", "conductor" + , "work", "grouping", "label" + , "comment" + , "musicbrainz_artistid" + , "musicbrainz_albumid" + , "musicbrainz_albumartistid" + , "musicbrainz_trackid" + , "musicbrainz_releasetrackid" + , "musicbrainz_workid" + -- status + , "state", "repeat", "random", "single", "consume" + , "duration", "elapsed", "elapsed_percent" + , "volume", "audio_format", "bitrate" + , "crossfade", "mixramp_db", "mixramp_delay" + , "updating_db" + , "error" + -- playlist + , "id", "next_id", "position", "next_position" + , "length" + ] + , confIndent = Spaces 2 + } diff --git a/src/Options.hs b/src/Options.hs --- a/src/Options.hs +++ b/src/Options.hs @@ -1,5 +1,6 @@ module Options ( Opts(..) + , NextSongFlag(..) , execParser , prefs , showHelpOnEmpty @@ -17,6 +18,7 @@ metavar, option, strOption, + flag', prefs, progDesc, short, @@ -26,7 +28,9 @@ Parser, ParserInfo, infoOption, - hidden ) + hidden, + many, + (<|>) ) import Options.Applicative.Extra ( helperWith ) @@ -37,16 +41,25 @@ { optPort :: Integer -- ^ MPD port to connect. , optHost :: String -- ^ MPD host address to connect. , optPass :: String -- ^ Plain text password to connect to MPD. + , optNext :: NextSongFlag -- ^ Either include in the json or print it alone. , optVersion :: Type -> Type -- ^ Print program version. } +data NextSongFlag = IncludeNextSong + | OnlyNextSong + | NoNextSong + optsParser :: Parser Opts optsParser = Opts <$> portOptParser <*> hostOptParser <*> passOptParser + <*> nextSongOptParser <*> versionOptParse + where + nextSongOptParser = nextSongFlagCountOptParser + <|> nextSongOnlyOptParser portOptParser :: Parser Integer portOptParser @@ -74,6 +87,28 @@ <> short 'P' <> value "" <> help "Password for connecting (will be sent as plain text)" + +nextSongFlagCountOptParser :: Parser NextSongFlag +nextSongFlagCountOptParser = + fmap (intToNextSong . length) <$> many + $ flag' () + $ short 'n' + <> long "next" + <> help ( concat + [ "If used once (e.g. -n), include next song information in the output.\n" + , "If used twice (e.g. -nn) it's an alias for --next-only." ]) + +nextSongOnlyOptParser :: Parser NextSongFlag +nextSongOnlyOptParser + = flag' OnlyNextSong + ( long "next-only" + <> help "Only print next song information." ) + +intToNextSong :: Int -> NextSongFlag +intToNextSong count + | count == 1 = IncludeNextSong + | count > 1 = OnlyNextSong + | otherwise = NoNextSong versionOptParse :: Parser (a -> a) versionOptParse =