{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}

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

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

The current playlist.
-}

module Network.MPD.Commands.CurrentPlaylist
    ( addId
    , add
    , clear
    , delete
    , deleteRange
    , deleteId
    , move
    , moveRange
    , moveId
    , playlist
    , playlistFind
    , playlistInfo
    , playlistInfoRange
    , playlistId
    , playlistSearch
    , plChanges
    , plChangesPosId
    , prio
    , prioId
    , shuffle
    , swap
    , swapId
    , addTagId
    , clearTagId
    , rangeId
    ) where

import qualified Network.MPD.Applicative.Internal as A
import qualified Network.MPD.Applicative.CurrentPlaylist as A
import           Network.MPD.Commands.Query
import           Network.MPD.Commands.Types
import           Network.MPD.Core
import           Network.MPD.Util

import           Control.Monad.Except (throwError)

-- | Like 'add', but returns a playlist id.
addId :: MonadMPD m => Path -> Maybe Position -> m Id
addId :: Path -> Maybe Position -> m Id
addId Path
path = Command Id -> m Id
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command Id -> m Id)
-> (Maybe Position -> Command Id) -> Maybe Position -> m Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Maybe Position -> Command Id
A.addId Path
path

-- | Add a song (or a whole directory) to the current playlist.
add :: MonadMPD m => Path -> m ()
add :: Path -> m ()
add = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Path -> Command ()) -> Path -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Command ()
A.add

-- | Clear the current playlist.
clear :: MonadMPD m => m ()
clear :: m ()
clear = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand Command ()
A.clear

-- | Remove a song from the current playlist.
delete :: MonadMPD m => Position -> m ()
delete :: Position -> m ()
delete = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ())
-> (Position -> Command ()) -> Position -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Command ()
A.delete

-- | Remove a range of songs from the current playlist.
--
-- @since 0.10.0.0
deleteRange :: MonadMPD m => Range -> m ()
deleteRange :: Range -> m ()
deleteRange = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Range -> Command ()) -> Range -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Command ()
A.deleteRange

-- | Remove a song from the current playlist.
deleteId :: MonadMPD m => Id -> m ()
deleteId :: Id -> m ()
deleteId = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Id -> Command ()) -> Id -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Command ()
A.deleteId

-- | Move a song to a given position in the current playlist.
move :: MonadMPD m => Position -> Position -> m ()
move :: Position -> Position -> m ()
move Position
pos = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ())
-> (Position -> Command ()) -> Position -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Position -> Command ()
A.move Position
pos

-- | Move a range of songs to a given position in the current playlist.
--
-- @since 0.10.0.0
moveRange :: MonadMPD m => Range -> Position -> m ()
moveRange :: Range -> Position -> m ()
moveRange Range
range = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ())
-> (Position -> Command ()) -> Position -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Position -> Command ()
A.moveRange Range
range

-- | Move a song from (songid) to (playlist index) in the playlist. If to is
-- negative, it is relative to the current song in the playlist (if there is one).
moveId :: MonadMPD m => Id -> Position -> m ()
moveId :: Id -> Position -> m ()
moveId Id
i = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ())
-> (Position -> Command ()) -> Position -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Position -> Command ()
A.moveId Id
i

-- | Retrieve file paths and positions of songs in the current playlist.
-- Note that this command is only included for completeness sake; it's
-- deprecated and likely to disappear at any time, please use 'playlistInfo'
-- instead.
playlist :: MonadMPD m => m [(Position, Path)]
playlist :: m [(Position, Path)]
playlist = (ByteString -> m (Position, Path))
-> [ByteString] -> m [(Position, Path)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> m (Position, Path)
forall a (m :: * -> *).
(Read a, Integral a, MonadError MPDError m) =>
ByteString -> m (a, Path)
f ([ByteString] -> m [(Position, Path)])
-> m [ByteString] -> m [(Position, Path)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> m [ByteString]
forall (m :: * -> *). MonadMPD m => String -> m [ByteString]
getResponse String
"playlist"
    where f :: ByteString -> m (a, Path)
f ByteString
s | (ByteString
pos, ByteString
name) <- Char -> ByteString -> (ByteString, ByteString)
breakChar Char
':' ByteString
s
              , Just a
pos'   <- ByteString -> Maybe a
forall a. (Read a, Integral a) => ByteString -> Maybe a
parseNum ByteString
pos
              = (a, Path) -> m (a, Path)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
pos', ByteString -> Path
Path ByteString
name)
              | Bool
otherwise = MPDError -> m (a, Path)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MPDError -> m (a, Path))
-> (String -> MPDError) -> String -> m (a, Path)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MPDError
Unexpected (String -> m (a, Path)) -> String -> m (a, Path)
forall a b. (a -> b) -> a -> b
$ ByteString -> String
forall a. Show a => a -> String
show ByteString
s
{-# WARNING playlist "this is deprecated; please use 'playlistInfo' instead." #-}

-- | Search for songs in the current playlist with strict matching.
playlistFind :: MonadMPD m => Query -> m [Song]
playlistFind :: Query -> m [Song]
playlistFind = Command [Song] -> m [Song]
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command [Song] -> m [Song])
-> (Query -> Command [Song]) -> Query -> m [Song]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Command [Song]
A.playlistFind

-- | Retrieve metadata for songs in the current playlist.
playlistInfo :: MonadMPD m => Maybe Position -> m [Song]
playlistInfo :: Maybe Position -> m [Song]
playlistInfo = Command [Song] -> m [Song]
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command [Song] -> m [Song])
-> (Maybe Position -> Command [Song]) -> Maybe Position -> m [Song]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Position -> Command [Song]
A.playlistInfo

-- | Like 'playlistInfo' but can restrict to a range of songs.
--
-- @since 0.10.0.0
playlistInfoRange :: MonadMPD m => Maybe Range -> m [Song]
playlistInfoRange :: Maybe Range -> m [Song]
playlistInfoRange = Command [Song] -> m [Song]
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command [Song] -> m [Song])
-> (Maybe Range -> Command [Song]) -> Maybe Range -> m [Song]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Range -> Command [Song]
A.playlistInfoRange

-- | Displays a list of songs in the playlist.
-- If id is specified, only its info is returned.
playlistId :: MonadMPD m => Maybe Id -> m [Song]
playlistId :: Maybe Id -> m [Song]
playlistId = Command [Song] -> m [Song]
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command [Song] -> m [Song])
-> (Maybe Id -> Command [Song]) -> Maybe Id -> m [Song]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Id -> Command [Song]
A.playlistId

-- | Search case-insensitively with partial matches for songs in the
-- current playlist.
playlistSearch :: MonadMPD m => Query -> m [Song]
playlistSearch :: Query -> m [Song]
playlistSearch = Command [Song] -> m [Song]
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command [Song] -> m [Song])
-> (Query -> Command [Song]) -> Query -> m [Song]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Command [Song]
A.playlistSearch

-- | Retrieve a list of changed songs currently in the playlist since
-- a given playlist version.
plChanges :: MonadMPD m => Integer -> m [Song]
plChanges :: Integer -> m [Song]
plChanges = Command [Song] -> m [Song]
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command [Song] -> m [Song])
-> (Integer -> Command [Song]) -> Integer -> m [Song]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Command [Song]
A.plChanges

-- | Like 'plChanges' but only returns positions and ids.
plChangesPosId :: MonadMPD m => Integer -> m [(Position, Id)]
plChangesPosId :: Integer -> m [(Position, Id)]
plChangesPosId = Command [(Position, Id)] -> m [(Position, Id)]
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command [(Position, Id)] -> m [(Position, Id)])
-> (Integer -> Command [(Position, Id)])
-> Integer
-> m [(Position, Id)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Command [(Position, Id)]
A.plChangesPosId

-- | Set the priority of the specified songs.
--
-- @since 0.10.0.0
prio :: MonadMPD m => Priority -> Range -> m ()
prio :: Priority -> Range -> m ()
prio Priority
p = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Range -> Command ()) -> Range -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Priority -> Range -> Command ()
A.prio Priority
p

-- | Set priority by song id.
prioId :: MonadMPD m => Priority -> Id -> m ()
prioId :: Priority -> Id -> m ()
prioId Priority
p = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Id -> Command ()) -> Id -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Priority -> Id -> Command ()
A.prioId Priority
p

-- | Shuffle the current playlist.
-- Optionally restrict to a range of songs.
--
-- @since 0.10.0.0
shuffle :: MonadMPD m => Maybe Range -> m ()
shuffle :: Maybe Range -> m ()
shuffle = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ())
-> (Maybe Range -> Command ()) -> Maybe Range -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Range -> Command ()
A.shuffle

-- | Swap the positions of two songs.
swap :: MonadMPD m => Position -> Position -> m ()
swap :: Position -> Position -> m ()
swap Position
pos1 = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ())
-> (Position -> Command ()) -> Position -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Position -> Command ()
A.swap Position
pos1

-- | Swap the positions of two songs (Id version)
swapId :: MonadMPD m => Id -> Id -> m ()
swapId :: Id -> Id -> m ()
swapId Id
id1 = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Id -> Command ()) -> Id -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Id -> Command ()
A.swapId Id
id1

-- | Add tag to (remote) song.
addTagId :: (MonadMPD m) => Id -> Metadata -> Value -> m ()
addTagId :: Id -> Metadata -> Value -> m ()
addTagId Id
id' Metadata
tag = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ()) -> (Value -> Command ()) -> Value -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Metadata -> Value -> Command ()
A.addTagId Id
id' Metadata
tag

-- | Remove tag from (remote) song.
clearTagId :: (MonadMPD m) => Id -> Metadata -> m ()
clearTagId :: Id -> Metadata -> m ()
clearTagId Id
id' = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ())
-> (Metadata -> Command ()) -> Metadata -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> Metadata -> Command ()
A.clearTagId Id
id'

-- | Specify portion of song that shall be played.
-- Both ends of the range are optional; omitting both plays everything.
rangeId :: (MonadMPD m) => Id -> (Maybe Double, Maybe Double) -> m ()
rangeId :: Id -> (Maybe Double, Maybe Double) -> m ()
rangeId Id
id' = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command () -> m ())
-> ((Maybe Double, Maybe Double) -> Command ())
-> (Maybe Double, Maybe Double)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Id -> (Maybe Double, Maybe Double) -> Command ()
A.rangeId Id
id'