{-
    libmpd for Haskell, an MPD client library.
    Copyright (C) 2005-2007  Ben Sinclair <bsinclai@turing.une.edu.au>

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
-}

-- | Module    : Network.MPD.Commands
-- Copyright   : (c) Ben Sinclair 2005-2007
-- License     : LGPL
-- Maintainer  : bsinclai@turing.une.edu.au
-- Stability   : alpha
-- Portability : Haskell 98
--
-- Interface to the user commands supported by MPD.

module Network.MPD.Commands (
    -- * Command related data types
    State(..), Status(..), Stats(..),
    Device(..),
    Query(..), Meta(..),
    Artist, Album, Title, Seconds, PLIndex(..),
    Song(..), Count(..),

    -- * Admin commands
    disableoutput, enableoutput, outputs, update,

    -- * Database commands
    find, list, listAll, listAllinfo, lsinfo, search, count,

    -- * Playlist commands
    -- $playlist
    add, add_, addid, clear, currentSong, delete, load, move,
    playlistinfo, listplaylist, listplaylistinfo, playlist, plchanges,
    plchangesposid, playlistfind, playlistsearch, rm, rename, save, shuffle,
    swap,

    -- * Playback commands
    crossfade, next, pause, play, previous, random, repeat, seek, setVolume,
    volume, stop,

    -- * Miscellaneous commands
    clearerror, close, commands, notcommands, tagtypes, urlhandlers, password,
    ping, reconnect, stats, status,

    -- * Extensions\/shortcuts
    addMany, deleteMany, crop, prune, lsdirs, lsfiles, lsplaylists, findArtist,
    findAlbum, findTitle, listArtists, listAlbums, listAlbum, searchArtist,
    searchAlbum, searchTitle, getPlaylist, toggle, updateid
    ) where

import Network.MPD.Prim

import Control.Monad (liftM, unless)
import Prelude hiding (repeat)
import Data.List (findIndex, intersperse)
import Data.Maybe

--
-- Data types
--

type Artist  = String
type Album   = String
type Title   = String
type Seconds = Integer

-- | Available metadata types\/scope modifiers, used for searching the
-- database for entries with certain metadata values.
data Meta = Artist | Album | Title | Track | Name | Genre | Date
    | Composer | Performer | Disc | Any | Filename

instance Show Meta where
    show Artist    = "Artist"
    show Album     = "Album"
    show Title     = "Title"
    show Track     = "Track"
    show Name      = "Name"
    show Genre     = "Genre"
    show Date      = "Date"
    show Composer  = "Composer"
    show Performer = "Performer"
    show Disc      = "Disc"
    show Any       = "Any"
    show Filename  = "Filename"

-- | A query is composed of a scope modifier and a query string.
data Query = Query Meta String  -- ^ Simple query.
           | MultiQuery [Query] -- ^ Query with multiple conditions.

instance Show Query where
    show (Query meta query) = show meta ++ " " ++ show query
    show (MultiQuery xs)    = show xs
    showList xs _ = unwords $ map show xs

-- | Represents a song's playlist index.
data PLIndex = Pos Integer -- ^ A playlist position index (starting from 0)
             | ID Integer  -- ^ A playlist ID number that more robustly
                           --   identifies a song.
    deriving Show

-- | Represents the different playback states.
data State = Playing
           | Stopped
           | Paused
    deriving (Show, Eq)

-- | Container for MPD status.
data Status =
    Status { stState :: State
             -- | A percentage (0-100)
           , stVolume          :: Int
           , stRepeat          :: Bool
           , stRandom          :: Bool
             -- | A value that is incremented by the server every time the
             --   playlist changes.
           , stPlaylistVersion :: Integer
           , stPlaylistLength  :: Integer
             -- | Current song's position in the playlist.
           , stSongPos         :: Maybe PLIndex
             -- | Current song's playlist ID.
           , stSongID          :: Maybe PLIndex
             -- | Time elapsed\/total time.
           , stTime            :: (Seconds, Seconds)
             -- | Bitrate (in kilobytes per second) of playing song (if any).
           , stBitrate         :: Int
             -- | Crossfade time.
           , stXFadeWidth      :: Seconds
             -- | Samplerate\/bits\/channels for the chosen output device
             --   (see mpd.conf).
           , stAudio           :: (Int, Int, Int)
             -- | Job ID of currently running update (if any).
           , stUpdatingDb      :: Integer
             -- | Last error message (if any).
           , stError           :: String }
    deriving Show

-- | Container for database statistics.
data Stats =
    Stats { stsArtists    :: Integer -- ^ Number of artists.
          , stsAlbums     :: Integer -- ^ Number of albums.
          , stsSongs      :: Integer -- ^ Number of songs.
          , stsUptime     :: Seconds -- ^ Daemon uptime in seconds.
          , stsPlaytime   :: Seconds -- ^ Total playing time.
          , stsDbPlaytime :: Seconds -- ^ Total play time of all the songs in
                                     --   the database.
          , stsDbUpdate   :: Integer -- ^ Last database update in UNIX time.
          }
    deriving Show

-- | Represents a single song item.
data Song =
    Song { sgArtist, sgAlbum, sgTitle, sgFilePath, sgGenre, sgName, sgComposer
         , sgPerformer :: String
         , sgLength    :: Seconds       -- ^ Length in seconds
         , sgDate      :: Int           -- ^ Year
         , sgTrack     :: (Int, Int)    -- ^ Track number\/total tracks
         , sgDisc      :: (Int, Int)    -- ^ Position in set\/total in set
         , sgIndex     :: Maybe PLIndex }
    deriving Show

-- Avoid the need for writing a proper 'elem' for use in 'prune'.
instance Eq Song where
    (==) x y = sgFilePath x == sgFilePath y

-- | Represents the result of running 'count'.
data Count =
    Count { cSongs    :: Integer -- ^ Number of songs matching the query
          , cPlaytime :: Seconds -- ^ Total play time of matching songs
          }
    deriving Show

-- | Represents an output device.
data Device =
    Device { dOutputID      :: Int    -- ^ Output's ID number
           , dOutputName    :: String -- ^ Output's name as defined in the MPD
                                      --   configuration file
           , dOutputEnabled :: Bool }
    deriving Show

--
-- Admin commands
--

-- | Turn off an output device.
disableoutput :: Int -> MPD ()
disableoutput = getResponse_ . ("disableoutput " ++) . show

-- | Turn on an output device.
enableoutput :: Int -> MPD ()
enableoutput = getResponse_ . ("enableoutput " ++) . show

-- | Retrieve information for all output devices.
outputs :: MPD [Device]
outputs = liftM (map takeDevInfo . splitGroups . toAssoc)
    (getResponse "outputs")
    where
        takeDevInfo xs = Device {
            dOutputID      = takeNum "outputid" xs,
            dOutputName    = takeString "outputname" xs,
            dOutputEnabled = takeBool "outputenabled" xs
            }

-- | Update the server's database.
update :: [String] -- ^ Optionally specify a list of paths
       -> MPD ()
update  [] = getResponse_ "update"
update [x] = getResponse_ ("update " ++ show x)
update  xs = getResponses (map (("update " ++) . show) xs) >> return ()

--
-- Database commands
--

-- | List all metadata of metadata (sic).
list :: Meta -- ^ Metadata to list
     -> Maybe Query -> MPD [String]
list mtype query = liftM takeValues (getResponse cmd)
    where cmd = "list " ++ show mtype ++ maybe "" ((" "++) . show) query

-- | Non-recursively list the contents of a database directory.
lsinfo :: Maybe String -- ^ Optionally specify a path.
       -> MPD [Either String Song]
lsinfo path = do
    (dirs,_,songs) <- liftM takeEntries
                      (getResponse ("lsinfo " ++ maybe "" show path))
    return (map Left dirs ++ map Right songs)

-- | List the songs (without metadata) in a database directory recursively.
listAll :: Maybe String -> MPD [String]
listAll path = liftM (map snd . filter ((== "file") . fst) . toAssoc)
                     (getResponse ("listall " ++ maybe "" show path))

-- | Recursive 'lsinfo'.
listAllinfo :: Maybe String -- ^ Optionally specify a path
            -> MPD [Either String Song]
listAllinfo path = do
    (dirs,_,songs) <- liftM takeEntries
                      (getResponse ("listallinfo " ++ maybe "" show path))
    return (map Left dirs ++ map Right songs)

-- | Search the database for entries exactly matching a query.
find :: Query -> MPD [Song]
find query = liftM takeSongs (getResponse ("find " ++ show query))

-- | Search the database using case insensitive matching.
search :: Query -> MPD [Song]
search query = liftM takeSongs (getResponse ("search " ++ show query))

-- | Count the number of entries matching a query.
count :: Query -> MPD Count
count query = liftM (takeCountInfo . toAssoc)
                    (getResponse ("count " ++ show query))
    where takeCountInfo xs = Count { cSongs    = takeNum "songs" xs,
                                     cPlaytime = takeNum "playtime" xs }

--
-- Playlist commands
--
-- $playlist
-- Unless otherwise noted all playlist commands operate on the current
-- playlist.

-- | Like 'add', but returns a playlist id.
addid :: String -> MPD Integer
addid x =
    liftM (read . snd . head . toAssoc) (getResponse ("addid " ++ show x))

-- | Like 'add_' but returns a list of the files added.
add :: Maybe String -> String -> MPD [String]
add plname x = add_ plname x >> listAll (Just x)

-- | Add a song (or a whole directory) to a playlist.
-- Adds to current if no playlist is specified.
-- Will create a new playlist if the one specified does not already exist.
add_ :: Maybe String -- ^ Optionally specify a playlist to operate on
     -> String -> MPD ()
add_ Nothing       = getResponse_ . ("add " ++) . show
add_ (Just plname) = getResponse_ .
                     (("playlistadd " ++ show plname ++ " ") ++) . show

-- | Clear a playlist. Clears current playlist if no playlist is specified.
-- If the specified playlist does not exist, it will be created.
clear :: Maybe String -- ^ Optional name of a playlist to clear.
      -> MPD ()
clear = getResponse_ . maybe "clear" (("playlistclear " ++) . show)

-- | Remove a song from a playlist.
-- If no playlist is specified, current playlist is used.
-- Note that a playlist position ('Pos') is required when operating on
-- playlists other than the current.
delete :: Maybe String -- ^ Optionally specify a playlist to operate on
       -> PLIndex -> MPD ()
delete Nothing (Pos x) = getResponse_ ("delete " ++ show x)
delete Nothing (ID x) = getResponse_ ("deleteid " ++ show x)
delete (Just plname) (Pos x) =
    getResponse_ ("playlistdelete " ++ show plname ++ " " ++ show x)
delete _ _ = fail "'delete' within a playlist doesn't accept a playlist ID"

-- | Load an existing playlist.
load :: String -> MPD ()
load = getResponse_ . ("load " ++) . show

-- | Move a song to a given position.
-- Note that a playlist position ('Pos') is required when operating on
-- playlists other than the current.
move :: Maybe String -- ^ Optionally specify a playlist to operate on
     -> PLIndex -> Integer -> MPD ()
move Nothing (Pos from) to =
    getResponse_ ("move " ++ show from ++ " " ++ show to)
move Nothing (ID from) to =
    getResponse_ ("moveid " ++ show from ++ " " ++ show to)
move (Just plname) (Pos from) to =
    getResponse_ ("playlistmove " ++ show plname ++ " " ++ show from ++
                       " " ++ show to)
move _ _ _ = fail "'move' within a playlist doesn't accept a playlist ID"

-- | Delete existing playlist.
rm :: String -> MPD ()
rm = getResponse_ . ("rm " ++) . show

-- | Rename an existing playlist.
rename :: String -- ^ Name of playlist to be renamed
       -> String -- ^ New playlist name
       -> MPD ()
rename plname new =
    getResponse_ ("rename " ++ show plname ++ " " ++ show new)

-- | Save the current playlist.
save :: String -> MPD ()
save = getResponse_ . ("save " ++) . show

-- | Swap the positions of two songs.
-- Note that the positions must be of the same type, i.e. mixing 'Pos' and 'ID'
-- will result in a no-op.
swap :: PLIndex -> PLIndex -> MPD ()
swap (Pos x) (Pos y) = getResponse_ ("swap "   ++ show x ++ " " ++ show y)
swap (ID x)  (ID y)  = getResponse_ ("swapid " ++ show x ++ " " ++ show y)
swap _ _ = fail "'swap' cannot mix position and ID arguments"

-- | Shuffle the playlist.
shuffle :: MPD ()
shuffle = getResponse_ "shuffle"

-- | Retrieve metadata for songs in the current playlist.
playlistinfo :: Maybe PLIndex   -- ^ Optional playlist index.
             -> MPD [Song]
playlistinfo x = liftM takeSongs (getResponse cmd)
    where cmd = case x of
                    Just (Pos x') -> "playlistinfo " ++ show x'
                    Just (ID x')  -> "playlistid " ++ show x'
                    Nothing       -> "playlistinfo"

-- | Retrieve metadata for files in a given playlist.
listplaylistinfo :: String -> MPD [Song]
listplaylistinfo = liftM takeSongs . getResponse .
    ("listplaylistinfo " ++) . show

-- | Retrieve a list of files in a given playlist.
listplaylist :: String -> MPD [String]
listplaylist = liftM takeValues . getResponse . ("listplaylist " ++) . show

-- | 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.
playlist :: MPD [(PLIndex, String)]
playlist = liftM (map f) (getResponse "playlist")
    where f s = let (pos, name) = break (== ':') s
                in (Pos $ read pos, drop 1 name)

-- | Retrieve a list of changed songs currently in the playlist since
-- a given playlist version.
plchanges :: Integer -> MPD [Song]
plchanges = liftM takeSongs . getResponse . ("plchanges " ++) . show

-- | Like 'plchanges' but only returns positions and ids.
plchangesposid :: Integer -> MPD [(PLIndex, PLIndex)]
plchangesposid plver =
    liftM (map takePosid . splitGroups . toAssoc) (getResponse cmd)
    where cmd          = "plchangesposid " ++ show plver
          takePosid xs = (Pos $ takeNum "cpos" xs, ID $ takeNum "Id" xs)

-- | Search for songs in the current playlist with strict matching.
playlistfind :: Query -> MPD [Song]
playlistfind = liftM takeSongs . getResponse . ("playlistfind " ++) . show

-- | Search case-insensitively with partial matches for songs in the
-- current playlist.
playlistsearch :: Query -> MPD [Song]
playlistsearch = liftM takeSongs . getResponse . ("playlistsearch " ++) . show

-- | Get the currently playing song.
currentSong :: MPD (Maybe Song)
currentSong = do
    currStatus <- status
    if stState currStatus == Stopped
        then return Nothing
        else do ls <- liftM toAssoc (getResponse "currentsong")
                return $ if null ls then Nothing
                                    else Just (takeSongInfo ls)

--
-- Playback commands
--

-- | Set crossfading between songs.
crossfade :: Seconds -> MPD ()
crossfade = getResponse_ . ("crossfade " ++) . show

-- | Begin\/continue playing.
play :: Maybe PLIndex -> MPD ()
play Nothing        = getResponse_ "play"
play (Just (Pos x)) = getResponse_ ("play " ++ show x)
play (Just (ID x))  = getResponse_ ("playid " ++ show x)

-- | Pause playing.
pause :: Bool -> MPD ()
pause = getResponse_ . ("pause " ++) . showBool

-- | Stop playing.
stop :: MPD ()
stop = getResponse_ "stop"

-- | Play the next song.
next :: MPD ()
next = getResponse_ "next"

-- | Play the previous song.
previous :: MPD ()
previous = getResponse_ "previous"

-- | Seek to some point in a song.
-- Seeks in current song if no position is given.
seek :: Maybe PLIndex -> Seconds -> MPD ()
seek (Just (Pos x)) time =
    getResponse_ ("seek " ++ show x ++ " " ++ show time)
seek (Just (ID x)) time =
    getResponse_ ("seekid " ++ show x ++ " " ++ show time)
seek Nothing time = do
    st <- status
    unless (stState st == Stopped) (seek (stSongID st) time)

-- | Set random playing.
random :: Bool -> MPD ()
random = getResponse_ . ("random " ++) . showBool

-- | Set repeating.
repeat :: Bool -> MPD ()
repeat = getResponse_ . ("repeat " ++) . showBool

-- | Set the volume.
setVolume :: Int -> MPD ()
setVolume = getResponse_ . ("setvol " ++) . show

-- | 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.
-- Note that this command is only included for completeness sake ; it's
-- deprecated and may disappear at any time.
volume :: Int -> MPD ()
volume = getResponse_ . ("volume " ++) . show

--
-- Miscellaneous commands
--

-- | Clear the current error message in status.
clearerror :: MPD ()
clearerror = getResponse_ "clearerror"

-- | Retrieve a list of available commands.
commands :: MPD [String]
commands = liftM takeValues (getResponse "commands")

-- | Retrieve a list of unavailable commands.
notcommands :: MPD [String]
notcommands = liftM takeValues (getResponse "notcommands")

-- | Retrieve a list of available song metadata.
tagtypes :: MPD [String]
tagtypes = liftM takeValues (getResponse "tagtypes")

-- | Retrieve a list of supported urlhandlers.
urlhandlers :: MPD [String]
urlhandlers = liftM takeValues (getResponse "urlhandlers")

-- XXX should the password be quoted?
-- | Send password to server to authenticate session.
-- Password is sent as plain text.
password :: String -> MPD ()
password = getResponse_ . ("password " ++)

-- | Check that the server is still responding.
ping :: MPD ()
ping = getResponse_ "ping"

-- | Get server statistics.
stats :: MPD Stats
stats = liftM (parseStats . toAssoc) (getResponse "stats")
    where parseStats xs =
                Stats { stsArtists = takeNum "artists" xs,
                        stsAlbums = takeNum "albums" xs,
                        stsSongs = takeNum "songs" xs,
                        stsUptime = takeNum "uptime" xs,
                        stsPlaytime = takeNum "playtime" xs,
                        stsDbPlaytime = takeNum "db_playtime" xs,
                        stsDbUpdate = takeNum "db_update" xs }

-- | Get the server's status.
status :: MPD Status
status = liftM (parseStatus . toAssoc) (getResponse "status")
    where parseStatus xs =
              Status { stState = maybe Stopped parseState $ lookup "state" xs,
                     stVolume = takeNum "volume" xs,
                     stRepeat = takeBool "repeat" xs,
                     stRandom = takeBool "random" xs,
                     stPlaylistVersion = takeNum "playlist" xs,
                     stPlaylistLength = takeNum "playlistlength" xs,
                     stXFadeWidth = takeNum "xfade" xs,
                     stSongPos = takeIndex Pos "song" xs,
                     stSongID = takeIndex ID "songid" xs,
                     stTime = maybe (0,0) parseTime $ lookup "time" xs,
                     stBitrate = takeNum "bitrate" xs,
                     stAudio = maybe (0,0,0) parseAudio $ lookup "audio" xs,
                     stUpdatingDb = takeNum "updating_db" xs,
                     stError = takeString "error" xs
                   }
          parseState x = case x of "play"  -> Playing
                                   "pause" -> Paused
                                   _       -> Stopped
          parseTime  x = let (y,_:z) = break (== ':') x in (read y, read z)
          parseAudio x =
              let (u,_:u') = break (== ':') x; (v,_:w) = break (== ':') u' in
                  (read u, read v, read w)

--
-- Extensions\/shortcuts.
--

-- | Like 'update', but returns the update job id.
updateid :: [String] -> MPD Integer
updateid paths = liftM (read . head . takeValues) cmd
  where cmd = case paths of
                []  -> getResponse "update"
                [x] -> getResponse ("update " ++ x)
                xs  -> getResponses (map ("update " ++) xs)

-- | Toggles play\/pause. Plays if stopped.
toggle :: MPD ()
toggle = status >>= \st -> case stState st of Playing -> pause True
                                              _       -> play Nothing

-- | Add a list of songs\/folders to a playlist.
-- Should be more efficient than running 'add' many times.
addMany :: Maybe String -> [String] -> MPD ()
addMany _ [] = return ()
addMany plname [x] = add_ plname x
addMany plname xs = getResponses (map (cmd ++) xs) >> return ()
    where cmd = maybe ("add ") (\pl -> "playlistadd " ++ show pl ++ " ") plname

-- | Delete a list of songs from a playlist.
-- If there is a duplicate then no further songs will be deleted, so
-- take care to avoid them (see 'prune' for this).
deleteMany :: Maybe String -> [PLIndex] -> MPD ()
deleteMany _ [] = return ()
deleteMany plname [x] = delete plname x
deleteMany (Just plname) xs = getResponses (map cmd xs) >> return ()
    where cmd (Pos x) = "playlistdelete " ++ show plname ++ " " ++ show x
          cmd _       = ""
deleteMany Nothing xs = getResponses (map cmd xs) >> return ()
    where cmd (Pos x) = "delete " ++ show x
          cmd (ID x)  = "deleteid " ++ show x

-- | Crop playlist.
-- The bounds are inclusive.
-- If 'Nothing' or 'ID' is passed the cropping will leave your playlist alone
-- on that side.
crop :: Maybe PLIndex -> Maybe PLIndex -> MPD ()
crop x y = do
    pl <- playlistinfo Nothing
    let x' = case x of Just (Pos p) -> fromInteger p
                       Just (ID i)  -> maybe 0 id (findByID i pl)
                       Nothing      -> 0
        -- ensure that no songs are deleted twice with 'max'.
        ys = case y of Just (Pos p) -> drop (max (fromInteger p) x') pl
                       Just (ID i)  -> maybe [] (flip drop pl . max x' . (+1))
                                      (findByID i pl)
                       Nothing      -> []
    deleteMany Nothing . mapMaybe sgIndex $ take x' pl ++ ys
    where findByID i = findIndex ((==) i . (\(ID j) -> j) . fromJust . sgIndex)

-- | Remove duplicate playlist entries.
prune :: MPD ()
prune = findDuplicates >>= deleteMany Nothing

-- Find duplicate playlist entries.
findDuplicates :: MPD [PLIndex]
findDuplicates =
    liftM (map ((\(ID x) -> ID x) . fromJust . sgIndex) . flip dups ([],[])) $
        playlistinfo Nothing
    where dups [] (_, dup) = dup
          dups (x:xs) (ys, dup)
            | x `elem` xs && x `notElem` ys = dups xs (ys, x:dup)
            | otherwise                     = dups xs (x:ys, dup)

-- | List directories non-recursively.
lsdirs :: Maybe String -- ^ optional path.
       -> MPD [String]
lsdirs path = liftM ((\(x,_,_) -> x) . takeEntries)
                    (getResponse ("lsinfo " ++ maybe "" show path))

-- | List files non-recursively.
lsfiles :: Maybe String -- ^ optional path.
        -> MPD [String]
lsfiles path = liftM (map sgFilePath . (\(_,_,x) -> x) . takeEntries)
                     (getResponse ("lsinfo " ++ maybe "" show path))

-- | List all playlists.
lsplaylists :: MPD [String]
lsplaylists = liftM ((\(_,x,_) -> x) . takeEntries) (getResponse "lsinfo")

-- | Search the database for songs relating to an artist.
findArtist :: Artist -> MPD [Song]
findArtist = find . Query Artist

-- | Search the database for songs relating to an album.
findAlbum :: Album -> MPD [Song]
findAlbum = find . Query Album

-- | Search the database for songs relating to a song title.
findTitle :: Title -> MPD [Song]
findTitle = find . Query Title

-- | List the artists in the database.
listArtists :: MPD [Artist]
listArtists = liftM takeValues (getResponse "list artist")

-- | List the albums in the database, optionally matching a given
-- artist.
listAlbums :: Maybe Artist -> MPD [Album]
listAlbums artist = liftM takeValues (getResponse ("list album" ++
    maybe "" ((" artist " ++) . show) artist))

-- | List the songs in an album of some artist.
listAlbum :: Artist -> Album -> MPD [Song]
listAlbum artist album = find (MultiQuery [Query Artist artist
                                          ,Query Album album])

-- | Search the database for songs relating to an artist using 'search'.
searchArtist :: Artist -> MPD [Song]
searchArtist = search . Query Artist

-- | Search the database for songs relating to an album using 'search'.
searchAlbum :: Album -> MPD [Song]
searchAlbum = search . Query Album

-- | Search the database for songs relating to a song title.
searchTitle :: Title -> MPD [Song]
searchTitle = search . Query Title

-- | Retrieve the current playlist.
-- Equivalent to 'playlistinfo Nothing'.
getPlaylist :: MPD [Song]
getPlaylist = playlistinfo Nothing

--
-- Miscellaneous functions.
--

-- Run getResponse but discard the response.
getResponse_ :: String -> MPD ()
getResponse_ x = getResponse x >> return ()

-- Get the lines of the daemon's response to a list of commands.
getResponses :: [String] -> MPD [String]
getResponses cmds = getResponse (concat . intersperse "\n" $ cmds')
    where cmds' = "command_list_begin" : cmds ++ ["command_list_end"]

-- Break up a list of strings into an assoc. list, separating at
-- the first ':'.
toAssoc :: [String] -> [(String, String)]
toAssoc = map f
    where f x = let (k,v) = break (== ':') x in
                (k,dropWhile (== ' ') $ drop 1 v)

-- Takes an assoc. list with recurring keys, and groups each cycle of
-- keys with their values together. The first key of each cycle needs
-- to be present in every cycle for it to work, but the rest don't
-- affect anything.
--
-- > splitGroups [(1,'a'),(2,'b'),(1,'c'),(2,'d')] ==
-- >     [[(1,'a'),(2,'b')],[(1,'c'),(2,'d')]]
splitGroups :: Eq a => [(a, b)] -> [[(a, b)]]
splitGroups [] = []
splitGroups (x:xs) = ((x:us):splitGroups vs)
    where (us,vs) = break (\y -> fst x == fst y) xs

-- Run 'toAssoc' and return only the values.
takeValues :: [String] -> [String]
takeValues = snd . unzip . toAssoc

-- Separate the result of an lsinfo\/listallinfo call into directories,
-- playlists, and songs.
takeEntries :: [String] -> ([String], [String], [Song])
takeEntries s =
    (dirs, playlists, map takeSongInfo . splitGroups $ reverse filedata)
    where (dirs, playlists, filedata) = foldl split ([], [], []) $ toAssoc s
          split (ds, pls, ss) x@(k, v) | k == "directory" = (v:ds, pls, ss)
                                       | k == "playlist"  = (ds, v:pls, ss)
                                       | otherwise        = (ds, pls, x:ss)

-- Build a list of song instances from a response.
takeSongs :: [String] -> [Song]
takeSongs = map takeSongInfo . splitGroups . toAssoc

-- Builds a song instance from an assoc. list.
takeSongInfo :: [(String,String)] -> Song
takeSongInfo xs =
    Song {
          sgArtist    = takeString "Artist" xs,
          sgAlbum     = takeString "Album" xs,
          sgTitle     = takeString "Title" xs,
          sgGenre     = takeString "Genre" xs,
          sgName      = takeString "Name" xs,
          sgComposer  = takeString "Composer" xs,
          sgPerformer = takeString "Performer" xs,
          sgDate      = takeNum "Date" xs,
          sgTrack     = maybe (0, 0) parseTrack $ lookup "Track" xs,
          sgDisc      = maybe (0, 0) parseTrack $ lookup "Disc" xs,
          sgFilePath  = takeString "file" xs,
          sgLength    = takeNum "Time" xs,
          sgIndex     = takeIndex ID "Id" xs
         }
    where parseTrack x = let (trck, tot) = break (== '/') x
                         in (read trck, parseNum (drop 1 tot))

-- Helpers for retrieving values from an assoc. list.
takeString :: String -> [(String, String)] -> String
takeString v = fromMaybe "" . lookup v

takeIndex :: (Integer -> PLIndex) -> String -> [(String, String)]
          -> Maybe PLIndex
takeIndex c v = maybe Nothing (Just . c . parseNum) . lookup v

takeNum :: (Read a, Num a) => String -> [(String, String)] -> a
takeNum v = maybe 0 parseNum . lookup v

takeBool :: String -> [(String, String)] -> Bool
takeBool v = maybe False parseBool . lookup v

-- Parse a numeric value, returning 0 on failure.
parseNum :: (Read a, Num a) => String -> a
parseNum = fromMaybe 0 . maybeReads
    where maybeReads s = do ; [(x, "")] <- return (reads s) ; return x

-- Inverts 'parseBool'.
showBool :: Bool -> String
showBool x = if x then "1" else "0"

-- Parse a boolean response value.
parseBool :: String -> Bool
parseBool = (== "1") . take 1