{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : Network.MPD.Commands.PlaybackOptions
Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2012
License     : MIT (see LICENSE)

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

Playback options.
-}

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

import qualified Network.MPD.Applicative.Internal as A
import qualified Network.MPD.Applicative.PlaybackOptions as A
import           Network.MPD.Commands.Types
import           Network.MPD.Core

import           Prelude hiding (repeat)

-- | Set consume mode
consume :: MonadMPD m => Bool -> m ()
consume :: Bool -> m ()
consume = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Bool -> Command ()) -> Bool -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Command ()
A.consume

-- | Set crossfading between songs.
crossfade :: MonadMPD m => Seconds -> m ()
crossfade :: Seconds -> m ()
crossfade = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Seconds -> Command ()) -> Seconds -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> Command ()
A.crossfade

-- | Set random playing.
random :: MonadMPD m => Bool -> m ()
random :: Bool -> m ()
random = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Bool -> Command ()) -> Bool -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Command ()
A.random

-- | Set repeating.
repeat :: MonadMPD m => Bool -> m ()
repeat :: Bool -> m ()
repeat = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Bool -> Command ()) -> Bool -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Command ()
A.repeat

-- | Set the volume.
setVolume :: MonadMPD m => Volume -> m ()
setVolume :: Volume -> m ()
setVolume = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Volume -> Command ()) -> Volume -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Volume -> Command ()
A.setVolume

-- | Set single mode
single :: MonadMPD m => Bool -> m ()
single :: Bool -> m ()
single = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Bool -> Command ()) -> Bool -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Command ()
A.single

-- | Set the replay gain mode.
replayGainMode :: MonadMPD m => ReplayGainMode -> m ()
replayGainMode :: ReplayGainMode -> m ()
replayGainMode = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ())
-> (ReplayGainMode -> Command ()) -> ReplayGainMode -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReplayGainMode -> Command ()
A.replayGainMode

-- | Get the replay gain options.
replayGainStatus :: MonadMPD m => m [(String, String)]
replayGainStatus :: m [(String, String)]
replayGainStatus = Command [(String, String)] -> m [(String, String)]
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand Command [(String, String)]
A.replayGainStatus