{-# LANGUAGE OverloadedStrings, TupleSections #-}

{- |
Module      : Network.MPD.Applicative.Status
Copyright   : (c) Joachim Fasting 2012
License     : MIT

Maintainer  : joachifm@fastmail.fm
Stability   : stable
Portability : unportable

Querying MPD's status.
-}

module Network.MPD.Applicative.Status
    ( clearError
    , currentSong
    , idle
    , noidle
    , status
    , stats
    ) where
import           Control.Monad
import           Control.Arrow ((***))

import           Network.MPD.Util
import           Network.MPD.Applicative.Internal
import           Network.MPD.Commands.Arg hiding (Command)
import           Network.MPD.Commands.Parse
import           Network.MPD.Commands.Types

import           Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.UTF8 as UTF8

-- | Clear current error message in status.
clearError :: Command ()
clearError :: Command ()
clearError = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [String
"clearerror"]

-- | Song metadata for currently playing song, if any.
currentSong :: Command (Maybe Song)
currentSong :: Command (Maybe Song)
currentSong = Parser (Maybe Song) -> [String] -> Command (Maybe Song)
forall a. Parser a -> [String] -> Command a
Command (([ByteString] -> Either String (Maybe Song)) -> Parser (Maybe Song)
forall a. ([ByteString] -> Either String a) -> Parser a
liftParser [ByteString] -> Either String (Maybe Song)
parseMaybeSong) [String
"currentsong"]

takeSubsystems :: [ByteString] -> Either String [Subsystem]
takeSubsystems :: [ByteString] -> Either String [Subsystem]
takeSubsystems = ((ByteString, ByteString) -> Either String Subsystem)
-> [(ByteString, ByteString)] -> Either String [Subsystem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ByteString, ByteString) -> Either String Subsystem
f ([(ByteString, ByteString)] -> Either String [Subsystem])
-> ([ByteString] -> [(ByteString, ByteString)])
-> [ByteString]
-> Either String [Subsystem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [(ByteString, ByteString)]
toAssocList
    where
        f :: (ByteString, ByteString) -> Either String Subsystem
        f :: (ByteString, ByteString) -> Either String Subsystem
f (ByteString
"changed", ByteString
system) =
            case ByteString
system of
                ByteString
"database"        -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
DatabaseS
                ByteString
"update"          -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
UpdateS
                ByteString
"stored_playlist" -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
StoredPlaylistS
                ByteString
"playlist"        -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
PlaylistS
                ByteString
"player"          -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
PlayerS
                ByteString
"mixer"           -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
MixerS
                ByteString
"output"          -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
OutputS
                ByteString
"options"         -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
OptionsS
                ByteString
"partition"       -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
PartitionS
                ByteString
"sticker"         -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
StickerS
                ByteString
"subscription"    -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
SubscriptionS
                ByteString
"message"         -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
MessageS
                ByteString
"neighbor"        -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
NeighborS
                ByteString
"mount"           -> Subsystem -> Either String Subsystem
forall a b. b -> Either a b
Right Subsystem
MountS
                ByteString
k                 -> String -> Either String Subsystem
forall a b. a -> Either a b
Left (String
"Unknown subsystem: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
UTF8.toString ByteString
k)
        f (ByteString, ByteString)
x                       =  String -> Either String Subsystem
forall a b. a -> Either a b
Left (String
"idle: Unexpected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ByteString, ByteString) -> String
forall a. Show a => a -> String
show (ByteString, ByteString)
x)

-- | Wait until there is noteworthy change in one or more of MPD's
-- subsystems.
-- When active, only 'noidle' commands are allowed.
idle :: [Subsystem] -> Command [Subsystem]
idle :: [Subsystem] -> Command [Subsystem]
idle [Subsystem]
ss = Parser [Subsystem] -> [String] -> Command [Subsystem]
forall a. Parser a -> [String] -> Command a
Command (([ByteString] -> Either String [Subsystem]) -> Parser [Subsystem]
forall a. ([ByteString] -> Either String a) -> Parser a
liftParser [ByteString] -> Either String [Subsystem]
takeSubsystems) [String]
c
    where
        c :: [String]
c = [Command
"idle" Command -> Args -> String
forall a. MPDArg a => Command -> a -> String
<@> (Subsystem -> Args -> Args) -> Args -> [Subsystem] -> Args
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Subsystem -> Args -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
(<++>) ([String] -> Args
Args []) [Subsystem]
ss]

-- | Cancel an 'idle' request.
noidle :: Command ()
noidle :: Command ()
noidle = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [String
"noidle"]

-- | Get database statistics.
stats :: Command Stats
stats :: Command Stats
stats = Parser Stats -> [String] -> Command Stats
forall a. Parser a -> [String] -> Command a
Command (([ByteString] -> Either String Stats) -> Parser Stats
forall a. ([ByteString] -> Either String a) -> Parser a
liftParser [ByteString] -> Either String Stats
parseStats) [String
"stats"]

-- | Get the current status of the player.
status :: Command Status
status :: Command Status
status = Parser Status -> [String] -> Command Status
forall a. Parser a -> [String] -> Command a
Command (([ByteString] -> Either String Status) -> Parser Status
forall a. ([ByteString] -> Either String a) -> Parser a
liftParser [ByteString] -> Either String Status
parseStatus) [String
"status"]
  where
    -- Builds a 'Status' instance from an assoc. list.
    parseStatus :: [ByteString] -> Either String Status
    parseStatus :: [ByteString] -> Either String Status
parseStatus = (Status -> (ByteString, ByteString) -> Either String Status)
-> Status -> [(ByteString, ByteString)] -> Either String Status
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Status -> (ByteString, ByteString) -> Either String Status
forall {a}.
(Eq a, IsString a, Show a) =>
Status -> (a, ByteString) -> Either String Status
go Status
forall a. Default a => a
def ([(ByteString, ByteString)] -> Either String Status)
-> ([ByteString] -> [(ByteString, ByteString)])
-> [ByteString]
-> Either String Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [(ByteString, ByteString)]
toAssocList
        where
            go :: Status -> (a, ByteString) -> Either String Status
go Status
a p :: (a, ByteString)
p@(a
k, ByteString
v) = case a
k of
                a
"volume"         -> (Maybe Volume -> Status) -> Either String Status
forall {a} {b}. Num a => (Maybe a -> b) -> Either String b
vol    ((Maybe Volume -> Status) -> Either String Status)
-> (Maybe Volume -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Maybe Volume
x -> Status
a { stVolume          = x }
                a
"repeat"         -> (Bool -> Status) -> Either String Status
forall {b}. (Bool -> b) -> Either String b
bool   ((Bool -> Status) -> Either String Status)
-> (Bool -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Bool
x -> Status
a { stRepeat          = x }
                a
"random"         -> (Bool -> Status) -> Either String Status
forall {b}. (Bool -> b) -> Either String b
bool   ((Bool -> Status) -> Either String Status)
-> (Bool -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Bool
x -> Status
a { stRandom          = x }
                a
"single"         -> (Bool -> Status) -> Either String Status
forall {b}. (Bool -> b) -> Either String b
single ((Bool -> Status) -> Either String Status)
-> (Bool -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Bool
x -> Status
a { stSingle          = x }
                a
"consume"        -> (Bool -> Status) -> Either String Status
forall {b}. (Bool -> b) -> Either String b
bool   ((Bool -> Status) -> Either String Status)
-> (Bool -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Bool
x -> Status
a { stConsume         = x }
                a
"playlist"       -> (Integer -> Status) -> Either String Status
forall {a} {b}. (Read a, Integral a) => (a -> b) -> Either String b
num    ((Integer -> Status) -> Either String Status)
-> (Integer -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Integer
x -> Status
a { stPlaylistVersion = x }
                a
"playlistlength" -> (Integer -> Status) -> Either String Status
forall {a} {b}. (Read a, Integral a) => (a -> b) -> Either String b
num    ((Integer -> Status) -> Either String Status)
-> (Integer -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Integer
x -> Status
a { stPlaylistLength  = x }
                a
"state"          -> (PlaybackState -> Status) -> Either String Status
forall {b}. (PlaybackState -> b) -> Either String b
state  ((PlaybackState -> Status) -> Either String Status)
-> (PlaybackState -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \PlaybackState
x -> Status
a { stState           = x }
                a
"song"           -> (Int -> Status) -> Either String Status
forall {b}. (Int -> b) -> Either String b
int    ((Int -> Status) -> Either String Status)
-> (Int -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Int
x -> Status
a { stSongPos         = Just x }
                a
"songid"         -> (Int -> Status) -> Either String Status
forall {b}. (Int -> b) -> Either String b
int    ((Int -> Status) -> Either String Status)
-> (Int -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Int
x -> Status
a { stSongID          = Just $ Id x }
                a
"nextsong"       -> (Int -> Status) -> Either String Status
forall {b}. (Int -> b) -> Either String b
int    ((Int -> Status) -> Either String Status)
-> (Int -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Int
x -> Status
a { stNextSongPos     = Just x }
                a
"nextsongid"     -> (Int -> Status) -> Either String Status
forall {b}. (Int -> b) -> Either String b
int    ((Int -> Status) -> Either String Status)
-> (Int -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Int
x -> Status
a { stNextSongID      = Just $ Id x }
                a
"time"           -> ((FractionalSeconds, FractionalSeconds) -> Status)
-> Either String Status
forall {a} {b} {b}.
(Fractional a, Fractional b, Read a, Read b) =>
((a, b) -> b) -> Either String b
time   (((FractionalSeconds, FractionalSeconds) -> Status)
 -> Either String Status)
-> ((FractionalSeconds, FractionalSeconds) -> Status)
-> Either String Status
forall a b. (a -> b) -> a -> b
$ \(FractionalSeconds, FractionalSeconds)
x -> Status
a { stTime            = Just x }
                a
"elapsed"        -> (FractionalSeconds -> Status) -> Either String Status
forall {a} {b}.
(Fractional a, Read a) =>
(a -> b) -> Either String b
frac   ((FractionalSeconds -> Status) -> Either String Status)
-> (FractionalSeconds -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \FractionalSeconds
x -> Status
a { stTime            = fmap ((x,) . snd) (stTime a) }
                a
"duration"       -> (FractionalSeconds -> Status) -> Either String Status
forall {a} {b}.
(Fractional a, Read a) =>
(a -> b) -> Either String b
frac   ((FractionalSeconds -> Status) -> Either String Status)
-> (FractionalSeconds -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \FractionalSeconds
x -> Status
a { stTime            = fmap ((,x) . fst) (stTime a) }
                a
"bitrate"        -> (Int -> Status) -> Either String Status
forall {b}. (Int -> b) -> Either String b
int    ((Int -> Status) -> Either String Status)
-> (Int -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Int
x -> Status
a { stBitrate         = Just x }
                a
"xfade"          -> (Integer -> Status) -> Either String Status
forall {a} {b}. (Read a, Integral a) => (a -> b) -> Either String b
num    ((Integer -> Status) -> Either String Status)
-> (Integer -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Integer
x -> Status
a { stXFadeWidth      = x }
                a
"mixrampdb"      -> (FractionalSeconds -> Status) -> Either String Status
forall {a} {b}.
(Fractional a, Read a) =>
(a -> b) -> Either String b
frac   ((FractionalSeconds -> Status) -> Either String Status)
-> (FractionalSeconds -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \FractionalSeconds
x -> Status
a { stMixRampdB       = x }
                a
"mixrampdelay"   -> (FractionalSeconds -> Status) -> Either String Status
forall {a} {b}.
(Fractional a, Read a) =>
(a -> b) -> Either String b
frac   ((FractionalSeconds -> Status) -> Either String Status)
-> (FractionalSeconds -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \FractionalSeconds
x -> Status
a { stMixRampDelay    = x }
                a
"audio"          -> ((Int, Int, Int) -> Status) -> Either String Status
forall {a} {a}.
(Read a, Integral a) =>
((a, a, a) -> Status) -> Either a Status
audio  (((Int, Int, Int) -> Status) -> Either String Status)
-> ((Int, Int, Int) -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \(Int, Int, Int)
x -> Status
a { stAudio           = x }
                a
"updating_db"    -> (Integer -> Status) -> Either String Status
forall {a} {b}. (Read a, Integral a) => (a -> b) -> Either String b
num    ((Integer -> Status) -> Either String Status)
-> (Integer -> Status) -> Either String Status
forall a b. (a -> b) -> a -> b
$ \Integer
x -> Status
a { stUpdatingDb      = Just x }
                a
"error"          -> Status -> Either String Status
forall a b. b -> Either a b
Right          Status
a { stError           = Just (UTF8.toString v) }
                a
"partition"      -> Status -> Either String Status
forall a b. b -> Either a b
Right          Status
a { stPartition = UTF8.toString v }
                a
_                -> Status -> Either String Status
forall a b. b -> Either a b
Right          Status
a
                where
                    unexpectedPair :: Either String b
unexpectedPair = String -> Either String b
forall a b. a -> Either a b
Left (String
"unexpected key-value pair: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (a, ByteString) -> String
forall a. Show a => a -> String
show (a, ByteString)
p)
                    int :: (Int -> b) -> Either String b
int    Int -> b
f = Either String b
-> (Int -> Either String b) -> Maybe Int -> Either String b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either String b
forall {b}. Either String b
unexpectedPair (b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b) -> (Int -> b) -> Int -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b
f) (ByteString -> Maybe Int
forall a. (Read a, Integral a) => ByteString -> Maybe a
parseNum ByteString
v :: Maybe Int)
                    num :: (a -> b) -> Either String b
num    a -> b
f = Either String b
-> (a -> Either String b) -> Maybe a -> Either String b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either String b
forall {b}. Either String b
unexpectedPair (b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b) -> (a -> b) -> a -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (ByteString -> Maybe a
forall a. (Read a, Integral a) => ByteString -> Maybe a
parseNum  ByteString
v)
                    bool :: (Bool -> b) -> Either String b
bool   Bool -> b
f = Either String b
-> (Bool -> Either String b) -> Maybe Bool -> Either String b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either String b
forall {b}. Either String b
unexpectedPair (b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b) -> (Bool -> b) -> Bool -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> b
f) (ByteString -> Maybe Bool
parseBool ByteString
v)
                    frac :: (a -> b) -> Either String b
frac   a -> b
f = Either String b
-> (a -> Either String b) -> Maybe a -> Either String b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either String b
forall {b}. Either String b
unexpectedPair (b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b) -> (a -> b) -> a -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (ByteString -> Maybe a
forall a. (Fractional a, Read a) => ByteString -> Maybe a
parseFrac ByteString
v)
                    single :: (Bool -> b) -> Either String b
single Bool -> b
f = Either String b
-> (Bool -> Either String b) -> Maybe Bool -> Either String b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Either String b
forall {b}. Either String b
unexpectedPair (b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b) -> (Bool -> b) -> Bool -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> b
f) (ByteString -> Maybe Bool
parseSingle ByteString
v)

                    -- This is sometimes "audio: 0:?:0", so we ignore any parse
                    -- errors.
                    audio :: ((a, a, a) -> Status) -> Either a Status
audio (a, a, a) -> Status
f = Status -> Either a Status
forall a b. b -> Either a b
Right (Status -> Either a Status) -> Status -> Either a Status
forall a b. (a -> b) -> a -> b
$ Status -> ((a, a, a) -> Status) -> Maybe (a, a, a) -> Status
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Status
a (a, a, a) -> Status
f (Char -> (ByteString -> Maybe a) -> ByteString -> Maybe (a, a, a)
forall a.
Char -> (ByteString -> Maybe a) -> ByteString -> Maybe (a, a, a)
parseTriple Char
':' ByteString -> Maybe a
forall a. (Read a, Integral a) => ByteString -> Maybe a
parseNum ByteString
v)

                    time :: ((a, b) -> b) -> Either String b
time (a, b) -> b
f = case ByteString -> Maybe a
forall a. (Fractional a, Read a) => ByteString -> Maybe a
parseFrac (ByteString -> Maybe a)
-> (ByteString -> Maybe b)
-> (ByteString, ByteString)
-> (Maybe a, Maybe b)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ByteString -> Maybe b
forall a. (Fractional a, Read a) => ByteString -> Maybe a
parseFrac ((ByteString, ByteString) -> (Maybe a, Maybe b))
-> (ByteString, ByteString) -> (Maybe a, Maybe b)
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> (ByteString, ByteString)
breakChar Char
':' ByteString
v of
                                 (Just a
a_, Just b
b) -> (b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b)
-> ((a, b) -> b) -> (a, b) -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> b
f) (a
a_, b
b)
                                 (Maybe a, Maybe b)
_                 -> Either String b
forall {b}. Either String b
unexpectedPair

                    state :: (PlaybackState -> b) -> Either String b
state PlaybackState -> b
f = case ByteString
v of
                        ByteString
"play"  -> (b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b)
-> (PlaybackState -> b) -> PlaybackState -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaybackState -> b
f) PlaybackState
Playing
                        ByteString
"pause" -> (b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b)
-> (PlaybackState -> b) -> PlaybackState -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaybackState -> b
f) PlaybackState
Paused
                        ByteString
"stop"  -> (b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b)
-> (PlaybackState -> b) -> PlaybackState -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaybackState -> b
f) PlaybackState
Stopped
                        ByteString
_       -> Either String b
forall {b}. Either String b
unexpectedPair

                    -- A volume of -1 indicates an audio backend w/o a mixer
                    vol :: (Maybe a -> b) -> Either String b
vol Maybe a -> b
f = case (ByteString -> Maybe Int
forall a. (Read a, Integral a) => ByteString -> Maybe a
parseNum ByteString
v :: Maybe Int) of
                      Maybe Int
Nothing -> Either String b
forall {b}. Either String b
unexpectedPair -- does it really make sense to fail here? when does this occur?
                      Just Int
v' -> (b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b)
-> (Maybe a -> b) -> Maybe a -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> b
f) (Int -> Maybe a
forall {a} {a}. (Integral a, Num a) => a -> Maybe a
g Int
v')
                      where g :: a -> Maybe a
g a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0     = Maybe a
forall a. Maybe a
Nothing
                                | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n