Skip to content

Files

Latest commit

 

History

History
1086 lines (959 loc) · 37.6 KB

LITERATE.org

File metadata and controls

1086 lines (959 loc) · 37.6 KB

Files

Executable Source

Main.hs

Pragma language extensions

{-# LANGUAGE OverloadedStrings #-}

Module declaration

module Main ( main ) where

Imports

Import for the libmpd library, added as libmpd == 0.10.* to mpd-current-json.cabal.

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 Options
       ( optsParserInfo, execParser, Opts(..), NextSongFlag(..) )

import Data.Aeson ( object, KeyValue((.=)) )
import Data.Aeson.Encode.Pretty
       ( defConfig, encodePretty', keyOrder, Config(..), Indent(..) )
import qualified Data.ByteString.Lazy.Char8 as C
import Text.Printf ( printf )

import Text.Read (readMaybe)
import Data.Maybe (fromMaybe)

Main

{- | 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

Parse the command-line options and bind the result to opts.

opts <- execParser optsParserInfo

Connect to MPD using either the provided arguments from the command-line or the default values, as defined in Parser Opts definition.

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
      ]

Create nested JSON objects with labels before each of them.

let jsonBaseObject tags = object
              $ [ "filename"      .= filename
                , "next_filename" .= filenameNext
                , "playlist"      .= jsonPlaylist
                , "status"        .= jsonStatus
                ] ++ tags

e.g. so they can be parsed as ”.tags.title” or ”.status.elapsed_percent”.

Helper for printing the encoded JSON

let printJson tags = C.putStrLn
                     $ encodePretty' customEncodeConf
                     $ jsonBaseObject tags

where customEncodeConf is an override for the Data.Aeson.Encode.Pretty’s Config data record. This is really unnecessary but using keyOrder it is possible to customize the order the encoded JSON bytestring will be displayed as.

By default print the encoded JSON object containing jsonBaseObject + a "tags" object for tags about the current song.

  • With no --next, --next-only, -n or -nn command-line flag provided, assign NoNextSong to optNext in Opts.
  • If the --next flag is provided to the program, assigning IncludeNextSong to optNext in Opts, include in its output JSON information about the next song in the playlist.
  • If the --next flag is provided twice either using it’s shorthand e.g. -nn or even --next --next, assigning OnlyNextSong to optNext in Opts replace the "tags" object with information about the next song instead.
case optNext opts of
  NoNextSong -> printJson [ "tags" .= jsonCurrentSongTags ]

  OnlyNextSong -> printJson [ "tags" .= jsonNextSongTags ]
  IncludeNextSong -> printJson [ "tags" .= jsonCurrentSongTags
                               , "next" .= object [ "tags" .= jsonNextSongTags ] ]
customEncodeConf :: Config
customEncodeConf = defConfig
 { confCompare =
     keyOrder
     -- top level labels
     [ "filename", "next_filename", "status", "playlist", "tags", "next"
     -- tags
     , "title", "name"
     , "artist", "album_artist", "artist_sort", "album_artist_sort"
     , "album", "album_sort"
     , "track", "disc"
     , "date", "original_date"
     , "genre", "composer", "performer", "conductor"
     , "work", "grouping", "label"
     , "comment"
     , "musicbrainz_artistid"
     , "musicbrainz_albumid"
     , "musicbrainz_albumartistid"
     , "musicbrainz_trackid"
     , "musicbrainz_releasetrackid"
     , "musicbrainz_workid"
     -- status
     , "state", "repeat", "random", "single", "consume"
     , "duration", "elapsed", "elapsed_percent"
     , "volume", "audio_format", "bitrate"
     , "crossfade", "mixramp_db", "mixramp_delay"
     , "updating_db"
     , "error"
     -- playlist
     , "id", "next_id", "position", "next_position"
     , "length"
     ]
 , confIndent = Spaces 2
 }

Options.hs

module Options
  ( Opts(..)
  , NextSongFlag(..)
  , execParser
  , prefs
  , showHelpOnEmpty
  , optsParser
  , optsParserInfo ) where

import Options.Applicative
    ( (<**>),
      auto,
      fullDesc,
      header,
      help,
      info,
      long,
      metavar,
      option,
      strOption,
      flag',
      prefs,
      progDesc,
      short,
      showHelpOnEmpty,
      value,
      execParser,
      Parser,
      ParserInfo,
      infoOption,
      hidden,
      many,
      (<|>) )

import Options.Applicative.Extra ( helperWith )

import Version ( versionStr, progName )
import Data.Kind (Type)

Data record for holding parsed ‘Parser’ values

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.
  }

data NextSongFlag = IncludeNextSong
                  | OnlyNextSong
                  | NoNextSong

Parser Opts definition

A Parser a is an option parser returning a value of type a.

Specify how Options.Applicative should parse arguments. Their returned values are stored in the custom defined data record Opts.

optsParser :: Parser Opts
optsParser
  = Opts
  <$> portOptParser
  <*> hostOptParser
  <*> passOptParser
  <*> nextSongOptParser
  <*> versionOptParse
  where
    nextSongOptParser = nextSongFlagCountOptParser
                        <|> nextSongOnlyOptParser

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)"

nextSongFlagCountOptParser :: Parser NextSongFlag
nextSongFlagCountOptParser =
  fmap (intToNextSong . length) <$> many
  $ flag' ()
  $ short 'n'
  <> long "next"
  <> help ( concat
            [ "If used once (e.g. -n), include next song information in the output.\n"
            , "If used twice (e.g. -nn) it's an alias for --next-only." ])

nextSongOnlyOptParser :: Parser NextSongFlag
nextSongOnlyOptParser
  = flag' OnlyNextSong
    ( long "next-only"
      <> help "Only print next song information." )

intToNextSong :: Int -> NextSongFlag
intToNextSong count
  | count == 1 = IncludeNextSong
  | count > 1 = OnlyNextSong
  | otherwise = NoNextSong

versionOptParse :: Parser (a -> a)
versionOptParse =
  infoOption versionStr
  $ long "version"
  <> short 'V'
  <> help "Display the version number"

Create ParserInfo

A ParserInfo describes a command line program, used to generate a help screen. — Options.Applicative

optsParserInfo :: ParserInfo Opts
optsParserInfo = info (optsParser <**> helper')
  $ fullDesc
  <> progDesc "Print currently playing song information as JSON"
  <> header (progName ++ " - " ++ "Current MPD song information as JSON")

Custom helper

Like helper, but with a minimal set of modifiers that can be extended as desired.

opts :: ParserInfo Sample
opts = info (sample <**> helperWith (mconcat [
         long "help",
         short 'h',
         help "Show this help text",
         hidden
       ])) mempty
  

— source of Options.Applicative#helper

Define a helper command that only accepts long --help:

helper' :: Parser (a -> a)
helper' = helperWith
          $ long "help"
          -- <> help "Show this help text"
          <> hidden -- don't show in help messages

Version.hs

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)

Setup.hs

Allow runhaskell to use cabal
import Distribution.Simple
main = defaultMain

Library Source

Network.MPD.Parse

Parsing functions module for libmpd retrieved data.

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 )

Define a data record for storing parsed tags as Maybe String or Maybe [String], this works because even though String and [String] are different, Data.Aeson.Value support various different types for encoding them into the different JSON types. The supported types can be converted into Values using toJSON.

At first TagField was just an alias for Maybe String but later adding support for multi-value tags, to be able to store either of them in them same data record field custom type representing both was very useful.

This approach greatly improved performance when comparing to doing everything in a IO block.

{- | 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
  }

The data record Song from the command currentSong contains a field label ”sgTags” that contains all MPD supported embedded metadata tags in a fromList [...], this helper stores the output from the parser getTag function calls in the custom data record ExtractedTags.

{- | 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

Instead of parsing using function argument definitions, define a data type that instances the specific response the parsing functions return.

-- | 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

Get the Int from MPD.status’s Either (Status {...}) fields that use the MPD.Id wrapper: stSongID and stNextSongID. The current song ID is also available in the response from MPD.currentSong as Either (Maybe (Song {sgId})).

-- | 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

Network.MPD.JSON

{-# 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 )

Filter list of [Maybe Pair] key/values.

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”.

{- | 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

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.

{- | 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 .=?

mpd-current-json.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:            2.1.0.0
synopsis:           Print current MPD song and status as JSON

tested-with: GHC == { 9.10.1, 9.4.8 }
-- A longer description of the package.
description: Print currently playing MPD's song metadata and status as JSON
homepage:           https://codeberg.org/useless-utils/mpd-current-json

-- A URL where users can report bugs.
-- bug-reports:
license:            Unlicense
license-file:       UNLICENSE
author:             Lucas G
maintainer:         [email protected]

-- A copyright notice.
-- copyright:
category:           Network
extra-doc-files:    CHANGELOG.md
                    README.org

source-repository head
    type:      git
    location:  https://codeberg.org/useless-utils/mpd-current-json

library
    -- exposed: False
    exposed-modules:  Network.MPD.Parse
                      Network.MPD.JSON
    build-depends:  base >=4.16 && <5
                  , libmpd == 0.10.*
                  , aeson == 2.2.*
                  , aeson-pretty == 0.8.*
                  , bytestring >=0.11 && <0.13
    hs-source-dirs: lib
    default-language: Haskell2010

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
                    , libmpd
                    , optparse-applicative == 0.18.*
                    , aeson
                    , aeson-pretty
                    , bytestring
                    , mpd-current-json

    -- 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
                    -O2

Changelog

# v2.1
- Fix multi-value tag arrays being in reverse order.

# v2.0.0.1
- Fix internal use of function unsupported in `base` version <4.19.
- Add `-O2` compilation flag to cabal file that benefits from v2.0 refactor.

# v2.0
- Major code rewrite.
- Add command-line flags:
  - `-n`: is an alias for `--next`
  - `-nn`: is an alias for `--next-only`
  - `--next`: Include information about the next queued song in the
    output JSON.
  - `--next-only`: Print only the next queued song's information,
    replacing the `tags` object.
- Add support for multi-value tags such as multiple artists. If a tag
  contains multiple values it should be displayed as an array in the
  output json.
- Major performance increase.

# v1.5.0.1
- Fix `next_filename` to display correct filename URI.
  - It was using Id instead of Position. Position is a 0-indexed
    number, Id is 1-indexed and it was returning one song after the
    intended one in the playlist. Oops.

# v1.5
- Add json keys
  - `volume`: Integer for volume percentage
  - `crossfade`: Integer seconds of crossfase
  - `mixramp_db`: Decibels for MixRamp, can use float (decimals) number
  - `mixramp_delay`: Seconds of delay for MixRamp, can use float number
  - `updating_db`: Returns `true` when updading, not present otherwise
- More code refactoring, prepping for v2 for more abstractions :p

# v1.4.0
- Add "`next_filename`" for getting next song file URI relative to the
  music library.

# v1.3.2
- Add "`next_position`", "`id`" and "`next_id`" keys to `playlist`.

# v1.3.1
- Move helper function `objectJson` to lib

# v1.3
- Add `filename` key.
- Add `playlist` key and move existing keys to it.
- Customize ordering of displayed output JSON.
- Add cabal tested-with GHC versions

# v1.2.0.0
- Move literate Org Mode code to LITERATE.org file
- Move functions from executable source Main.hs to their own library
- Bump dependency versions for `aeson` and `bytestring`
- Changed status.state from "play" to "playing" and "pause" to
  "paused".
  The reason why it was "play" and "pause" before was because
  that was the socket answer string.

# 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.

Local file variables