{-# LANGUAGE OverloadedStrings #-}

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

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

Controlling playback.
-}

module Network.MPD.Applicative.PlaybackControl
    ( next
    , pause
    , toggle
    , play
    , playId
    , previous
    , seek
    , seekId
    , seekCur
    , stop
    ) where

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

-- | Play next song in the playlist.
next :: Command ()
next :: Command ()
next = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [String
"next"]

-- | Pauses playback on True, resumes on False.
pause :: Bool -> Command ()
pause :: Bool -> Command ()
pause Bool
f = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"pause" Command -> Bool -> String
forall a. MPDArg a => Command -> a -> String
<@> Bool
f]

-- | Toggles playback.
--
-- @since 0.10.0.0
toggle :: Command ()
toggle :: Command ()
toggle = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [String
"pause"]


-- | Begin playback (optionally at a specific position).
play :: Maybe Position -> Command ()
play :: Maybe Position -> Command ()
play Maybe Position
mbPos = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [String]
c
    where
        c :: [String]
c = String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String -> (Position -> String) -> Maybe Position -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"play" (Command
"play" Command -> Position -> String
forall a. MPDArg a => Command -> a -> String
<@>) Maybe Position
mbPos

-- | Begin playback at the specified song id.
playId :: Id -> Command ()
playId :: Id -> Command ()
playId Id
id' = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"playid" Command -> Id -> String
forall a. MPDArg a => Command -> a -> String
<@> Id
id']

-- | Play previous song.
previous :: Command ()
previous :: Command ()
previous = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [String
"previous"]

-- | Seek to time in the song at the given position.
seek :: Position -> FractionalSeconds -> Command ()
seek :: Position -> FractionalSeconds -> Command ()
seek Position
pos FractionalSeconds
time = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"seek" Command -> Args -> String
forall a. MPDArg a => Command -> a -> String
<@> Position
pos Position -> FractionalSeconds -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> FractionalSeconds
time]

-- | Seek to time in the song with the given id.
seekId :: Id -> FractionalSeconds -> Command ()
seekId :: Id -> FractionalSeconds -> Command ()
seekId Id
id' FractionalSeconds
time = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"seekid" Command -> Args -> String
forall a. MPDArg a => Command -> a -> String
<@> Id
id' Id -> FractionalSeconds -> Args
forall a b. (MPDArg a, MPDArg b) => a -> b -> Args
<++> FractionalSeconds
time]

-- | Seek to time in the current song. Absolute time for True in
-- the frist argument, relative time for False.
--
-- @since 0.9.2.0
seekCur :: Bool -> FractionalSeconds -> Command ()
seekCur :: Bool -> FractionalSeconds -> Command ()
seekCur Bool
bool FractionalSeconds
time
  | Bool
bool      = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"seekcur" Command -> FractionalSeconds -> String
forall a. MPDArg a => Command -> a -> String
<@> FractionalSeconds
time]
  | Bool
otherwise = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [Command
"seekcur" Command -> Sign FractionalSeconds -> String
forall a. MPDArg a => Command -> a -> String
<@> (FractionalSeconds -> Sign FractionalSeconds
forall a. a -> Sign a
Sign FractionalSeconds
time)]

-- | Stop playback.
stop :: Command ()
stop :: Command ()
stop = Parser () -> [String] -> Command ()
forall a. Parser a -> [String] -> Command a
Command Parser ()
emptyResponse [String
"stop"]