mpd-current-json 1.5.0.1 → 2.0.0.0
raw patch · 6 files changed
+387/−222 lines, 6 filesdep ~aeson-prettydep ~bytestringdep ~mpd-current-json
Dependency ranges changed: aeson-pretty, bytestring, mpd-current-json
Files
- CHANGELOG.md +14/−0
- lib/Network/MPD/JSON.hs +90/−0
- lib/Network/MPD/Parse.hs +152/−90
- mpd-current-json.cabal +8/−6
- src/Main.hs +87/−125
- src/Options.hs +36/−1
CHANGELOG.md view
@@ -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
+ lib/Network/MPD/JSON.hs view
@@ -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 .=?
lib/Network/MPD/Parse.hs view
@@ -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
mpd-current-json.cabal view
@@ -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
src/Main.hs view
@@ -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+ }
src/Options.hs view
@@ -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 =