mpd-current-json (empty) → 1.1.0.2
raw patch · 8 files changed
+1147/−0 lines, 8 filesdep +aesondep +aeson-prettydep +basesetup-changed
Dependencies added: aeson, aeson-pretty, base, bytestring, libmpd, optparse-applicative
Files
- CHANGELOG.md +28/−0
- README.org +682/−0
- Setup.hs +2/−0
- UNLICENSE +24/−0
- mpd-current-json.cabal +69/−0
- src/Main.hs +235/−0
- src/Options.hs +95/−0
- src/Version.hs +12/−0
+ CHANGELOG.md view
@@ -0,0 +1,28 @@+# v1.1.0.2+[comment]: # (2023-10-23)+- Fixed cabal `build-depends` version bounds for Arch Linux dynamic+ building.++# v1.1.0.1+[comment]: # (2023-10-17)+- Added haddock comments+- Addressed `cabal check` warnings;+- setup for uploading as a Hackage package.++# v1.1.0.0+[comment]: # (2023-06-11)+- Remove `-h` from `--help` and use `-h` for `--host`+- Make `--help` option hidden in the help message++# v1.0.0.0+[comment]: # (2023-06-08)+Initial working version+- Added conditional tags printing, only non-empty values are printed+- Accept host, port and password+- Nested json objects for `status` and `tags`+- Added `elapsed_percent` key shortcut for `elapsed / duration * 100`++# v0.0.1.0+[comment]: # (2023-06-01)+- initial connection and parsing values+- First version. Released on an unsuspecting world.
+ README.org view
@@ -0,0 +1,682 @@+#+TITLE: Print currently playing MPD's song metadata and status as JSON+# #+PROPERTY: header-args :comments org+#+OPTIONS: toc:1++* Installation+#+begin_example+git clone https://codeberg.org/useless-utils/mpd-current-json+cd mpd-current-json+#+end_example+and to install the executable to =./dist=, in the current directory:+: cabal install --install-method=copy --overwrite-policy=always --installdir=dist+or to install to =${CABAL_DIR}/bin= remove the =--installdir=dist=+argument. =CABAL_DIR= defaults to =~/.local/share/cabal=.++* Usage+get values+: mpd-current-json | jaq .tags.album+: mpd-current-json | jaq .status.elapsed_percent++provide host and port with+: mpd-current-json -h 'localhost' -p 4321++* Files++** Source+*** Main.hs+:PROPERTIES:+:header-args:haskell+: :tangle src/Main.hs+:END:+**** Pragma language extensions+#+begin_src haskell+{-# LANGUAGE OverloadedStrings #-}+#+end_src+**** Module declaration+#+begin_src haskell+module Main ( main,+ getStatusItem,+ getTag,+ processSong,+ headMay,+ valueToStringMay,+ (.=?) ) where+#+end_src++**** Imports+Import for the ~libmpd~ library, added as ~libmpd == 0.10.*~ to+[[*mpd-current-json.cabal][mpd-current-json.cabal]].+#+begin_src haskell+import qualified Network.MPD as MPD+import Network.MPD+ ( Metadata(..), Song, PlaybackState(Stopped, Playing, Paused) )+import Data.Maybe ( catMaybes )+import Data.Aeson ( object, Key, KeyValue(..), ToJSON )+import Data.Aeson.Encode.Pretty ( encodePretty )+import qualified Data.ByteString.Lazy.Char8 as C+import Text.Printf ( printf )+import Options+ ( optsParserInfo, execParser, Opts(optPass, optHost, optPort) )+#+end_src++**** Main+#+begin_src haskell :padline no+{- | 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+#+end_src++Parse the command-line options and bind the result to =opts=.+#+begin_src haskell :padline no+ opts <- execParser optsParserInfo+#+end_src++Connect to MPD using either the provided arguments from the+command-line or the default values, as defined in [[*=Parser Opts= definition][=Parser Opts=+definition]].+#+begin_src haskell+ cs <- MPD.withMPDEx (optHost opts) (optPort opts) (optPass opts) MPD.currentSong+ st <- MPD.withMPDEx (optHost opts) (optPort opts) (optPass opts) MPD.status+#+end_src+where =currentSong= returns a =Maybe (Just (Song {...}))= and =status=+returns =Maybe (Status {...})= to be parsed.++The data record =Song= from the command =currentSong= contains a field+label "=sgTags=" that contains all embedded metadata tags in a+=fromList [...]=, in this =let= statement store the parser =getTag= function+calls to be placed in the JSON object later:+#+begin_src haskell+ 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+#+end_src++Likewise, =getStatusItem= parses values from =Status {...}= returned by+=status=, some may require additional =Maybe= checks to get the desired+values.+#+begin_src haskell+ let state :: Maybe String+ state = case getStatusItem st MPD.stState of+ Just ps -> case ps of+ Playing -> Just "play" -- same as mpc+ Paused -> Just "pause" -- same as mpc+ Stopped -> Just "stopped"+ Nothing -> Nothing++ time = getStatusItem st MPD.stTime++ elapsed = case time of+ Just t -> case t of+ Just (e, _) -> Just e+ _ -> Nothing+ Nothing -> Nothing++ duration = case time of+ Just t -> case t of+ Just (_, d) -> Just d+ _ -> Nothing+ Nothing -> Nothing++ elapsedPercent :: Maybe Double+ elapsedPercent = case time of+ Just t -> case t of+ Just t1 -> Just (read $ printf "%.2f" (uncurry (/) t1 * 100))+ Nothing -> Just 0+ Nothing -> Nothing++ repeatSt = getStatusItem st MPD.stRepeat+ randomSt = getStatusItem st MPD.stRandom+ singleSt = getStatusItem st MPD.stSingle+ consumeSt = getStatusItem st MPD.stConsume+ pos = getStatusItem st MPD.stSongPos+ playlistLength = getStatusItem st MPD.stPlaylistLength+ bitrate = getStatusItem st MPD.stBitrate+ audioFormat = getStatusItem st MPD.stAudio+ errorSt = getStatusItem st MPD.stError+#+end_src++# Create the first JSON object that contains all the extracted =sgTags=+# values. To prevent printing fields that contain no value to the final+# JSON object (e.g. ="key":null=), the custom operator ~.=?~ is used to+# check if the assined =getTag= or =getStatusItem= functions returned+# "=Nothing=", if so, also send =Nothing= as the value of the key/value+# pair, then, in conjunction with =catMaybes= filter out empty values and+# extract only the values from =Just=, returning the raw value.++The =object . catMaybes= constructs a JSON object by combining a list of+key/value pairs. The ~.=?~ operator is used to create each key/value+pair. If the value is =Just=, the key/value pair is included in the+list; if the value is =Nothing=, it is filtered out using =catMaybes= to+prevent generating fields with a value of =null= in the final JSON+object. Then, the =object= function converts the list of key/value+pairs =[Pair]= into a =Value= data structure that can be 'encoded' using+=Data.Aeson='s "=encode=" or =Data.Aeson.Encode.Pretty='s "=encodePretty=".+#+begin_src haskell+ -- sgTags+ let jTags = object . catMaybes $+ [ "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+ ]++ -- status+ let jStatus = object . catMaybes $+ [ "state" .=? state+ , "repeat" .=? repeatSt+ , "elapsed" .=? elapsed+ , "duration" .=? duration+ , "elapsed_percent" .=? elapsedPercent+ , "random" .=? randomSt+ , "single" .=? singleSt+ , "consume" .=? consumeSt+ , "song_position" .=? pos+ , "playlist_length" .=? playlistLength+ , "bitrate" .=? bitrate+ , "audio_format" .=? audioFormat+ , "error" .=? errorSt+ ]+#+end_src++Having two objects, one for "tags" and other for "status", create a+nested JSON with labels before each of them.+#+begin_src haskell+ let jObject = object [ "tags" .= jTags+ , "status" .= jStatus ]+#+end_src+e.g. so they can be parsed as "=.tags.title=" or+"=.status.elapsed_percent=".++Finally, encode it to real JSON and print it to the+terminal. =Data.Aeson='s encoding is returned as a =ByteString= so use the+=Data.ByteString...= import that provides an implementation of =putStrLn=+that supports =ByteString=s.+#+begin_src haskell+ C.putStrLn $ encodePretty jObject+#+end_src++***** Utility Functions+# ChatGPT descriptions++# Return =Just (f st)= where =f= is a field label and =st= is the =(Response+# Status)= from =withMPD* status=.++The =getStatusItem= function takes an =Either MPD.MPDError MPD.Status=+value and a field label function =f= as arguments. It returns+=Just (f st)= if the input status is =Right st=, where =st= is the+=MPD.Status= value. This function helps to extract a specific field+from the status data record by providing the corresponding field label function.+If the input status is not =Right st=, indicating an error, or the field+label function is not applicable, it returns =Nothing=.+#+begin_src haskell+{- | Extract a field from the returned MPD.Status data record.++This takes an @Either@ 'Network.MPD.MPDError' 'Network.MPD.Status'+value and a field label function @f@ as arguments. It returns @Just+(f st)@ if the input status is @Right st@, where @st@ is the+'Network.MPD.Status' value. This function helps to extract a+specific field from the @MPD.Status@ data record by providing the+corresponding field label function. If the input status "@st@" is+not @Right st@, indicating an error, or the field label function is+not applicable, it returns @Nothing@.+-}+getStatusItem :: Either MPD.MPDError MPD.Status -> (MPD.Status -> a) -> Maybe a+getStatusItem (Right st) f = Just (f st)+getStatusItem _ _ = Nothing+#+end_src++# Check if =Maybe Song= is not empty and send it to =processSong=+The =getTag= function takes a metadata type =t= and an =Either= value+=c= containing a =Maybe Song=. It checks if the =Either= value is+=Left _=, indicating an error, and returns =Nothing=. If the =Either=+value is =Right song=, it calls the =processSong= function with the+metadata type =t= and the =Just song= value, which extracts the tag+value from the song. The =getTag= function helps to retrieve a+specific tag value from the song if it exists.+#+begin_src haskell+{- | @Either@ check for the returned value of 'Network.MPD.currentSong',+then call 'processSong' or return @Nothing@.+-}+getTag :: Metadata -> Either a (Maybe Song) -> Maybe String+getTag t c =+ case c of+ Left _ -> Nothing+ Right song -> processSong t song+#+end_src++The =processSong= function takes a metadata type =tag= and a+=Maybe Song=. If the =Maybe Song= value is =Nothing=, indicating an+empty value, it returns =Nothing=. If the =Maybe Song= value is+=Just song=, it retrieves the tag value using the =MPD.sgGetTag=+function with the provided metadata type and song. It then applies the+=headMay= function to extract the first element from the list of tag+values and the =valueToStringMay= function to convert the value to a+string within a =Maybe= context. This function helps to process the+tag values of a song and convert them to strings if they exist.+#+begin_src haskell+{- | 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.+-}+processSong :: Metadata -> Maybe Song -> Maybe String+processSong _ Nothing = Nothing+processSong tag (Just song) = do+ let tagVal = MPD.sgGetTag tag song+ valueToStringMay =<< (headMay =<< tagVal)+#+end_src++The =headMay= function is a utility function that safely gets the head+of a list. It takes a list as input and returns =Nothing= if the list is+empty or =Just x= where =x= is the first element of the list.+#+begin_src haskell+{- | Safely get the head of a list. Same as 'Safe.headMay'.+-}+headMay :: [a] -> Maybe a+headMay [] = Nothing+headMay (x:_) = Just x+#+end_src++The =valueToStringMay= function is a utility function that converts a+=MPD.Value= to a =String= within a =Maybe= context. It takes a+=MPD.Value= as input and returns =Just (MPD.toString x)= where =x= is+the input value converted to a string.+#+begin_src haskell+{- | 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]@. '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)+#+end_src++The ~.=?~ operator is a utility function to define optional fields in+the key-value pairs of a JSON object. It takes a =Key= and a =Maybe=+value =v= as input. If the =Maybe= value is =Just value=, it returns+~Just (key .= value)~, where =key= is the input key and =value= is the+input value. If the =Maybe= value is =Nothing=, it returns =Nothing=.+This operator helps to conditionally include or exclude fields in+the JSON object based on the presence or absence of values.+#+begin_src haskell+{- | 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 a, ToJSON v) => Key -> Maybe v -> Maybe a+key .=? Just value = Just (key .= value)+_ .=? Nothing = Nothing+#+end_src++*** Options.hs+:PROPERTIES:+:header-args:haskell+: :tangle src/Options.hs+:END:+#+begin_src haskell+module Options+ ( Opts(..)+ , execParser+ , prefs+ , showHelpOnEmpty+ , optsParser+ , optsParserInfo ) where++import Options.Applicative+ ( (<**>),+ auto,+ fullDesc,+ header,+ help,+ info,+ long,+ metavar,+ option,+ strOption,+ prefs,+ progDesc,+ short,+ showHelpOnEmpty,+ value,+ execParser,+ Parser,+ ParserInfo,+ infoOption,+ hidden )++import Options.Applicative.Extra ( helperWith )++import Version ( versionStr, progName )+import Data.Kind (Type)++#+end_src++**** Data record for holding parsed 'Parser' values+#+begin_src haskell+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.+ , optVersion :: Type -> Type -- ^ Print program version.+ }+#+end_src++**** =Parser Opts= definition+#+begin_quote+A [[https://hackage.haskell.org/package/optparse-applicative-0.18.1.0/docs/Options-Applicative.html#t:Parser][Parser]] a is an option parser returning a value of type a.+#+end_quote++Specify how =Options.Applicative= should parse arguments. Their returned+values are stored in the custom defined data record =Opts=.+#+begin_src haskell+optsParser :: Parser Opts+optsParser+ = Opts+ <$> portOptParser+ <*> hostOptParser+ <*> passOptParser+ <*> versionOptParse++portOptParser :: Parser Integer+portOptParser+ = option auto+ $ long "port"+ <> short 'p'+ <> metavar "PORTNUM"+ <> value 6600+ <> help "Port number"++hostOptParser :: Parser String+hostOptParser+ = strOption+ $ metavar "ADDRESS"+ <> long "host"+ <> short 'h'+ <> value "localhost"+ <> help "Host address"++passOptParser :: Parser String+passOptParser+ = option auto+ $ metavar "PASSWORD"+ <> long "password"+ <> short 'P'+ <> value ""+ <> help "Password for connecting (will be sent as plain text)"++versionOptParse :: Parser (a -> a)+versionOptParse =+ infoOption versionStr+ $ long "version"+ <> short 'V'+ <> help "Display the version number"+#+end_src++**** Create ParserInfo++#+begin_quote+A [[https://hackage.haskell.org/package/optparse-applicative-0.18.1.0/docs/Options-Applicative.html#t:ParserInfo][ParserInfo]] describes a command line program, used to generate a help+screen.+--- [[https://hackage.haskell.org/package/optparse-applicative-0.18.1.0/docs/Options-Applicative.html#g:8][Options.Applicative]]+#+end_quote++- =optsParserInfo=++ Utility function for =Options.Applicative='s "=info=" that create a+ =ParserInfo= given a [[https://hackage.haskell.org/package/optparse-applicative-0.18.1.0/docs/Options-Applicative.html#t:Parser][=Parser=]] and a modifier, where =Parser=s are defined+ using a [[*Data record for holding parsed 'Parser' values][custom data record]].+#+begin_src haskell+optsParserInfo :: ParserInfo Opts+optsParserInfo = info (optsParser <**> helper')+ $ fullDesc+ <> progDesc "Print currently playing song information as JSON"+ <> header (progName ++ " - " ++ "Current MPD song information as JSON")+#+end_src++**** Custom helper+#+begin_quote+Like helper, but with a minimal set of modifiers that can be extended+as desired.+ #+begin_src haskell :tangle no+ opts :: ParserInfo Sample+ opts = info (sample <**> helperWith (mconcat [+ long "help",+ short 'h',+ help "Show this help text",+ hidden+ ])) mempty+ #+end_src++--- source of [[https://hackage.haskell.org/package/optparse-applicative-0.18.1.0/docs/Options-Applicative.html#v:helper][Options.Applicative#helper]]+#+end_quote+Define a helper command that only accepts long =--help=:+#+begin_src haskell+helper' :: Parser (a -> a)+helper' = helperWith+ $ long "help"+ -- <> help "Show this help text"+ <> hidden -- don't show in help messages+#+end_src++*** Version.hs+:PROPERTIES:+:header-args:haskell+: :tangle src/Version.hs+:END:+#+begin_src haskell+module Version ( versionStr,+ progName ) where++import Data.Version (showVersion)++import Paths_mpd_current_json (version) -- generated by Cabal++progName :: [Char]+progName = "mpd-current-json"++versionStr :: [Char]+versionStr = progName ++ " version " ++ (showVersion version)+#+end_src+++*** Setup.hs+:PROPERTIES:+:header-args:haskell+: :tangle Setup.hs+:END:+Allow =runhaskell= to use =cabal=+#+begin_src haskell+import Distribution.Simple+main = defaultMain+#+end_src++** Extra++*** mpd-current-json.cabal+:PROPERTIES:+:header-args:haskell-cabal+: :tangle mpd-current-json.cabal :comments none+:END:+#+begin_src haskell-cabal+cabal-version: 3.0+name: mpd-current-json+-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 1.1.0.2+synopsis: Print current MPD song and status as JSON++-- 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++-- A URL where users can report bugs.+-- bug-reports:+license: Unlicense+license-file: UNLICENSE+author: Lucas G+maintainer: g@11xx.org++-- A copyright notice.+-- copyright:+category: Network+extra-source-files: CHANGELOG.md+ README.org++source-repository head+ type: git+ location: https://codeberg.org/useless-utils/mpd-current-json++executable mpd-current-json+ main-is: Main.hs++ -- Modules included in this executable, other than Main.+ other-modules: Options+ Paths_mpd_current_json+ Version++ autogen-modules: Paths_mpd_current_json++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:+ build-depends: base >4.15 && <4.17+ , libmpd == 0.10.*+ , optparse-applicative >0.17 && <0.19+ , aeson == 2.1.*+ , bytestring >0.10 && <0.12+ , aeson-pretty == 0.8.*++ -- Directories containing source files.+ hs-source-dirs: src+ default-language: Haskell2010++ -- [[https://kowainik.github.io/posts/2019-02-06-style-guide#ghc-options][Haskell Style Guide :: Kowainik]]+ 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++#+end_src+++* Changelog+#+begin_src markdown :tangle CHANGELOG.md+# v1.1.0.2+[comment]: # (2023-10-23)+- Fixed cabal `build-depends` version bounds for Arch Linux dynamic+ building.++# v1.1.0.1+[comment]: # (2023-10-17)+- Added haddock comments+- Addressed `cabal check` warnings;+- setup for uploading as a Hackage package.++# v1.1.0.0+[comment]: # (2023-06-11)+- Remove `-h` from `--help` and use `-h` for `--host`+- Make `--help` option hidden in the help message++# v1.0.0.0+[comment]: # (2023-06-08)+Initial working version+- Added conditional tags printing, only non-empty values are printed+- Accept host, port and password+- Nested json objects for `status` and `tags`+- Added `elapsed_percent` key shortcut for `elapsed / duration * 100`++# v0.0.1.0+[comment]: # (2023-06-01)+- initial connection and parsing values+- First version. Released on an unsuspecting world.+#+end_src++* Local file variables :noexport:+# Local Variables:+# org-src-preserve-indentation: t+# End:
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ UNLICENSE view
@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <https://unlicense.org>
+ mpd-current-json.cabal view
@@ -0,0 +1,69 @@+cabal-version: 3.0+name: mpd-current-json+-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 1.1.0.2+synopsis: Print current MPD song and status as JSON++-- 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++-- A URL where users can report bugs.+-- bug-reports:+license: Unlicense+license-file: UNLICENSE+author: Lucas G+maintainer: g@11xx.org++-- A copyright notice.+-- copyright:+category: Network+extra-source-files: CHANGELOG.md+ README.org++source-repository head+ type: git+ location: https://codeberg.org/useless-utils/mpd-current-json++executable mpd-current-json+ main-is: Main.hs++ -- Modules included in this executable, other than Main.+ other-modules: Options+ Paths_mpd_current_json+ Version++ autogen-modules: Paths_mpd_current_json++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:+ build-depends: base >4.15 && <4.17+ , libmpd == 0.10.*+ , optparse-applicative >0.17 && <0.19+ , aeson == 2.1.*+ , bytestring >0.10 && <0.12+ , aeson-pretty == 0.8.*++ -- Directories containing source files.+ hs-source-dirs: src+ default-language: Haskell2010++ -- [[https://kowainik.github.io/posts/2019-02-06-style-guide#ghc-options][Haskell Style Guide :: Kowainik]]+ 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
+ src/Main.hs view
@@ -0,0 +1,235 @@+{-# LANGUAGE OverloadedStrings #-}++module Main ( main,+ getStatusItem,+ getTag,+ processSong,+ headMay,+ valueToStringMay,+ (.=?) ) where++import qualified Network.MPD as MPD+import Network.MPD+ ( Metadata(..), Song, PlaybackState(Stopped, Playing, Paused) )+import Data.Maybe ( catMaybes )+import Data.Aeson ( object, Key, KeyValue(..), ToJSON )+import Data.Aeson.Encode.Pretty ( encodePretty )+import qualified Data.ByteString.Lazy.Char8 as C+import Text.Printf ( printf )+import Options+ ( optsParserInfo, execParser, Opts(optPass, optHost, optPort) )+{- | 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++ cs <- MPD.withMPDEx (optHost opts) (optPort opts) (optPass opts) MPD.currentSong+ st <- MPD.withMPDEx (optHost opts) (optPort opts) (optPass opts) 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 getStatusItem st MPD.stState of+ Just ps -> case ps of+ Playing -> Just "play" -- same as mpc+ Paused -> Just "pause" -- same as mpc+ Stopped -> Just "stopped"+ Nothing -> Nothing++ time = getStatusItem st MPD.stTime++ elapsed = case time of+ Just t -> case t of+ Just (e, _) -> Just e+ _ -> Nothing+ Nothing -> Nothing++ duration = case time of+ Just t -> case t of+ Just (_, d) -> Just d+ _ -> Nothing+ Nothing -> Nothing++ elapsedPercent :: Maybe Double+ elapsedPercent = case time of+ Just t -> case t of+ Just t1 -> Just (read $ printf "%.2f" (uncurry (/) t1 * 100))+ Nothing -> Just 0+ Nothing -> Nothing++ repeatSt = getStatusItem st MPD.stRepeat+ randomSt = getStatusItem st MPD.stRandom+ singleSt = getStatusItem st MPD.stSingle+ consumeSt = getStatusItem st MPD.stConsume+ pos = getStatusItem st MPD.stSongPos+ playlistLength = getStatusItem st MPD.stPlaylistLength+ bitrate = getStatusItem st MPD.stBitrate+ audioFormat = getStatusItem st MPD.stAudio+ errorSt = getStatusItem st MPD.stError++ -- sgTags+ let jTags = object . catMaybes $+ [ "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+ ]++ -- status+ let jStatus = object . catMaybes $+ [ "state" .=? state+ , "repeat" .=? repeatSt+ , "elapsed" .=? elapsed+ , "duration" .=? duration+ , "elapsed_percent" .=? elapsedPercent+ , "random" .=? randomSt+ , "single" .=? singleSt+ , "consume" .=? consumeSt+ , "song_position" .=? pos+ , "playlist_length" .=? playlistLength+ , "bitrate" .=? bitrate+ , "audio_format" .=? audioFormat+ , "error" .=? errorSt+ ]++ let jObject = object [ "tags" .= jTags+ , "status" .= jStatus ]++ C.putStrLn $ encodePretty jObject++{- | Extract a field from the returned MPD.Status data record.++This takes an @Either@ 'Network.MPD.MPDError' 'Network.MPD.Status'+value and a field label function @f@ as arguments. It returns @Just+(f st)@ if the input status is @Right st@, where @st@ is the+'Network.MPD.Status' value. This function helps to extract a+specific field from the @MPD.Status@ data record by providing the+corresponding field label function. If the input status "@st@" is+not @Right st@, indicating an error, or the field label function is+not applicable, it returns @Nothing@.+-}+getStatusItem :: Either MPD.MPDError MPD.Status -> (MPD.Status -> a) -> Maybe a+getStatusItem (Right st) f = Just (f st)+getStatusItem _ _ = Nothing++{- | @Either@ check for the returned value of 'Network.MPD.currentSong',+then call 'processSong' or return @Nothing@.+-}+getTag :: Metadata -> Either a (Maybe Song) -> Maybe String+getTag t c =+ case c of+ Left _ -> Nothing+ Right song -> processSong t song++{- | 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.+-}+processSong :: Metadata -> Maybe Song -> Maybe String+processSong _ Nothing = Nothing+processSong tag (Just song) = do+ let tagVal = MPD.sgGetTag tag song+ valueToStringMay =<< (headMay =<< tagVal)++{- | Safely get the head of a list. Same as '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]@. '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 a, ToJSON v) => Key -> Maybe v -> Maybe a+key .=? Just value = Just (key .= value)+_ .=? Nothing = Nothing
+ src/Options.hs view
@@ -0,0 +1,95 @@+module Options+ ( Opts(..)+ , execParser+ , prefs+ , showHelpOnEmpty+ , optsParser+ , optsParserInfo ) where++import Options.Applicative+ ( (<**>),+ auto,+ fullDesc,+ header,+ help,+ info,+ long,+ metavar,+ option,+ strOption,+ prefs,+ progDesc,+ short,+ showHelpOnEmpty,+ value,+ execParser,+ Parser,+ ParserInfo,+ infoOption,+ hidden )++import Options.Applicative.Extra ( helperWith )++import Version ( versionStr, progName )+import Data.Kind (Type)++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.+ , optVersion :: Type -> Type -- ^ Print program version.+ }++optsParser :: Parser Opts+optsParser+ = Opts+ <$> portOptParser+ <*> hostOptParser+ <*> passOptParser+ <*> versionOptParse++portOptParser :: Parser Integer+portOptParser+ = option auto+ $ long "port"+ <> short 'p'+ <> metavar "PORTNUM"+ <> value 6600+ <> help "Port number"++hostOptParser :: Parser String+hostOptParser+ = strOption+ $ metavar "ADDRESS"+ <> long "host"+ <> short 'h'+ <> value "localhost"+ <> help "Host address"++passOptParser :: Parser String+passOptParser+ = option auto+ $ metavar "PASSWORD"+ <> long "password"+ <> short 'P'+ <> value ""+ <> help "Password for connecting (will be sent as plain text)"++versionOptParse :: Parser (a -> a)+versionOptParse =+ infoOption versionStr+ $ long "version"+ <> short 'V'+ <> help "Display the version number"++optsParserInfo :: ParserInfo Opts+optsParserInfo = info (optsParser <**> helper')+ $ fullDesc+ <> progDesc "Print currently playing song information as JSON"+ <> header (progName ++ " - " ++ "Current MPD song information as JSON")++helper' :: Parser (a -> a)+helper' = helperWith+ $ long "help"+ -- <> help "Show this help text"+ <> hidden -- don't show in help messages
+ src/Version.hs view
@@ -0,0 +1,12 @@+module Version ( versionStr,+ progName ) where++import Data.Version (showVersion)++import Paths_mpd_current_json (version) -- generated by Cabal++progName :: [Char]+progName = "mpd-current-json"++versionStr :: [Char]+versionStr = progName ++ " version " ++ (showVersion version)