{-# LANGUAGE OverloadedStrings #-}

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

Maintainer  : Joachim Fasting <joachifm@fastmail.fm>
Stability   : unstable
Portability : unportable

Extensions and shortcuts to the standard MPD command set.
-}

module Network.MPD.Commands.Extensions where

import           Network.MPD.Core
import           Network.MPD.Commands
import qualified Network.MPD.Applicative.Internal as A
import qualified Network.MPD.Applicative.CurrentPlaylist as A
import qualified Network.MPD.Applicative.StoredPlaylists as A

import           Control.Monad (liftM)
import           Data.Traversable (for)
import           Data.Foldable (for_)

-- | This is exactly the same as `update`.
updateId :: MonadMPD m => Maybe Path -> m Integer
updateId :: Maybe Path -> m Integer
updateId = Maybe Path -> m Integer
forall (m :: * -> *). MonadMPD m => Maybe Path -> m Integer
update
{-# DEPRECATED updateId "use `update` instead" #-}

-- | Toggles play\/pause. Plays if stopped.
toggle :: MonadMPD m => m ()
toggle :: m ()
toggle = m Status
forall (m :: * -> *). MonadMPD m => m Status
status m Status -> (Status -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \st :: Status
st -> case Status -> PlaybackState
stState Status
st of Playing -> Bool -> m ()
forall (m :: * -> *). MonadMPD m => Bool -> m ()
pause Bool
True
                                              _       -> Maybe Position -> m ()
forall (m :: * -> *). MonadMPD m => Maybe Position -> m ()
play Maybe Position
forall a. Maybe a
Nothing

-- | Add a list of songs\/folders to a playlist.
-- Should be more efficient than running 'add' many times.
addMany :: MonadMPD m => PlaylistName -> [Path] -> m ()
addMany :: PlaylistName -> [Path] -> m ()
addMany plname :: PlaylistName
plname xs :: [Path]
xs = Command () -> m ()
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand ([Path] -> (Path -> Command ()) -> Command ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Path]
xs Path -> Command ()
cmd)
    where cmd :: Path -> Command ()
cmd | PlaylistName
plname PlaylistName -> PlaylistName -> Bool
forall a. Eq a => a -> a -> Bool
== "" = Path -> Command ()
A.add
              | Bool
otherwise    = PlaylistName -> Path -> Command ()
A.playlistAdd PlaylistName
plname

-- | Recursive 'addId'. For directories, it will use the given position
-- for the first file in the directory and use the successor for the remaining
-- files. It returns a list of playlist ids for the songs added.
addIdMany :: MonadMPD m => Path -> Maybe Position -> m [Id]
addIdMany :: Path -> Maybe Position -> m [Id]
addIdMany x :: Path
x (Just p :: Position
p) = do
    [Path]
fs <- Path -> m [Path]
forall (m :: * -> *). MonadMPD m => Path -> m [Path]
listAll Path
x
    let fs' :: [(Path, Maybe Position)]
fs' = ((Path, Position) -> (Path, Maybe Position))
-> [(Path, Position)] -> [(Path, Maybe Position)]
forall a b. (a -> b) -> [a] -> [b]
map (\(a :: Path
a, b :: Position
b) -> (Path
a, Position -> Maybe Position
forall a. a -> Maybe a
Just Position
b)) ([(Path, Position)] -> [(Path, Maybe Position)])
-> [(Path, Position)] -> [(Path, Maybe Position)]
forall a b. (a -> b) -> a -> b
$ [Path] -> [Position] -> [(Path, Position)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Path]
fs [Position
p ..]
    Command [Id] -> m [Id]
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command [Id] -> m [Id]) -> Command [Id] -> m [Id]
forall a b. (a -> b) -> a -> b
$ [(Path, Maybe Position)]
-> ((Path, Maybe Position) -> Command Id) -> Command [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(Path, Maybe Position)]
fs' ((Path -> Maybe Position -> Command Id)
-> (Path, Maybe Position) -> Command Id
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Path -> Maybe Position -> Command Id
A.addId)
addIdMany x :: Path
x Nothing = do
    [Path]
fs <- Path -> m [Path]
forall (m :: * -> *). MonadMPD m => Path -> m [Path]
listAll Path
x
    Command [Id] -> m [Id]
forall (m :: * -> *) a. MonadMPD m => Command a -> m a
A.runCommand (Command [Id] -> m [Id]) -> Command [Id] -> m [Id]
forall a b. (a -> b) -> a -> b
$ [Path] -> (Path -> Command Id) -> Command [Id]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Path]
fs (Path -> Maybe Position -> Command Id
`A.addId` Maybe Position
forall a. Maybe a
Nothing)

-- | Like 'add' but returns a list of the files added.
addList :: MonadMPD m => Path -> m [Path]
addList :: Path -> m [Path]
addList x :: Path
x = Path -> m ()
forall (m :: * -> *). MonadMPD m => Path -> m ()
add Path
x m () -> m [Path] -> m [Path]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path -> m [Path]
forall (m :: * -> *). MonadMPD m => Path -> m [Path]
listAll Path
x
{-# DEPRECATED addList "will be removed in a future version" #-}

-- | Like 'playlistAdd' but returns a list of the files added.
playlistAddList :: MonadMPD m => PlaylistName -> Path -> m [Path]
playlistAddList :: PlaylistName -> Path -> m [Path]
playlistAddList plname :: PlaylistName
plname path :: Path
path = PlaylistName -> Path -> m ()
forall (m :: * -> *). MonadMPD m => PlaylistName -> Path -> m ()
playlistAdd PlaylistName
plname Path
path m () -> m [Path] -> m [Path]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Path -> m [Path]
forall (m :: * -> *). MonadMPD m => Path -> m [Path]
listAll Path
path
{-# DEPRECATED playlistAddList "will be removed in a future version" #-}

{-
-- | Returns all songs and directories that match the given partial
-- path name.
complete :: MonadMPD m => String -> m [Either Path Song]
complete path = do
    xs <- liftM matches . lsInfo $ dropFileName path
    case xs of
        [Left dir] -> complete $ dir ++ "/"
        _          -> return xs
    where
        matches = filter (isPrefixOf path . takePath)
        takePath = either id sgFilePath
-}

-- | List the artists in the database.
listArtists :: MonadMPD m => m [Artist]
listArtists :: m [Artist]
listArtists = Metadata -> Maybe Artist -> m [Artist]
forall (m :: * -> *).
MonadMPD m =>
Metadata -> Maybe Artist -> m [Artist]
list Metadata
Artist Maybe Artist
forall a. Maybe a
Nothing

-- | List the albums in the database, optionally matching a given
-- artist.
listAlbums :: MonadMPD m => Maybe Artist -> m [Album]
listAlbums :: Maybe Artist -> m [Artist]
listAlbums = Metadata -> Maybe Artist -> m [Artist]
forall (m :: * -> *).
MonadMPD m =>
Metadata -> Maybe Artist -> m [Artist]
list Metadata
Album

-- | List the songs in an album of some artist.
listAlbum :: MonadMPD m => Artist -> Album -> m [Song]
listAlbum :: Artist -> Artist -> m [Song]
listAlbum artist :: Artist
artist album :: Artist
album = Query -> m [Song]
forall (m :: * -> *). MonadMPD m => Query -> m [Song]
find (Metadata
Artist Metadata -> Artist -> Query
=? Artist
artist Query -> Query -> Query
<&> Metadata
Album Metadata -> Artist -> Query
=? Artist
album)

-- | Retrieve the current playlist.
-- Equivalent to @playlistinfo Nothing@.
getPlaylist :: MonadMPD m => m [Song]
getPlaylist :: m [Song]
getPlaylist = Maybe Position -> m [Song]
forall (m :: * -> *). MonadMPD m => Maybe Position -> m [Song]
playlistInfo Maybe Position
forall a. Maybe a
Nothing

-- | Increase or decrease volume by a given percent, e.g.
-- 'volume 10' will increase the volume by 10 percent, while
-- 'volume (-10)' will decrease it by the same amount.
volume :: MonadMPD m => Int -> m ()
volume :: Position -> m ()
volume n :: Position
n = do
    Maybe Volume
cur <- Status -> Maybe Volume
stVolume (Status -> Maybe Volume) -> m Status -> m (Maybe Volume)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` m Status
forall (m :: * -> *). MonadMPD m => m Status
status
    case Maybe Volume
cur of
        Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just v :: Volume
v  -> Volume -> m ()
forall (m :: * -> *). MonadMPD m => Volume -> m ()
setVolume (Volume -> Volume
forall b a. (Integral b, Integral a) => a -> b
adjust Volume
v)
    where
        adjust :: a -> b
adjust x :: a
x = Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> b) -> Double -> b
forall a b. (a -> b) -> a -> b
$ (Position -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Position
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (100 :: Double)) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x'
          where x' :: Double
x' = a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x