{-# LANGUAGE OverloadedStrings #-}

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

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

Playback options
-}

module Network.MPD.Applicative.PlaybackOptions
    ( consume
    , crossfade
    , random
    , repeat
    , setVolume
    , single
    , replayGainMode
    , replayGainStatus
    , mixrampDb
    , mixrampDelay
    ) where

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

import           Control.Applicative
import           Prelude hiding (repeat)

-- | Toggle consume mode.
consume :: Bool -> Command ()
consume :: Bool -> Command ()
consume Bool
f = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"consume" Command -> Bool -> String
forall a. MPDArg a => Command -> a -> String
<@> Bool
f]

-- | Set crossfading between songs.
crossfade :: Seconds -> Command ()
crossfade :: Seconds -> Command ()
crossfade Seconds
secs = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"crossfade" Command -> Seconds -> String
forall a. MPDArg a => Command -> a -> String
<@> Seconds
secs]

-- | Toggle random mode.
random :: Bool -> Command ()
random :: Bool -> Command ()
random Bool
f = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"random" Command -> Bool -> String
forall a. MPDArg a => Command -> a -> String
<@> Bool
f]

-- | Toggle repeat mode.
repeat :: Bool -> Command ()
repeat :: Bool -> Command ()
repeat Bool
f = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"repeat" Command -> Bool -> String
forall a. MPDArg a => Command -> a -> String
<@> Bool
f]

-- | Set volume.
setVolume :: Volume -> Command ()
setVolume :: Volume -> Command ()
setVolume Volume
vol = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"setvol" Command -> Volume -> String
forall a. MPDArg a => Command -> a -> String
<@> Volume
vol]

-- | Toggle single mode.
single :: Bool -> Command ()
single :: Bool -> Command ()
single Bool
f = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"single" Command -> Bool -> String
forall a. MPDArg a => Command -> a -> String
<@> Bool
f]

-- | Set replay gain mode.
replayGainMode :: ReplayGainMode -> Command ()
replayGainMode :: ReplayGainMode -> Command ()
replayGainMode ReplayGainMode
f = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"replay_gain_mode" Command -> ReplayGainMode -> String
forall a. MPDArg a => Command -> a -> String
<@> ReplayGainMode
f]

-- | Get replay gain status: option name and its value.
replayGainStatus :: Command [(String, String)]
replayGainStatus :: Command [(String, String)]
replayGainStatus = Parser [(String, String)] -> [String] -> Command [(String, String)]
forall a. Parser a -> [String] -> Command a
Command Parser [(String, String)]
p [String
"replay_gain_status"]
    where
        p :: Parser [(String, String)]
p = ((ByteString, ByteString) -> (String, String))
-> [(ByteString, ByteString)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, ByteString) -> (String, String)
decodePair ([(ByteString, ByteString)] -> [(String, String)])
-> ([ByteString] -> [(ByteString, ByteString)])
-> [ByteString]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [(ByteString, ByteString)]
toAssocList ([ByteString] -> [(String, String)])
-> Parser [ByteString] -> Parser [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [ByteString]
getResponse

-- | Set MixRamp overlap threshold.
-- 0dB is the normalized maximum value; use negative values to adjust it.
--
-- Songs must have MixRamp tags set by an external tool for this to
-- work; crossfading is used if no tags are present.
mixrampDb :: Decibels -> Command ()
mixrampDb :: Seconds -> Command ()
mixrampDb Seconds
db = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"mixrampdb" Command -> Seconds -> String
forall a. MPDArg a => Command -> a -> String
<@> Seconds
db]

-- | Additional time subtracted from the overlap calculated by
-- 'mixrampDb'.
-- "NaN" disables MixRamp overlapping and reverts to crossfading.
mixrampDelay :: Seconds -> Command ()
mixrampDelay :: Seconds -> Command ()
mixrampDelay Seconds
sec = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"mixrampdelay" Command -> Seconds -> String
forall a. MPDArg a => Command -> a -> String
<@> Seconds
sec]