{-# 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 ()
IO ()
main = do
  Opts
opts <- forall a. ParserInfo a -> IO a
execParser ParserInfo Opts
optsParserInfo

  Response (Maybe Song)
cs <- forall a. String -> Port -> String -> MPD a -> IO (Response a)
MPD.withMPDEx (Opts -> String
optHost Opts
opts) (Opts -> Port
optPort Opts
opts) (Opts -> String
optPass Opts
opts) forall (m :: * -> *). MonadMPD m => m (Maybe Song)
MPD.currentSong
  Response Status
st <- forall a. String -> Port -> String -> MPD a -> IO (Response a)
MPD.withMPDEx (Opts -> String
optHost Opts
opts) (Opts -> Port
optPort Opts
opts) (Opts -> String
optPass Opts
opts) forall (m :: * -> *). MonadMPD m => m Status
MPD.status

  let artist :: Maybe String
artist                     = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Artist                     Response (Maybe Song)
cs
      artistSort :: Maybe String
artistSort                 = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
ArtistSort                 Response (Maybe Song)
cs
      album :: Maybe String
album                      = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Album                      Response (Maybe Song)
cs
      albumSort :: Maybe String
albumSort                  = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
AlbumSort                  Response (Maybe Song)
cs
      albumArtist :: Maybe String
albumArtist                = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
AlbumArtist                Response (Maybe Song)
cs
      albumArtistSort :: Maybe String
albumArtistSort            = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
AlbumArtistSort            Response (Maybe Song)
cs
      title :: Maybe String
title                      = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Title                      Response (Maybe Song)
cs
      track :: Maybe String
track                      = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Track                      Response (Maybe Song)
cs
      name :: Maybe String
name                       = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Name                       Response (Maybe Song)
cs
      genre :: Maybe String
genre                      = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Genre                      Response (Maybe Song)
cs
      date :: Maybe String
date                       = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Date                       Response (Maybe Song)
cs
      originalDate :: Maybe String
originalDate               = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
OriginalDate               Response (Maybe Song)
cs
      composer :: Maybe String
composer                   = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Composer                   Response (Maybe Song)
cs
      performer :: Maybe String
performer                  = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Performer                  Response (Maybe Song)
cs
      conductor :: Maybe String
conductor                  = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Conductor                  Response (Maybe Song)
cs
      work :: Maybe String
work                       = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Work                       Response (Maybe Song)
cs
      grouping :: Maybe String
grouping                   = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Grouping                   Response (Maybe Song)
cs
      comment :: Maybe String
comment                    = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Comment                    Response (Maybe Song)
cs
      disc :: Maybe String
disc                       = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Disc                       Response (Maybe Song)
cs
      label :: Maybe String
label                      = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Label                      Response (Maybe Song)
cs
      musicbrainz_Artistid :: Maybe String
musicbrainz_Artistid       = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
MUSICBRAINZ_ARTISTID       Response (Maybe Song)
cs
      musicbrainz_Albumid :: Maybe String
musicbrainz_Albumid        = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
MUSICBRAINZ_ALBUMID        Response (Maybe Song)
cs
      musicbrainz_Albumartistid :: Maybe String
musicbrainz_Albumartistid  = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
MUSICBRAINZ_ALBUMARTISTID  Response (Maybe Song)
cs
      musicbrainz_Trackid :: Maybe String
musicbrainz_Trackid        = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
MUSICBRAINZ_TRACKID        Response (Maybe Song)
cs
      musicbrainz_Releasetrackid :: Maybe String
musicbrainz_Releasetrackid = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
MUSICBRAINZ_RELEASETRACKID Response (Maybe Song)
cs
      musicbrainz_Workid :: Maybe String
musicbrainz_Workid         = forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
MUSICBRAINZ_WORKID         Response (Maybe Song)
cs

  let state :: Maybe String
      state :: Maybe String
state = case forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> PlaybackState
MPD.stState of
                Just PlaybackState
ps -> case PlaybackState
ps of
                             PlaybackState
Playing -> forall a. a -> Maybe a
Just String
"play"  -- same as mpc
                             PlaybackState
Paused  -> forall a. a -> Maybe a
Just String
"pause"  -- same as mpc
                             PlaybackState
Stopped -> forall a. a -> Maybe a
Just String
"stopped"
                Maybe PlaybackState
Nothing -> forall a. Maybe a
Nothing

      time :: Maybe (Maybe (Double, Double))
time = forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Maybe (Double, Double)
MPD.stTime

      elapsed :: Maybe Double
elapsed = case Maybe (Maybe (Double, Double))
time of
        Just Maybe (Double, Double)
t -> case Maybe (Double, Double)
t of
                    Just (Double
e, Double
_) -> forall a. a -> Maybe a
Just Double
e
                    Maybe (Double, Double)
_           -> forall a. Maybe a
Nothing
        Maybe (Maybe (Double, Double))
Nothing -> forall a. Maybe a
Nothing

      duration :: Maybe Double
duration = case Maybe (Maybe (Double, Double))
time of
        Just Maybe (Double, Double)
t -> case Maybe (Double, Double)
t of
                    Just (Double
_, Double
d) -> forall a. a -> Maybe a
Just Double
d
                    Maybe (Double, Double)
_           -> forall a. Maybe a
Nothing
        Maybe (Maybe (Double, Double))
Nothing -> forall a. Maybe a
Nothing

      elapsedPercent :: Maybe Double
      elapsedPercent :: Maybe Double
elapsedPercent = case Maybe (Maybe (Double, Double))
time of
        Just Maybe (Double, Double)
t -> case Maybe (Double, Double)
t of
                    Just (Double, Double)
t1 -> forall a. a -> Maybe a
Just (forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%.2f" (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Fractional a => a -> a -> a
(/) (Double, Double)
t1 forall a. Num a => a -> a -> a
* Double
100))
                    Maybe (Double, Double)
Nothing -> forall a. a -> Maybe a
Just Double
0
        Maybe (Maybe (Double, Double))
Nothing -> forall a. Maybe a
Nothing

      repeatSt :: Maybe Bool
repeatSt       = forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Bool
MPD.stRepeat
      randomSt :: Maybe Bool
randomSt       = forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Bool
MPD.stRandom
      singleSt :: Maybe Bool
singleSt       = forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Bool
MPD.stSingle
      consumeSt :: Maybe Bool
consumeSt      = forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Bool
MPD.stConsume
      pos :: Maybe (Maybe Position)
pos            = forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Maybe Position
MPD.stSongPos
      playlistLength :: Maybe Port
playlistLength = forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Port
MPD.stPlaylistLength
      bitrate :: Maybe (Maybe Position)
bitrate        = forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Maybe Position
MPD.stBitrate
      audioFormat :: Maybe (Position, Position, Position)
audioFormat    = forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> (Position, Position, Position)
MPD.stAudio
      errorSt :: Maybe (Maybe String)
errorSt        = forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Maybe String
MPD.stError

  -- sgTags
  let jTags :: Value
jTags = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
        [ Key
"artist"                     forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
artist
        , Key
"artist_sort"                forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
artistSort
        , Key
"album"                      forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
album
        , Key
"album_sort"                 forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
albumSort
        , Key
"album_artist"               forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
albumArtist
        , Key
"album_artist_sort"          forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
albumArtistSort
        , Key
"title"                      forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
title
        , Key
"track"                      forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
track
        , Key
"name"                       forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
name
        , Key
"genre"                      forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
genre
        , Key
"date"                       forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
date
        , Key
"original_date"              forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
originalDate
        , Key
"composer"                   forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
composer
        , Key
"performer"                  forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
performer
        , Key
"conductor"                  forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
conductor
        , Key
"work"                       forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
work
        , Key
"grouping"                   forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
grouping
        , Key
"comment"                    forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
comment
        , Key
"disc"                       forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
disc
        , Key
"label"                      forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
label
        , Key
"musicbrainz_artistid"       forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Artistid
        , Key
"musicbrainz_albumid"        forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Albumid
        , Key
"musicbrainz_albumartistid"  forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Albumartistid
        , Key
"musicbrainz_trackid"        forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Trackid
        , Key
"musicbrainz_releasetrackid" forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Releasetrackid
        , Key
"musicbrainz_workid"         forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Workid
        ]

  -- status
  let jStatus :: Value
jStatus = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
        [ Key
"state"           forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
state
        , Key
"repeat"          forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Bool
repeatSt
        , Key
"elapsed"         forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Double
elapsed
        , Key
"duration"        forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Double
duration
        , Key
"elapsed_percent" forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Double
elapsedPercent
        , Key
"random"          forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Bool
randomSt
        , Key
"single"          forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Bool
singleSt
        , Key
"consume"         forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Bool
consumeSt
        , Key
"song_position"   forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe (Maybe Position)
pos
        , Key
"playlist_length" forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Port
playlistLength
        , Key
"bitrate"         forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe (Maybe Position)
bitrate
        , Key
"audio_format"    forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe (Position, Position, Position)
audioFormat
        , Key
"error"           forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe (Maybe String)
errorSt
        ]

  let jObject :: Value
jObject = [Pair] -> Value
object [ Key
"tags"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
jTags
                       , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
jStatus ]

  ByteString -> IO ()
C.putStrLn forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encodePretty Value
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 :: forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem (Right Status
st) Status -> a
f = forall a. a -> Maybe a
Just (Status -> a
f Status
st)
getStatusItem Response Status
_ Status -> a
_ = forall a. Maybe a
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 :: forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
t Either a (Maybe Song)
c =
  case Either a (Maybe Song)
c of
    Left a
_ -> forall a. Maybe a
Nothing
    Right Maybe Song
song -> Metadata -> Maybe Song -> Maybe String
processSong Metadata
t Maybe Song
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 :: Metadata -> Maybe Song -> Maybe String
processSong Metadata
_ Maybe Song
Nothing = forall a. Maybe a
Nothing
processSong Metadata
tag (Just Song
song) = do
  let tagVal :: Maybe [Value]
tagVal = Metadata -> Song -> Maybe [Value]
MPD.sgGetTag Metadata
tag Song
song
  Value -> Maybe String
valueToStringMay forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall a. [a] -> Maybe a
headMay forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [Value]
tagVal)

{- | Safely get the head of a list. Same as 'Safe.headMay'.
-}
headMay :: [a] -> Maybe a
headMay :: forall a. [a] -> Maybe a
headMay []    = forall a. Maybe a
Nothing
headMay (a
x:[a]
_) = forall a. a -> Maybe a
Just a
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 :: Value -> Maybe String
valueToStringMay Value
x = forall a. a -> Maybe a
Just (forall a. ToString a => a -> String
MPD.toString Value
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
key .=? :: forall a v. (KeyValue a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Just v
value = forall a. a -> Maybe a
Just (Key
key forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
value)
Key
_   .=? Maybe v
Nothing    = forall a. Maybe a
Nothing