{-# LANGUAGE OverloadedStrings #-}
module Main ( main ) where
import qualified Network.MPD as MPD
import Network.MPD
( Metadata(..), PlaybackState(Stopped, Playing, Paused) )
import Data.Maybe ( catMaybes )
import Data.Aeson ( object, KeyValue((.=)), Value )
import Data.Aeson.Encode.Pretty
( defConfig, encodePretty', keyOrder, Config(confCompare) )
import qualified Data.ByteString.Lazy.Char8 as C
import Text.Printf ( printf )
import Options
( optsParserInfo, execParser, Opts(optPass, optHost, optPort) )
import Network.MPD.Parse ( getStatusItem
, getTag
, maybePath
, (.=?) )
import Text.Read (readMaybe)
import Data.Aeson.Types (Pair)
main :: IO ()
IO ()
main = do
Opts
opts <- ParserInfo Opts -> IO Opts
forall a. ParserInfo a -> IO a
execParser ParserInfo Opts
optsParserInfo
Response (Maybe Song)
cs <- String
-> Port -> String -> MPD (Maybe Song) -> IO (Response (Maybe Song))
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) MPD (Maybe Song)
forall (m :: * -> *). MonadMPD m => m (Maybe Song)
MPD.currentSong
Response Status
st <- String -> Port -> String -> MPD Status -> IO (Response Status)
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) MPD Status
forall (m :: * -> *). MonadMPD m => m Status
MPD.status
let artist :: Maybe String
artist = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Artist Response (Maybe Song)
cs
artistSort :: Maybe String
artistSort = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
ArtistSort Response (Maybe Song)
cs
album :: Maybe String
album = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Album Response (Maybe Song)
cs
albumSort :: Maybe String
albumSort = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
AlbumSort Response (Maybe Song)
cs
albumArtist :: Maybe String
albumArtist = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
AlbumArtist Response (Maybe Song)
cs
albumArtistSort :: Maybe String
albumArtistSort = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
AlbumArtistSort Response (Maybe Song)
cs
title :: Maybe String
title = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Title Response (Maybe Song)
cs
track :: Maybe String
track = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Track Response (Maybe Song)
cs
name :: Maybe String
name = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Name Response (Maybe Song)
cs
genre :: Maybe String
genre = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Genre Response (Maybe Song)
cs
date :: Maybe String
date = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Date Response (Maybe Song)
cs
originalDate :: Maybe String
originalDate = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
OriginalDate Response (Maybe Song)
cs
composer :: Maybe String
composer = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Composer Response (Maybe Song)
cs
performer :: Maybe String
performer = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Performer Response (Maybe Song)
cs
conductor :: Maybe String
conductor = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Conductor Response (Maybe Song)
cs
work :: Maybe String
work = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Work Response (Maybe Song)
cs
grouping :: Maybe String
grouping = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Grouping Response (Maybe Song)
cs
comment :: Maybe String
comment = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Comment Response (Maybe Song)
cs
disc :: Maybe String
disc = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Disc Response (Maybe Song)
cs
label :: Maybe String
label = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
Label Response (Maybe Song)
cs
musicbrainz_Artistid :: Maybe String
musicbrainz_Artistid = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
MUSICBRAINZ_ARTISTID Response (Maybe Song)
cs
musicbrainz_Albumid :: Maybe String
musicbrainz_Albumid = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
MUSICBRAINZ_ALBUMID Response (Maybe Song)
cs
musicbrainz_Albumartistid :: Maybe String
musicbrainz_Albumartistid = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
MUSICBRAINZ_ALBUMARTISTID Response (Maybe Song)
cs
musicbrainz_Trackid :: Maybe String
musicbrainz_Trackid = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
MUSICBRAINZ_TRACKID Response (Maybe Song)
cs
musicbrainz_Releasetrackid :: Maybe String
musicbrainz_Releasetrackid = Metadata -> Response (Maybe Song) -> Maybe String
forall a. Metadata -> Either a (Maybe Song) -> Maybe String
getTag Metadata
MUSICBRAINZ_RELEASETRACKID Response (Maybe Song)
cs
musicbrainz_Workid :: Maybe String
musicbrainz_Workid = Metadata -> Response (Maybe Song) -> Maybe String
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 Response Status -> (Status -> PlaybackState) -> Maybe PlaybackState
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 -> String -> Maybe String
forall a. a -> Maybe a
Just String
"playing"
PlaybackState
Paused -> String -> Maybe String
forall a. a -> Maybe a
Just String
"paused"
PlaybackState
Stopped -> String -> Maybe String
forall a. a -> Maybe a
Just String
"stopped"
Maybe PlaybackState
Nothing -> Maybe String
forall a. Maybe a
Nothing
time :: Maybe (Maybe (Double, Double))
time = Response Status
-> (Status -> Maybe (Double, Double))
-> Maybe (Maybe (Double, Double))
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
_) -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
e
Maybe (Double, Double)
_noTag -> Maybe Double
forall a. Maybe a
Nothing
Maybe (Maybe (Double, Double))
Nothing -> Maybe Double
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) -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
d
Maybe (Double, Double)
_noTag -> Maybe Double
forall a. Maybe a
Nothing
Maybe (Maybe (Double, Double))
Nothing -> Maybe Double
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 -> String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Double) -> String -> Maybe Double
forall a b. (a -> b) -> a -> b
$ String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2f" ((Double -> Double -> Double) -> (Double, Double) -> Double
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(/) (Double, Double)
t1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)
Maybe (Double, Double)
Nothing -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
0
Maybe (Maybe (Double, Double))
Nothing -> Maybe Double
forall a. Maybe a
Nothing
repeatSt :: Maybe Bool
repeatSt = Response Status -> (Status -> Bool) -> Maybe Bool
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Bool
MPD.stRepeat
randomSt :: Maybe Bool
randomSt = Response Status -> (Status -> Bool) -> Maybe Bool
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Bool
MPD.stRandom
singleSt :: Maybe Bool
singleSt = Response Status -> (Status -> Bool) -> Maybe Bool
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Bool
MPD.stSingle
consumeSt :: Maybe Bool
consumeSt = Response Status -> (Status -> Bool) -> Maybe Bool
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Bool
MPD.stConsume
pos :: Maybe (Maybe Position)
pos = Response Status
-> (Status -> Maybe Position) -> Maybe (Maybe Position)
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Maybe Position
MPD.stSongPos
playlistLength :: Maybe Port
playlistLength = Response Status -> (Status -> Port) -> Maybe Port
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Port
MPD.stPlaylistLength
bitrate :: Maybe (Maybe Position)
bitrate = Response Status
-> (Status -> Maybe Position) -> Maybe (Maybe Position)
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Maybe Position
MPD.stBitrate
audioFormat :: Maybe (Position, Position, Position)
audioFormat = Response Status
-> (Status -> (Position, Position, Position))
-> Maybe (Position, Position, Position)
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> (Position, Position, Position)
MPD.stAudio
errorSt :: Maybe (Maybe String)
errorSt = Response Status -> (Status -> Maybe String) -> Maybe (Maybe String)
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusItem Response Status
st Status -> Maybe String
MPD.stError
let filename :: Maybe String
filename = Response (Maybe Song) -> Maybe String
forall a. Either a (Maybe Song) -> Maybe String
maybePath Response (Maybe Song)
cs
let jTags :: Value
jTags = [Maybe Pair] -> Value
objectJson
[ Key
"artist" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
artist
, Key
"artist_sort" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
artistSort
, Key
"album" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
album
, Key
"album_sort" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
albumSort
, Key
"album_artist" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
albumArtist
, Key
"album_artist_sort" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
albumArtistSort
, Key
"title" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
title
, Key
"track" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
track
, Key
"name" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
name
, Key
"genre" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
genre
, Key
"date" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
date
, Key
"original_date" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
originalDate
, Key
"composer" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
composer
, Key
"performer" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
performer
, Key
"conductor" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
conductor
, Key
"work" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
work
, Key
"grouping" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
grouping
, Key
"comment" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
comment
, Key
"disc" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
disc
, Key
"label" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
label
, Key
"musicbrainz_artistid" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Artistid
, Key
"musicbrainz_albumid" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Albumid
, Key
"musicbrainz_albumartistid" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Albumartistid
, Key
"musicbrainz_trackid" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Trackid
, Key
"musicbrainz_releasetrackid" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Releasetrackid
, Key
"musicbrainz_workid" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
musicbrainz_Workid
]
let jStatus :: Value
jStatus = [Maybe Pair] -> Value
objectJson
[ Key
"state" Key -> Maybe String -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe String
state
, Key
"repeat" Key -> Maybe Bool -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Bool
repeatSt
, Key
"random" Key -> Maybe Bool -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Bool
randomSt
, Key
"single" Key -> Maybe Bool -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Bool
singleSt
, Key
"consume" Key -> Maybe Bool -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Bool
consumeSt
, Key
"duration" Key -> Maybe Double -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Double
duration
, Key
"elapsed" Key -> Maybe Double -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Double
elapsed
, Key
"elapsed_percent" Key -> Maybe Double -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Double
elapsedPercent
, Key
"audio_format" Key -> Maybe (Position, Position, Position) -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe (Position, Position, Position)
audioFormat
, Key
"bitrate" Key -> Maybe (Maybe Position) -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe (Maybe Position)
bitrate
, Key
"error" Key -> Maybe (Maybe String) -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe (Maybe String)
errorSt
]
let jPlaylist :: Value
jPlaylist = [Maybe Pair] -> Value
objectJson
[ Key
"position" Key -> Maybe (Maybe Position) -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe (Maybe Position)
pos
, Key
"length" Key -> Maybe Port -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Port
playlistLength
]
let jObject :: Value
jObject = [Pair] -> Value
object [ Key
"filename" Key -> Maybe String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe String
filename
, Key
"playlist" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
jPlaylist
, Key
"status" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
jStatus
, Key
"tags" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
jTags
]
ByteString -> IO ()
C.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> Value -> ByteString
forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
customEncodeConf Value
jObject
customEncodeConf :: Config
customEncodeConf :: Config
customEncodeConf = Config
defConfig
{ confCompare :: Text -> Text -> Ordering
confCompare = [Text] -> Text -> Text -> Ordering
keyOrder [ Text
"title", Text
"name"
, Text
"artist", Text
"album_artist", Text
"artist_sort", Text
"album_artist_sort"
, Text
"album", Text
"album_sort"
, Text
"track", Text
"disc"
, Text
"date", Text
"original_date"
, Text
"genre", Text
"composer", Text
"performer", Text
"conductor"
, Text
"work", Text
"grouping", Text
"label"
, Text
"comment"
, Text
"musicbrainz_artistid"
, Text
"musicbrainz_albumid"
, Text
"musicbrainz_albumartistid"
, Text
"musicbrainz_trackid"
, Text
"musicbrainz_releasetrackid"
, Text
"musicbrainz_workid"
, Text
"state", Text
"repeat", Text
"random", Text
"single", Text
"consume"
, Text
"duration", Text
"elapsed", Text
"elapsed_percent"
, Text
"audio_format", Text
"bitrate"
, Text
"error"
]
}
objectJson :: [Maybe Pair] -> Value
objectJson :: [Maybe Pair] -> Value
objectJson = [Pair] -> Value
object ([Pair] -> Value)
-> ([Maybe Pair] -> [Pair]) -> [Maybe Pair] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes