{-# LANGUAGE OverloadedStrings #-}

module Main ( main ) where

import qualified Network.MPD as MPD
import Network.MPD ( PlaybackState(Stopped, Playing, Paused) )

import Network.MPD.Parse
    ( getAllTags,
      getStatusField,
      getStatusFieldElement,
      getStatusIdInt,
      maybePathCurrentSong,
      maybePathNextPlaylistSong,
      SongCurrentOrNext(..) )
import Network.MPD.JSON ( objectMaybes, jsonSongTags, (.=?) )
import 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)
{- | 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 <- ParserInfo Opts -> IO Opts
forall a. ParserInfo a -> IO a
execParser ParserInfo Opts
optsParserInfo

  let withMpdOpts = String -> Seconds -> String -> MPD a -> IO (Response a)
forall a. String -> Seconds -> String -> MPD a -> IO (Response a)
MPD.withMPDEx (Opts -> String
optHost Opts
opts) (Opts -> Seconds
optPort Opts
opts) (Opts -> String
optPass Opts
opts)
  currentSong <- withMpdOpts MPD.currentSong
  st <- withMpdOpts MPD.status

  let state :: Maybe String
      state = PlaybackState -> String
forall {a}. IsString a => PlaybackState -> a
playbackStateToString (PlaybackState -> String) -> Maybe PlaybackState -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response Status -> (Status -> PlaybackState) -> Maybe PlaybackState
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> PlaybackState
MPD.stState
        where
          playbackStateToString :: PlaybackState -> a
playbackStateToString PlaybackState
Playing = a
"playing"
          playbackStateToString PlaybackState
Paused  = a
"paused"
          playbackStateToString PlaybackState
Stopped = a
"stopped"

      time = Response Status
-> (Status -> Maybe (Double, Double)) -> Maybe (Double, Double)
forall a. Response Status -> (Status -> Maybe a) -> Maybe a
getStatusFieldElement Response Status
st Status -> Maybe (Double, Double)
MPD.stTime
      elapsed = (Double, Double) -> Double
forall a b. (a, b) -> a
fst ((Double, Double) -> Double)
-> Maybe (Double, Double) -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Double, Double)
time
      duration = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double)
-> Maybe (Double, Double) -> Maybe Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Double, Double)
time

      elapsedPercent :: Maybe Double
      elapsedPercent = String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe String
percentTwoDecimals
        where
          percentTwoDecimals :: String
percentTwoDecimals = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2f" Double
timeToPercent
          timeToPercent :: Double
timeToPercent = (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)
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100
          t :: (Double, Double)
t = (Double, Double) -> Maybe (Double, Double) -> (Double, Double)
forall a. a -> Maybe a -> a
fromMaybe (Double
0,Double
0) Maybe (Double, Double)
time

      volumeSt :: Maybe Int
      volumeSt = Volume -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Volume -> Int) -> Maybe Volume -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response Status -> (Status -> Maybe Volume) -> Maybe Volume
forall a. Response Status -> (Status -> Maybe a) -> Maybe a
getStatusFieldElement Response Status
st Status -> Maybe Volume
MPD.stVolume

      repeatSt       = Response Status -> (Status -> Bool) -> Maybe Bool
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> Bool
MPD.stRepeat
      randomSt       = Response Status -> (Status -> Bool) -> Maybe Bool
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> Bool
MPD.stRandom
      singleSt       = Response Status -> (Status -> Bool) -> Maybe Bool
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> Bool
MPD.stSingle
      consumeSt      = Response Status -> (Status -> Bool) -> Maybe Bool
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> Bool
MPD.stConsume
      bitrate        = Response Status -> (Status -> Maybe Int) -> Maybe (Maybe Int)
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> Maybe Int
MPD.stBitrate
      audioFormat    = Response Status
-> (Status -> (Int, Int, Int)) -> Maybe (Int, Int, Int)
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> (Int, Int, Int)
MPD.stAudio
      errorSt        = Response Status -> (Status -> Maybe String) -> Maybe (Maybe String)
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> Maybe String
MPD.stError

      updatingDbSt :: Maybe Bool
      updatingDbSt   = (Seconds -> Seconds -> Bool
forall a. Eq a => a -> a -> Bool
== Seconds
1) (Seconds -> Bool) -> Maybe Seconds -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response Status -> (Status -> Maybe Seconds) -> Maybe Seconds
forall a. Response Status -> (Status -> Maybe a) -> Maybe a
getStatusFieldElement Response Status
st Status -> Maybe Seconds
MPD.stUpdatingDb

      crossfadeSt :: Maybe Int
      crossfadeSt = Seconds -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Seconds -> Int) -> Maybe Seconds -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response Status -> (Status -> Seconds) -> Maybe Seconds
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> Seconds
MPD.stXFadeWidth

      mixRampDbSt = Response Status -> (Status -> Double) -> Maybe Double
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> Double
MPD.stMixRampdB
      mixRampDelay = Response Status -> (Status -> Double) -> Maybe Double
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> Double
MPD.stMixRampDelay

  -- positon is an index starting from 0. Id starts from 1
  let pos            = Response Status -> (Status -> Maybe Int) -> Maybe (Maybe Int)
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> Maybe Int
MPD.stSongPos
      nextPos        = Response Status -> (Status -> Maybe Int) -> Maybe Int
forall a. Response Status -> (Status -> Maybe a) -> Maybe a
getStatusFieldElement Response Status
st Status -> Maybe Int
MPD.stNextSongPos
      songId         = (Status -> Maybe Id) -> Response Status -> Maybe Int
getStatusIdInt Status -> Maybe Id
MPD.stSongID Response Status
st
      nextId         = (Status -> Maybe Id) -> Response Status -> Maybe Int
getStatusIdInt Status -> Maybe Id
MPD.stNextSongID Response Status
st
      playlistLength = Response Status -> (Status -> Seconds) -> Maybe Seconds
forall a. Response Status -> (Status -> a) -> Maybe a
getStatusField Response Status
st Status -> Seconds
MPD.stPlaylistLength

  nextSong <- withMpdOpts $ MPD.playlistInfo nextPos
  let filename = Response (Maybe Song) -> Maybe String
maybePathCurrentSong Response (Maybe Song)
currentSong
      filenameNext = Response [Song] -> Maybe String
maybePathNextPlaylistSong Response [Song]
nextSong

  -- sgTags
  let jsonCurrentSongTags = ExtractedTags -> Value
jsonSongTags (ExtractedTags -> Value) -> ExtractedTags -> Value
forall a b. (a -> b) -> a -> b
$ SongCurrentOrNext -> ExtractedTags
getAllTags (SongCurrentOrNext -> ExtractedTags)
-> SongCurrentOrNext -> ExtractedTags
forall a b. (a -> b) -> a -> b
$ Response (Maybe Song) -> SongCurrentOrNext
Current Response (Maybe Song)
currentSong
      jsonNextSongTags = ExtractedTags -> Value
jsonSongTags (ExtractedTags -> Value) -> ExtractedTags -> Value
forall a b. (a -> b) -> a -> b
$ SongCurrentOrNext -> ExtractedTags
getAllTags (SongCurrentOrNext -> ExtractedTags)
-> SongCurrentOrNext -> ExtractedTags
forall a b. (a -> b) -> a -> b
$ Response [Song] -> SongCurrentOrNext
Next Response [Song]
nextSong

  -- status
  let jsonStatus = [Maybe Pair] -> Value
objectMaybes
        [ 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
"volume"          Key -> Maybe Int -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Int
volumeSt
        , Key
"audio_format"    Key -> Maybe (Int, Int, Int) -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe (Int, Int, Int)
audioFormat
        , Key
"bitrate"         Key -> Maybe (Maybe Int) -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe (Maybe Int)
bitrate
        , Key
"crossfade"       Key -> Maybe Int -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Int
crossfadeSt
        , Key
"mixramp_db"      Key -> Maybe Double -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Double
mixRampDbSt
        , Key
"mixramp_delay"   Key -> Maybe Double -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Double
mixRampDelay
        , Key
"updating_db"     Key -> Maybe Bool -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Bool
updatingDbSt
        , 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 jFilename = objectMaybes [ "file" .=? filename ]

  let jsonPlaylist = [Maybe Pair] -> Value
objectMaybes
        [ Key
"position"      Key -> Maybe (Maybe Int) -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe (Maybe Int)
pos
        , Key
"next_position" Key -> Maybe Int -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Int
nextPos
        , Key
"id"            Key -> Maybe Int -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Int
songId
        , Key
"next_id"       Key -> Maybe Int -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Int
nextId
        , Key
"length"        Key -> Maybe Seconds -> Maybe Pair
forall e a v. (KeyValue e a, ToJSON v) => Key -> Maybe v -> Maybe a
.=? Maybe Seconds
playlistLength
        ]

  let jsonBaseObject [Pair]
tags = [Pair] -> Value
object
                ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ 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
"next_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
filenameNext
                  , 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
jsonPlaylist
                  , 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
jsonStatus
                  ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair]
tags

  let printJson [Pair]
tags = 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 -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
jsonBaseObject [Pair]
tags

  case optNext opts of
    NextSongFlag
NoNextSong -> [Pair] -> IO ()
printJson [ 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
jsonCurrentSongTags ]

    NextSongFlag
OnlyNextSong -> [Pair] -> IO ()
printJson [ 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
jsonNextSongTags ]
    NextSongFlag
IncludeNextSong -> [Pair] -> IO ()
printJson [ 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
jsonCurrentSongTags
                                 , Key
"next" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [ 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
jsonNextSongTags ] ]

customEncodeConf :: Config
customEncodeConf :: Config
customEncodeConf = Config
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
 }