{-# 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 = 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 = forall a. Parser a -> [String] -> Command a
Command (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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ByteString, ByteString) -> Either String Subsystem
f 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"        -> forall a b. b -> Either a b
Right Subsystem
DatabaseS
                ByteString
"update"          -> forall a b. b -> Either a b
Right Subsystem
UpdateS
                ByteString
"stored_playlist" -> forall a b. b -> Either a b
Right Subsystem
StoredPlaylistS
                ByteString
"playlist"        -> forall a b. b -> Either a b
Right Subsystem
PlaylistS
                ByteString
"player"          -> forall a b. b -> Either a b
Right Subsystem
PlayerS
                ByteString
"mixer"           -> forall a b. b -> Either a b
Right Subsystem
MixerS
                ByteString
"output"          -> forall a b. b -> Either a b
Right Subsystem
OutputS
                ByteString
"options"         -> forall a b. b -> Either a b
Right Subsystem
OptionsS
                ByteString
"partition"       -> forall a b. b -> Either a b
Right Subsystem
PartitionS
                ByteString
"sticker"         -> forall a b. b -> Either a b
Right Subsystem
StickerS
                ByteString
"subscription"    -> forall a b. b -> Either a b
Right Subsystem
SubscriptionS
                ByteString
"message"         -> forall a b. b -> Either a b
Right Subsystem
MessageS
                ByteString
"neighbor"        -> forall a b. b -> Either a b
Right Subsystem
NeighborS
                ByteString
"mount"           -> forall a b. b -> Either a b
Right Subsystem
MountS
                ByteString
k                 -> forall a b. a -> Either a b
Left (String
"Unknown subsystem: " forall a. [a] -> [a] -> [a]
++ ByteString -> String
UTF8.toString ByteString
k)
        f (ByteString, ByteString)
x                       =  forall a b. a -> Either a b
Left (String
"idle: Unexpected " forall a. [a] -> [a] -> [a]
++ 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 = forall a. Parser a -> [String] -> Command a
Command (forall a. ([ByteString] -> Either String a) -> Parser a
liftParser [ByteString] -> Either String [Subsystem]
takeSubsystems) [String]
c
    where
        c :: [String]
c = [Command
"idle" forall a. MPDArg a => Command -> a -> String
<@> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
(<++>) ([String] -> Args
Args []) [Subsystem]
ss]

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

-- | Get database statistics.
stats :: Command Stats
stats :: Command Stats
stats = forall a. Parser a -> [String] -> Command a
Command (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 = forall a. Parser a -> [String] -> Command a
Command (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 = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {a}.
(Eq a, IsString a, Show a) =>
Status -> (a, ByteString) -> Either String Status
go forall a. Default a => a
def 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"         -> forall {a} {b}. Num a => (Maybe a -> b) -> Either String b
vol    forall a b. (a -> b) -> a -> b
$ \Maybe Volume
x -> Status
a { stVolume :: Maybe Volume
stVolume          = Maybe Volume
x }
                a
"repeat"         -> forall {b}. (Bool -> b) -> Either String b
bool   forall a b. (a -> b) -> a -> b
$ \Bool
x -> Status
a { stRepeat :: Bool
stRepeat          = Bool
x }
                a
"random"         -> forall {b}. (Bool -> b) -> Either String b
bool   forall a b. (a -> b) -> a -> b
$ \Bool
x -> Status
a { stRandom :: Bool
stRandom          = Bool
x }
                a
"single"         -> forall {b}. (Bool -> b) -> Either String b
single forall a b. (a -> b) -> a -> b
$ \Bool
x -> Status
a { stSingle :: Bool
stSingle          = Bool
x }
                a
"consume"        -> forall {b}. (Bool -> b) -> Either String b
bool   forall a b. (a -> b) -> a -> b
$ \Bool
x -> Status
a { stConsume :: Bool
stConsume         = Bool
x }
                a
"playlist"       -> forall {a} {b}. (Read a, Integral a) => (a -> b) -> Either String b
num    forall a b. (a -> b) -> a -> b
$ \Integer
x -> Status
a { stPlaylistVersion :: Integer
stPlaylistVersion = Integer
x }
                a
"playlistlength" -> forall {a} {b}. (Read a, Integral a) => (a -> b) -> Either String b
num    forall a b. (a -> b) -> a -> b
$ \Integer
x -> Status
a { stPlaylistLength :: Integer
stPlaylistLength  = Integer
x }
                a
"state"          -> forall {b}. (PlaybackState -> b) -> Either String b
state  forall a b. (a -> b) -> a -> b
$ \PlaybackState
x -> Status
a { stState :: PlaybackState
stState           = PlaybackState
x }
                a
"song"           -> forall {b}. (Int -> b) -> Either String b
int    forall a b. (a -> b) -> a -> b
$ \Int
x -> Status
a { stSongPos :: Maybe Int
stSongPos         = forall a. a -> Maybe a
Just Int
x }
                a
"songid"         -> forall {b}. (Int -> b) -> Either String b
int    forall a b. (a -> b) -> a -> b
$ \Int
x -> Status
a { stSongID :: Maybe Id
stSongID          = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Id
Id Int
x }
                a
"nextsong"       -> forall {b}. (Int -> b) -> Either String b
int    forall a b. (a -> b) -> a -> b
$ \Int
x -> Status
a { stNextSongPos :: Maybe Int
stNextSongPos     = forall a. a -> Maybe a
Just Int
x }
                a
"nextsongid"     -> forall {b}. (Int -> b) -> Either String b
int    forall a b. (a -> b) -> a -> b
$ \Int
x -> Status
a { stNextSongID :: Maybe Id
stNextSongID      = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> Id
Id Int
x }
                a
"time"           -> forall {a} {b} {b}.
(Fractional a, Fractional b, Read a, Read b) =>
((a, b) -> b) -> Either String b
time   forall a b. (a -> b) -> a -> b
$ \(FractionalSeconds, FractionalSeconds)
x -> Status
a { stTime :: Maybe (FractionalSeconds, FractionalSeconds)
stTime            = forall a. a -> Maybe a
Just (FractionalSeconds, FractionalSeconds)
x }
                a
"elapsed"        -> forall {a} {b}.
(Fractional a, Read a) =>
(a -> b) -> Either String b
frac   forall a b. (a -> b) -> a -> b
$ \FractionalSeconds
x -> Status
a { stTime :: Maybe (FractionalSeconds, FractionalSeconds)
stTime            = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FractionalSeconds
x,) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (Status -> Maybe (FractionalSeconds, FractionalSeconds)
stTime Status
a) }
                a
"duration"       -> forall {a} {b}.
(Fractional a, Read a) =>
(a -> b) -> Either String b
frac   forall a b. (a -> b) -> a -> b
$ \FractionalSeconds
x -> Status
a { stTime :: Maybe (FractionalSeconds, FractionalSeconds)
stTime            = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((,FractionalSeconds
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (Status -> Maybe (FractionalSeconds, FractionalSeconds)
stTime Status
a) }
                a
"bitrate"        -> forall {b}. (Int -> b) -> Either String b
int    forall a b. (a -> b) -> a -> b
$ \Int
x -> Status
a { stBitrate :: Maybe Int
stBitrate         = forall a. a -> Maybe a
Just Int
x }
                a
"xfade"          -> forall {a} {b}. (Read a, Integral a) => (a -> b) -> Either String b
num    forall a b. (a -> b) -> a -> b
$ \Integer
x -> Status
a { stXFadeWidth :: Integer
stXFadeWidth      = Integer
x }
                a
"mixrampdb"      -> forall {a} {b}.
(Fractional a, Read a) =>
(a -> b) -> Either String b
frac   forall a b. (a -> b) -> a -> b
$ \FractionalSeconds
x -> Status
a { stMixRampdB :: FractionalSeconds
stMixRampdB       = FractionalSeconds
x }
                a
"mixrampdelay"   -> forall {a} {b}.
(Fractional a, Read a) =>
(a -> b) -> Either String b
frac   forall a b. (a -> b) -> a -> b
$ \FractionalSeconds
x -> Status
a { stMixRampDelay :: FractionalSeconds
stMixRampDelay    = FractionalSeconds
x }
                a
"audio"          -> forall {a} {a}.
(Read a, Integral a) =>
((a, a, a) -> Status) -> Either a Status
audio  forall a b. (a -> b) -> a -> b
$ \(Int, Int, Int)
x -> Status
a { stAudio :: (Int, Int, Int)
stAudio           = (Int, Int, Int)
x }
                a
"updating_db"    -> forall {a} {b}. (Read a, Integral a) => (a -> b) -> Either String b
num    forall a b. (a -> b) -> a -> b
$ \Integer
x -> Status
a { stUpdatingDb :: Maybe Integer
stUpdatingDb      = forall a. a -> Maybe a
Just Integer
x }
                a
"error"          -> forall a b. b -> Either a b
Right          Status
a { stError :: Maybe String
stError           = forall a. a -> Maybe a
Just (ByteString -> String
UTF8.toString ByteString
v) }
                a
"partition"      -> forall a b. b -> Either a b
Right          Status
a { stPartition :: String
stPartition = ByteString -> String
UTF8.toString ByteString
v }
                a
_                -> forall a b. b -> Either a b
Right          Status
a
                where
                    unexpectedPair :: Either String b
unexpectedPair = forall a b. a -> Either a b
Left (String
"unexpected key-value pair: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (a, ByteString)
p)
                    int :: (Int -> b) -> Either String b
int    Int -> b
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. Either String b
unexpectedPair (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b
f) (forall a. (Read a, Integral a) => ByteString -> Maybe a
parseNum ByteString
v :: Maybe Int)
                    num :: (a -> b) -> Either String b
num    a -> b
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. Either String b
unexpectedPair (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (forall a. (Read a, Integral a) => ByteString -> Maybe a
parseNum  ByteString
v)
                    bool :: (Bool -> b) -> Either String b
bool   Bool -> b
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. Either String b
unexpectedPair (forall a b. b -> Either a b
Right 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. Either String b
unexpectedPair (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (forall a. (Fractional a, Read a) => ByteString -> Maybe a
parseFrac ByteString
v)
                    single :: (Bool -> b) -> Either String b
single Bool -> b
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. Either String b
unexpectedPair (forall a b. b -> Either a b
Right 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 = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Status
a (a, a, a) -> Status
f (forall a.
Char -> (ByteString -> Maybe a) -> ByteString -> Maybe (a, a, a)
parseTriple Char
':' 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 forall a. (Fractional a, Read a) => ByteString -> Maybe a
parseFrac forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. (Fractional a, Read a) => ByteString -> Maybe a
parseFrac forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> (ByteString, ByteString)
breakChar Char
':' ByteString
v of
                                 (Just a
a_, Just b
b) -> (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> b
f) (a
a_, b
b)
                                 (Maybe a, Maybe b)
_                 -> forall {b}. Either String b
unexpectedPair

                    state :: (PlaybackState -> b) -> Either String b
state PlaybackState -> b
f = case ByteString
v of
                        ByteString
"play"  -> (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaybackState -> b
f) PlaybackState
Playing
                        ByteString
"pause" -> (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaybackState -> b
f) PlaybackState
Paused
                        ByteString
"stop"  -> (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaybackState -> b
f) PlaybackState
Stopped
                        ByteString
_       -> 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 (forall a. (Read a, Integral a) => ByteString -> Maybe a
parseNum ByteString
v :: Maybe Int) of
                      Maybe Int
Nothing -> forall {b}. Either String b
unexpectedPair -- does it really make sense to fail here? when does this occur?
                      Just Int
v' -> (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> b
f) (forall {a} {a}. (Integral a, Num a) => a -> Maybe a
g Int
v')
                      where g :: a -> Maybe a
g a
n | a
n forall a. Ord a => a -> a -> Bool
< a
0     = forall a. Maybe a
Nothing
                                | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n