diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# v3.0 +- refactor internal types +- change json output, move next filename information to under `next`, + now nested as `next.filename` and behind the `-n` cli flag. + # v2.1 - Fix multi-value tag arrays being in reverse order. diff --git a/lib/MPD/Current/JSON/Builder.hs b/lib/MPD/Current/JSON/Builder.hs new file mode 100644 --- /dev/null +++ b/lib/MPD/Current/JSON/Builder.hs @@ -0,0 +1,59 @@ +module MPD.Current.JSON.Builder + ( mkStatus + , mkPlaylist + , mkFile + ) where + + +import MPD.Current.JSON.Types qualified as Current +import Network.MPD qualified as MPD +import Text.Read ( readMaybe ) +import Text.Printf ( printf ) +import GHC.Num ( integerToInt ) + +mkStatus :: MPD.Status -> Current.Status +mkStatus st = Current.Status + { Current.state = Current.MPDPlaybackState st.stState + , Current.repeat = st.stRepeat + , Current.random = st.stRandom + , Current.single = st.stSingle + , Current.consume = st.stConsume + , Current.duration = snd <$> st.stTime + , Current.elapsed = fst <$> st.stTime + , Current.elapsedPercent = calcElapsedPercent st.stTime + , Current.volume = fromIntegral <$> st.stVolume + , Current.audioFormat = Just st.stAudio + , Current.bitrate = st.stBitrate + , Current.crossfade = Just . integerToInt $ st.stXFadeWidth + , Current.mixRampDb = Just st.stMixRampdB + , Current.mixRampDelay = Just st.stMixRampDelay + , Current.updatingDb = integerToInt <$> st.stUpdatingDb + , Current.error = st.stError + } + where + calcElapsedPercent :: Maybe (MPD.FractionalSeconds, MPD.FractionalSeconds) -> Maybe Double + calcElapsedPercent Nothing = Nothing + calcElapsedPercent (Just (elapsed, duration)) = do + let elapsedPercent = (elapsed / duration) * 100 + if duration > 0 + then readMaybe $ printf "%02.2f" elapsedPercent :: Maybe Double + else Nothing + +mkPlaylist :: MPD.Status -> Current.Playlist +mkPlaylist st = Current.Playlist + { Current.position = st.stSongPos + , Current.nextPosition = st.stNextSongPos + , Current.id = Current.MPDId <$> st.stSongID + , Current.nextId = Current.MPDId <$> st.stNextSongID + , Current.length = fromIntegral st.stPlaylistLength + } + +mkFile :: MPD.Song -> MPD.Song -> Current.File +mkFile cs ns = Current.File + { Current.currentFile = if null $ MPD.toString cs.sgFilePath + then Nothing + else Just $ Current.MPDPath cs.sgFilePath + , Current.nextFile = if null $ MPD.toString ns.sgFilePath + then Nothing + else Just $ Current.MPDPath ns.sgFilePath + } diff --git a/lib/MPD/Current/JSON/Parse.hs b/lib/MPD/Current/JSON/Parse.hs new file mode 100644 --- /dev/null +++ b/lib/MPD/Current/JSON/Parse.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} + + +module MPD.Current.JSON.Parse + ( getTags + ) where + +import MPD.Current.JSON.Types ( Tags(..), TagField(..) ) +import Network.MPD ( Metadata(..) ) +import qualified Network.MPD as MPD + + +-- | Builder for `Tags' from `Network.MPD.Song' that assigns `TagField' values +-- based on them being a single string or multi-value array. +getTags :: MPD.Song -> Tags +getTags song = Tags + { artist = getTag Artist song + , artistSort = getTag ArtistSort song + , album = getTag Album song + , albumSort = getTag AlbumSort song + , albumArtist = getTag AlbumArtist song + , albumArtistSort = getTag AlbumArtistSort song + , title = getTag Title song + , track = getTag Track song + , name = getTag Name song + , genre = getTag Genre song + , date = getTag Date song + , originalDate = getTag OriginalDate song + , composer = getTag Composer song + , performer = getTag Performer song + , conductor = getTag Conductor song + , work = getTag Work song + , grouping = getTag Grouping song + , comment = getTag Comment song + , disc = getTag Disc song + , label = getTag Label song + , musicbrainzArtistId = getTag MUSICBRAINZ_ARTISTID song + , musicbrainzAlbumId = getTag MUSICBRAINZ_ALBUMID song + , musicbrainzAlbumartistId = getTag MUSICBRAINZ_ALBUMARTISTID song + , musicbrainzTrackId = getTag MUSICBRAINZ_TRACKID song + , musicbrainzReleasetrackId = getTag MUSICBRAINZ_RELEASETRACKID song + , musicbrainzWorkId = getTag MUSICBRAINZ_WORKID song + } + + +-- | Parse single or multi `Network.MPD.Value' +getTag :: Metadata -> MPD.Song -> Maybe TagField +getTag tag song = tagSingleOrList (MPD.sgGetTag tag song) + where + tagSingleOrList :: Maybe [MPD.Value] -> Maybe TagField + tagSingleOrList val = case val of + Just [v] -> Just . SingleTagField $ MPD.toString v + Just v -> Just . MultiTagField $ map MPD.toString v + Nothing -> Nothing diff --git a/lib/MPD/Current/JSON/Types.hs b/lib/MPD/Current/JSON/Types.hs new file mode 100644 --- /dev/null +++ b/lib/MPD/Current/JSON/Types.hs @@ -0,0 +1,226 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedRecordDot #-} + +module MPD.Current.JSON.Types + ( Tags(..) + , TagField(..) + , Status(..) + , Playlist(..) + , File(..) + , State(..) + , MPDPath(..) + , MPDPlaybackState(..) + , MPDId(..) + ) where + +import Network.MPD qualified as MPD + +import Data.Aeson.Types +import Deriving.Aeson +import Data.List qualified as L +import Data.Char +import Control.Applicative +import Data.Text qualified as T +import Data.String + + +-- | Deriving.Aeson ghost type +data MPDCurrentJSONTag + +{- | Custom field label string modifier for Tags + +Lowercase @musicbrainz@ fields by separating them with @_@, otherwise +default to CamelToSnake. +-} +instance StringModifier MPDCurrentJSONTag where + getStringModifier s = + case L.stripPrefix "musicbrainz" s of + Just xs -> "musicbrainz_" ++ map toLower xs + Nothing -> camelTo2 '_' s + + +{- | Sum type for either a single string or list of strings. + +`Network.MPD.sgGetTag' always returns a list of values for the given +`Network.MPD.Metadata', so to make the output JSON only use direct +strings vs an array, use this sum type. +-} +data TagField = SingleTagField !String + | MultiTagField ![String] + deriving stock (Show, Eq, Generic) + +{- | Store the parsed output of 'getTag'. + +Each field represents a supported MPD tag. + +@Maybe@ is used so `Deriving.Aeson.OmitNothingFields' can skip fields +that would otherwise be null in the encoded JSON. +-} +data Tags = Tags + { artist :: !(Maybe TagField) + , artistSort :: !(Maybe TagField) + , album :: !(Maybe TagField) + , albumSort :: !(Maybe TagField) + , albumArtist :: !(Maybe TagField) + , albumArtistSort :: !(Maybe TagField) + , title :: !(Maybe TagField) + , track :: !(Maybe TagField) + , name :: !(Maybe TagField) + , genre :: !(Maybe TagField) + , date :: !(Maybe TagField) + , originalDate :: !(Maybe TagField) + , composer :: !(Maybe TagField) + , performer :: !(Maybe TagField) + , conductor :: !(Maybe TagField) + , work :: !(Maybe TagField) + , grouping :: !(Maybe TagField) + , comment :: !(Maybe TagField) + , disc :: !(Maybe TagField) + , label :: !(Maybe TagField) + , musicbrainzArtistId :: !(Maybe TagField) + , musicbrainzAlbumId :: !(Maybe TagField) + , musicbrainzAlbumartistId :: !(Maybe TagField) + , musicbrainzTrackId :: !(Maybe TagField) + , musicbrainzReleasetrackId :: !(Maybe TagField) + , musicbrainzWorkId :: !(Maybe TagField) + } + deriving stock (Show, Eq, Generic) + deriving (ToJSON, FromJSON) via CustomJSON + '[ FieldLabelModifier '[ MPDCurrentJSONTag ] + , OmitNothingFields + ] Tags + +instance ToJSON TagField where + toJSON :: TagField -> Value + toJSON (SingleTagField s) = toJSON s + toJSON (MultiTagField maybeList) = toJSON maybeList + +instance FromJSON TagField where + parseJSON v = + (SingleTagField <$> parseJSON v) + <|> (MultiTagField <$> parseJSON v) + +data Status = Status + { state :: !MPDPlaybackState + , repeat :: !Bool + , random :: !Bool + , single :: !Bool + , consume :: !Bool + , duration :: !(Maybe MPD.FractionalSeconds) -- Double + , elapsed :: !(Maybe MPD.FractionalSeconds) + , elapsedPercent :: !(Maybe Double) + , volume :: !(Maybe Int) + , audioFormat :: !(Maybe (Int, Int, Int)) + , bitrate :: !(Maybe Int) + , crossfade :: !(Maybe Int) + , mixRampDb :: !(Maybe Double) + , mixRampDelay :: !(Maybe Double) + , updatingDb :: !(Maybe Int) + , error :: !(Maybe String) + } + deriving stock (Show, Eq, Generic) + deriving (ToJSON, FromJSON) via CustomJSON + '[ FieldLabelModifier '[ Rename "mixRampDb" "mixramp_db" + , Rename "mixRampDelay" "mixramp_delay" + , CamelToSnake + ] + , OmitNothingFields + ] Status + +-- | @newtype@ wrapper for otherwise orphan instance. Address warning GHC-90177. +newtype MPDPlaybackState = MPDPlaybackState MPD.PlaybackState + deriving stock (Show, Eq, Generic) + +instance ToJSON MPDPlaybackState where + toJSON :: MPDPlaybackState -> Value + toJSON (MPDPlaybackState MPD.Playing) = "playing" + toJSON (MPDPlaybackState MPD.Paused) = "paused" + toJSON (MPDPlaybackState MPD.Stopped) = "stopped" + +instance FromJSON MPDPlaybackState where + parseJSON = withText "MPD.PlaybackState" $ \state -> do + case state of + "playing" -> pure (MPDPlaybackState MPD.Playing) + "paused" -> pure (MPDPlaybackState MPD.Paused) + "stopped" -> pure (MPDPlaybackState MPD.Playing) + _ -> fail $ "Unknown playback state: " ++ show state + +data Playlist = Playlist + { position :: !(Maybe MPD.Position) + , nextPosition :: !(Maybe MPD.Position) + , id :: !(Maybe MPDId) + , nextId :: !(Maybe MPDId) + , length :: !Int + } + deriving stock (Show, Eq, Generic) + deriving (ToJSON, FromJSON) via CustomJSON + '[ FieldLabelModifier '[ CamelToSnake ] + , OmitNothingFields + ] Playlist + +-- | @newtype@ wrapper for otherwise orphan instance. Address warning GHC-90177. +newtype MPDId = MPDId MPD.Id + deriving stock (Show, Eq, Generic) + +instance ToJSON MPDId where + toJSON :: MPDId -> Value + toJSON (MPDId (MPD.Id i)) = toJSON i + +instance FromJSON MPDId where + parseJSON v = MPDId . MPD.Id <$> parseJSON v + +data File = File + { currentFile :: !(Maybe MPDPath) -- ^ current song file path + , nextFile :: !(Maybe MPDPath) -- ^ next song file path + } + deriving stock (Show, Eq, Generic) + deriving (ToJSON, FromJSON) via CustomJSON + '[ FieldLabelModifier '[ Rename "currentFile" "filename" + , Rename "nextFile" "next_filename" ] + , OmitNothingFields + ] File + + +-- | @newtype@ wrapper for otherwise orphan instance. Address warning GHC-90177. +newtype MPDPath = MPDPath MPD.Path + deriving stock (Show, Eq, Generic) + +instance ToJSON MPDPath where + toJSON :: MPDPath -> Value + toJSON (MPDPath p) = toJSON $ MPD.toString p + +instance FromJSON MPDPath where + parseJSON = withText "MPD.Path" $ \path -> do + pure . MPDPath . fromString . T.unpack $ path + +-- | Complete MPD State. Where other states will be stored into and JSON encoded. +data State = State + { mpdFile :: !File + , mpdStatus :: !Status + , mpdPlaylist :: !Playlist + , mpdTags :: !Tags + , mpdNextTags :: !(Maybe Tags) + } + deriving stock (Show, Eq, Generic) + +-- | Custom output for encoded 'State'. +instance ToJSON State where + toJSON :: State -> Value + toJSON state = object $ + [ "filename" .= toJSON state.mpdFile.currentFile + , "status" .= toJSON state.mpdStatus + , "playlist" .= toJSON state.mpdPlaylist + , "tags" .= state.mpdTags + ] <> case state.mpdNextTags of + Nothing -> [] + Just nextTags -> [ "next" .= object + [ "filename" .= toJSON state.mpdFile.nextFile + , "tags" .= nextTags + ] ] diff --git a/lib/Network/MPD/JSON.hs b/lib/Network/MPD/JSON.hs deleted file mode 100644 --- a/lib/Network/MPD/JSON.hs +++ /dev/null @@ -1,90 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/lib/Network/MPD/Parse.hs +++ /dev/null @@ -1,236 +0,0 @@ -module Network.MPD.Parse - ( TagField (..) - , ExtractedTags (..) - , getAllTags - , getStatusField - , getStatusFieldElement - , SongCurrentOrNext(..) - , getTag - , songToTagField - , maybePathCurrentSong - , maybePathNextPlaylistSong - , singleValueToString - , multiValueToString - , getStatusIdInt - ) -where - -import qualified Network.MPD as MPD -import Network.MPD - ( Metadata(..), Song, PlaybackState(Stopped, Playing, Paused) ) -import Data.Maybe ( fromMaybe, listToMaybe ) - -{- | 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) - -{- | 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__: - -@ -ghci> import qualified Network.MPD as MPD -ghci> st <- MPD.withMPD MPD.status -ghci> getStatusField st MPD.stVolume -@ -Just (Just 100) --} -getStatusField :: MPD.Response MPD.Status -> (MPD.Status -> a) -> Maybe a -getStatusField (Right st) f = Just (f st) -getStatusField _ _ = Nothing - -{- | Go a level deeper than `getStatusField'. For nested @Maybe a@ -fields from 'Network.MPD.Status'. - -==== __Example__: - -@ -ghci> import qualified Network.MPD as MPD -ghci> st <- MPD.withMPD MPD.status -ghci> getStatusFieldElement st MPD.stVolume -@ -Just 100 --} -getStatusFieldElement :: MPD.Response MPD.Status -> (MPD.Status -> Maybe a) -> Maybe a -getStatusFieldElement status item = fromMaybe Nothing $ getStatusField status item - --- | 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. --} -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 - $ listToMaybe - $ fromMaybe [] val - | fmap length val > Just 1 = - MultiTagField $ multiValueToString val - | otherwise = SingleTagField Nothing - -{- | 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@. --} -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. - -`reverse' is used here because multi-value tags are returned in -reverse order by [libmpd](Network.MPD), e.g. if a song has a -multi-value @artist@ tag that contains "Artist1; Artist2; Artist3", -the returned value of 'Network.MPD.Song.sgTags' from -`Network.MPD.playlistInfo' @-> [Song]@ (which is a way of fetching the -next song) would be @["Artist3", "Artist2", "Artist1"]@. --} -multiValueToString :: Maybe [MPD.Value] -> Maybe [String] -multiValueToString (Just x) = Just $ reverse $ 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 -maybePathCurrentSong cs = - case cs of - Left _ -> Nothing - Right Nothing -> Nothing - Right (Just song) -> Just $ MPD.toString $ MPD.sgFilePath song - -{- | Get the next song's relative path in the current playlist. - -Using 'Network.MPD.sgFilePath' from the returned 'Network.MPD.Response' @[Song]@. --} -maybePathNextPlaylistSong :: MPD.Response [Song] -> Maybe String -maybePathNextPlaylistSong (Left _) = Nothing -maybePathNextPlaylistSong (Right []) = Nothing -maybePathNextPlaylistSong (Right (_:_:_)) = Nothing -maybePathNextPlaylistSong (Right [s]) = Just $ MPD.toString $ MPD.sgFilePath s - --- | 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 - Just (MPD.Id int) -> Just int - Nothing -> Nothing - where - m = fromMaybe Nothing $ getStatusField status item diff --git a/mpd-current-json.cabal b/mpd-current-json.cabal --- a/mpd-current-json.cabal +++ b/mpd-current-json.cabal @@ -1,4 +1,4 @@ -cabal-version: 3.0 +cabal-version: 3.8 name: mpd-current-json -- The package version. -- See the Haskell package versioning policy (PVP) for standards @@ -7,10 +7,10 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 2.1.0.0 +version: 3.0.0.0 synopsis: Print current MPD song and status as JSON -tested-with: GHC == { 9.10.1, 9.4.8 } +tested-with: GHC == { 9.10.1, 9.6.7, 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 @@ -34,16 +34,43 @@ library -- exposed: False - exposed-modules: Network.MPD.Parse - Network.MPD.JSON + exposed-modules: MPD.Current.JSON.Parse + MPD.Current.JSON.Builder + MPD.Current.JSON.Types build-depends: base >=4.16 && <5 , libmpd == 0.10.* , aeson == 2.2.* , aeson-pretty == 0.8.* + , deriving-aeson ^>=0.2.10 , bytestring >=0.11 && <0.13 + , text ^>=2.1.3 hs-source-dirs: lib - default-language: Haskell2010 + default-language: GHC2021 + default-extensions: LambdaCase + , NoFieldSelectors + , OverloadedRecordDot + , OverloadedStrings + , StrictData + , DerivingStrategies + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-uni-patterns + -Wincomplete-record-updates + -Wredundant-constraints + -Wmissing-export-lists + -Wpartial-fields + -Wmissing-deriving-strategies + -Wunused-packages + -fwrite-ide-info + -hiedir=.hie + -Wmissing-local-signatures + -Wincomplete-patterns + -Woverlapping-patterns + -fwarn-incomplete-patterns + -fwarn-tabs + executable mpd-current-json main-is: Main.hs @@ -66,7 +93,13 @@ -- Directories containing source files. hs-source-dirs: src - default-language: Haskell2010 + default-language: GHC2021 + default-extensions: LambdaCase + , NoFieldSelectors + , OverloadedRecordDot + , OverloadedStrings + , StrictData + , DerivingStrategies -- [[https://kowainik.github.io/posts/2019-02-06-style-guide#ghc-options][Haskell Style Guide :: Kowainik]] ghc-options: -Wall @@ -81,4 +114,3 @@ -Wunused-packages -fwrite-ide-info -hiedir=.hie - -O2 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,151 +1,69 @@ +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module Main ( main ) where -import qualified Network.MPD as MPD -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 MPD.Current.JSON.Types ( State(..) ) +import MPD.Current.JSON.Builder qualified as Builder +import MPD.Current.JSON.Parse ( getTags ) +import Network.MPD qualified as MPD import Options - ( optsParserInfo, execParser, Opts(..), NextSongFlag(..) ) + ( execParser, + NextSongFlag(IncludeNextSong, NoNextSong, OnlyNextSong), + Opts(..), + optsParserInfo ) +import Version ( versionStr ) -import Data.Aeson ( object, KeyValue((.=)) ) +import Data.Aeson ( object, KeyValue((.=)), ToJSON(toJSON) ) import Data.Aeson.Encode.Pretty - ( defConfig, encodePretty', keyOrder, Config(..), Indent(..) ) -import qualified Data.ByteString.Lazy.Char8 as C -import Text.Printf ( printf ) + ( defConfig, + encodePretty', + keyOrder, + Config(..), + Indent(Spaces) ) +import Data.ByteString.Lazy.Char8 qualified as C +import System.Exit ( die, exitSuccess ) -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 -a conventional JSON @ByteString@ with -'Data.Aeson.Encode.Pretty.encodePretty' for the pretty-print version. --} + main :: IO () main = do opts <- execParser optsParserInfo - - let withMpdOpts = MPD.withMPDEx (optHost opts) (optPort opts) (optPass opts) - currentSong <- withMpdOpts MPD.currentSong - st <- withMpdOpts MPD.status - - let state :: Maybe String - 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 = 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 - - repeatSt = getStatusField st MPD.stRepeat - randomSt = getStatusField st MPD.stRandom - singleSt = getStatusField st MPD.stSingle - consumeSt = getStatusField st MPD.stConsume - bitrate = getStatusField st MPD.stBitrate - audioFormat = getStatusField st MPD.stAudio - errorSt = getStatusField st MPD.stError - - updatingDbSt :: Maybe Bool - updatingDbSt = (== 1) <$> getStatusFieldElement st MPD.stUpdatingDb - - crossfadeSt :: Maybe Int - crossfadeSt = fromIntegral <$> getStatusField st MPD.stXFadeWidth - - mixRampDbSt = getStatusField st MPD.stMixRampdB - mixRampDelay = getStatusField st MPD.stMixRampDelay - - -- positon is an index starting from 0. Id starts from 1 - let pos = getStatusField st MPD.stSongPos - nextPos = getStatusFieldElement st MPD.stNextSongPos - songId = getStatusIdInt MPD.stSongID st - nextId = getStatusIdInt MPD.stNextSongID st - playlistLength = getStatusField st MPD.stPlaylistLength - - nextSong <- withMpdOpts $ MPD.playlistInfo nextPos - let filename = maybePathCurrentSong currentSong - filenameNext = maybePathNextPlaylistSong nextSong - - -- sgTags - let jsonCurrentSongTags = jsonSongTags $ getAllTags $ Current currentSong - jsonNextSongTags = jsonSongTags $ getAllTags $ Next nextSong - - -- status - let jsonStatus = objectMaybes - [ "state" .=? state - , "repeat" .=? repeatSt - , "random" .=? randomSt - , "single" .=? singleSt - , "consume" .=? consumeSt - , "duration" .=? duration - , "elapsed" .=? elapsed - , "elapsed_percent" .=? elapsedPercent - , "volume" .=? volumeSt - , "audio_format" .=? audioFormat - , "bitrate" .=? bitrate - , "crossfade" .=? crossfadeSt - , "mixramp_db" .=? mixRampDbSt - , "mixramp_delay" .=? mixRampDelay - , "updating_db" .=? updatingDbSt - , "error" .=? errorSt - ] - - -- let jFilename = objectMaybes [ "file" .=? filename ] - - let jsonPlaylist = objectMaybes - [ "position" .=? pos - , "next_position" .=? nextPos - , "id" .=? songId - , "next_id" .=? nextId - , "length" .=? playlistLength - ] + optsExecVersion opts - let jsonBaseObject tags = object - $ [ "filename" .= filename - , "next_filename" .= filenameNext - , "playlist" .= jsonPlaylist - , "status" .= jsonStatus - ] ++ tags + let withMpdOpts = MPD.withMPDEx opts.optHost opts.optPort opts.optPass + response <- withMpdOpts $ do + cs <- MPD.currentSong + st <- MPD.status + let nPos = st.stNextSongPos + ns <- MPD.playlistInfo nPos + pure (cs, st, ns) - let printJson tags = C.putStrLn - $ encodePretty' customEncodeConf - $ jsonBaseObject tags + case response of + Right (Just cs, status, [ns]) -> + -- handle edge case where next song is the same as current + let opts' = if cs == ns + then opts {optNext = NoNextSong} + else opts + in printEncoded opts' cs ns status - case optNext opts of - NoNextSong -> printJson [ "tags" .= jsonCurrentSongTags ] + -- something tells me that exceptions are thrown before these get reached + _ -> die "Couldn't get enough information from MPD." - OnlyNextSong -> printJson [ "tags" .= jsonNextSongTags ] - IncludeNextSong -> printJson [ "tags" .= jsonCurrentSongTags - , "next" .= object [ "tags" .= jsonNextSongTags ] ] +printEncoded :: Opts -> MPD.Song -> MPD.Song -> MPD.Status -> IO () +printEncoded opts cs ns status = + let mpdState = mkState opts cs ns status + finalJson = case opts.optNext of + OnlyNextSong -> object ["tags" .= mpdState.mpdNextTags] + _ -> toJSON mpdState + in C.putStrLn $ encodePretty' customEncodeConf finalJson customEncodeConf :: Config customEncodeConf = defConfig { confCompare = keyOrder -- top level labels - [ "filename", "next_filename", "status", "playlist", "tags", "next" + [ "filename", "status", "playlist", "tags", "next" -- tags , "title", "name" , "artist", "album_artist", "artist_sort", "album_artist_sort" @@ -174,3 +92,23 @@ ] , confIndent = Spaces 2 } + +-- | Main builder function that creates the complete state +mkState :: Opts -> MPD.Song -> MPD.Song -> MPD.Status -> State +mkState opts currentSong nextSong status = + State + { mpdFile = Builder.mkFile currentSong nextSong + , mpdStatus = Builder.mkStatus status + , mpdPlaylist = Builder.mkPlaylist status + , mpdTags = getTags currentSong + , mpdNextTags = case opts.optNext of + NoNextSong -> Nothing + OnlyNextSong -> Just (getTags nextSong) + IncludeNextSong -> Just (getTags nextSong) + } + +optsExecVersion :: Opts -> IO () +optsExecVersion opts + | opts.optVersion = do putStrLn versionStr + exitSuccess + | otherwise = pure () diff --git a/src/Options.hs b/src/Options.hs --- a/src/Options.hs +++ b/src/Options.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DerivingStrategies #-} + module Options ( Opts(..) , NextSongFlag(..) @@ -18,6 +20,7 @@ metavar, option, strOption, + flag, flag', prefs, progDesc, @@ -27,27 +30,28 @@ execParser, Parser, ParserInfo, - infoOption, hidden, many, (<|>) ) import Options.Applicative.Extra ( helperWith ) -import Version ( versionStr, progName ) -import Data.Kind (Type) +import Version ( progName ) + data Opts = Opts -- ^ Custom data record for storing 'Options.Applicative.Parser' values { 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. + , optVersion :: Bool } + deriving stock (Show, Eq) data NextSongFlag = IncludeNextSong | OnlyNextSong | NoNextSong + deriving stock (Show, Eq) optsParser :: Parser Opts optsParser @@ -94,9 +98,11 @@ $ 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." ]) + <> help + (unlines + [ "If used once (e.g. -n), include next song information in the output." + , "If used twice (e.g. -nn) it's an alias for --next-only." + ]) nextSongOnlyOptParser :: Parser NextSongFlag nextSongOnlyOptParser @@ -110,9 +116,9 @@ | count > 1 = OnlyNextSong | otherwise = NoNextSong -versionOptParse :: Parser (a -> a) +versionOptParse :: Parser Bool versionOptParse = - infoOption versionStr + flag False True $ long "version" <> short 'V' <> help "Display the version number" diff --git a/src/Version.hs b/src/Version.hs --- a/src/Version.hs +++ b/src/Version.hs @@ -9,4 +9,4 @@ progName = "mpd-current-json" versionStr :: [Char] -versionStr = progName ++ " version " ++ (showVersion version) +versionStr = progName ++ " version " ++ showVersion version