mpd-current-json 2.1.0.0 → 3.0.0.0
raw patch · 10 files changed
+466/−470 lines, 10 filesdep +deriving-aesondep +text
Dependencies added: deriving-aeson, text
Files
- CHANGELOG.md +5/−0
- lib/MPD/Current/JSON/Builder.hs +59/−0
- lib/MPD/Current/JSON/Parse.hs +56/−0
- lib/MPD/Current/JSON/Types.hs +226/−0
- lib/Network/MPD/JSON.hs +0/−90
- lib/Network/MPD/Parse.hs +0/−236
- mpd-current-json.cabal +40/−8
- src/Main.hs +64/−126
- src/Options.hs +15/−9
- src/Version.hs +1/−1
CHANGELOG.md view
@@ -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.
+ lib/MPD/Current/JSON/Builder.hs view
@@ -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+ }
+ lib/MPD/Current/JSON/Parse.hs view
@@ -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
+ lib/MPD/Current/JSON/Types.hs view
@@ -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+ ] ]
− lib/Network/MPD/JSON.hs
@@ -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 .=?
− lib/Network/MPD/Parse.hs
@@ -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
mpd-current-json.cabal view
@@ -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
src/Main.hs view
@@ -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 ()
src/Options.hs view
@@ -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"
src/Version.hs view
@@ -9,4 +9,4 @@ progName = "mpd-current-json" versionStr :: [Char]-versionStr = progName ++ " version " ++ (showVersion version)+versionStr = progName ++ " version " ++ showVersion version