module Network.MPD.Commands (
State(..), Status(..), Stats(..),
Device(..),
Query(..), Meta(..),
Artist, Album, Title, Seconds, PLIndex(..),
Song(..), Count(..),
disableoutput, enableoutput, outputs, update,
find, list, listAll, listAllinfo, lsinfo, search, count,
add, add_, addid, clear, currentSong, delete, load, move,
playlistinfo, listplaylist, listplaylistinfo, playlist, plchanges,
plchangesposid, playlistfind, playlistsearch, rm, rename, save, shuffle,
swap,
crossfade, next, pause, play, previous, random, repeat, seek, setVolume,
volume, stop,
clearerror, close, commands, notcommands, tagtypes, urlhandlers, password,
ping, reconnect, stats, status,
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
type Artist = String
type Album = String
type Title = String
type Seconds = Integer
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"
data Query = Query Meta String
| MultiQuery [Query]
instance Show Query where
show (Query meta query) = show meta ++ " " ++ show query
show (MultiQuery xs) = show xs
showList xs _ = unwords $ map show xs
data PLIndex = Pos Integer
| ID Integer
deriving Show
data State = Playing
| Stopped
| Paused
deriving (Show, Eq)
data Status =
Status { stState :: State
, stVolume :: Int
, stRepeat :: Bool
, stRandom :: Bool
, stPlaylistVersion :: Integer
, stPlaylistLength :: Integer
, stSongPos :: Maybe PLIndex
, stSongID :: Maybe PLIndex
, stTime :: (Seconds, Seconds)
, stBitrate :: Int
, stXFadeWidth :: Seconds
, stAudio :: (Int, Int, Int)
, stUpdatingDb :: Integer
, stError :: String }
deriving Show
data Stats =
Stats { stsArtists :: Integer
, stsAlbums :: Integer
, stsSongs :: Integer
, stsUptime :: Seconds
, stsPlaytime :: Seconds
, stsDbPlaytime :: Seconds
, stsDbUpdate :: Integer
}
deriving Show
data Song =
Song { sgArtist, sgAlbum, sgTitle, sgFilePath, sgGenre, sgName, sgComposer
, sgPerformer :: String
, sgLength :: Seconds
, sgDate :: Int
, sgTrack :: (Int, Int)
, sgDisc :: (Int, Int)
, sgIndex :: Maybe PLIndex }
deriving Show
instance Eq Song where
(==) x y = sgFilePath x == sgFilePath y
data Count =
Count { cSongs :: Integer
, cPlaytime :: Seconds
}
deriving Show
data Device =
Device { dOutputID :: Int
, dOutputName :: String
, dOutputEnabled :: Bool }
deriving Show
disableoutput :: Int -> MPD ()
disableoutput = getResponse_ . ("disableoutput " ++) . show
enableoutput :: Int -> MPD ()
enableoutput = getResponse_ . ("enableoutput " ++) . show
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 :: [String]
-> MPD ()
update [] = getResponse_ "update"
update [x] = getResponse_ ("update " ++ show x)
update xs = getResponses (map (("update " ++) . show) xs) >> return ()
list :: Meta
-> Maybe Query -> MPD [String]
list mtype query = liftM takeValues (getResponse cmd)
where cmd = "list " ++ show mtype ++ maybe "" ((" "++) . show) query
lsinfo :: Maybe String
-> MPD [Either String Song]
lsinfo path = do
(dirs,_,songs) <- liftM takeEntries
(getResponse ("lsinfo " ++ maybe "" show path))
return (map Left dirs ++ map Right songs)
listAll :: Maybe String -> MPD [String]
listAll path = liftM (map snd . filter ((== "file") . fst) . toAssoc)
(getResponse ("listall " ++ maybe "" show path))
listAllinfo :: Maybe String
-> MPD [Either String Song]
listAllinfo path = do
(dirs,_,songs) <- liftM takeEntries
(getResponse ("listallinfo " ++ maybe "" show path))
return (map Left dirs ++ map Right songs)
find :: Query -> MPD [Song]
find query = liftM takeSongs (getResponse ("find " ++ show query))
search :: Query -> MPD [Song]
search query = liftM takeSongs (getResponse ("search " ++ show 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 }
addid :: String -> MPD Integer
addid x =
liftM (read . snd . head . toAssoc) (getResponse ("addid " ++ show x))
add :: Maybe String -> String -> MPD [String]
add plname x = add_ plname x >> listAll (Just x)
add_ :: Maybe String
-> String -> MPD ()
add_ Nothing = getResponse_ . ("add " ++) . show
add_ (Just plname) = getResponse_ .
(("playlistadd " ++ show plname ++ " ") ++) . show
clear :: Maybe String
-> MPD ()
clear = getResponse_ . maybe "clear" (("playlistclear " ++) . show)
delete :: Maybe String
-> 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 :: String -> MPD ()
load = getResponse_ . ("load " ++) . show
move :: Maybe String
-> 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"
rm :: String -> MPD ()
rm = getResponse_ . ("rm " ++) . show
rename :: String
-> String
-> MPD ()
rename plname new =
getResponse_ ("rename " ++ show plname ++ " " ++ show new)
save :: String -> MPD ()
save = getResponse_ . ("save " ++) . show
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 :: MPD ()
shuffle = getResponse_ "shuffle"
playlistinfo :: Maybe PLIndex
-> 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"
listplaylistinfo :: String -> MPD [Song]
listplaylistinfo = liftM takeSongs . getResponse .
("listplaylistinfo " ++) . show
listplaylist :: String -> MPD [String]
listplaylist = liftM takeValues . getResponse . ("listplaylist " ++) . show
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)
plchanges :: Integer -> MPD [Song]
plchanges = liftM takeSongs . getResponse . ("plchanges " ++) . show
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)
playlistfind :: Query -> MPD [Song]
playlistfind = liftM takeSongs . getResponse . ("playlistfind " ++) . show
playlistsearch :: Query -> MPD [Song]
playlistsearch = liftM takeSongs . getResponse . ("playlistsearch " ++) . show
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)
crossfade :: Seconds -> MPD ()
crossfade = getResponse_ . ("crossfade " ++) . show
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 :: Bool -> MPD ()
pause = getResponse_ . ("pause " ++) . showBool
stop :: MPD ()
stop = getResponse_ "stop"
next :: MPD ()
next = getResponse_ "next"
previous :: MPD ()
previous = getResponse_ "previous"
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)
random :: Bool -> MPD ()
random = getResponse_ . ("random " ++) . showBool
repeat :: Bool -> MPD ()
repeat = getResponse_ . ("repeat " ++) . showBool
setVolume :: Int -> MPD ()
setVolume = getResponse_ . ("setvol " ++) . show
volume :: Int -> MPD ()
volume = getResponse_ . ("volume " ++) . show
clearerror :: MPD ()
clearerror = getResponse_ "clearerror"
commands :: MPD [String]
commands = liftM takeValues (getResponse "commands")
notcommands :: MPD [String]
notcommands = liftM takeValues (getResponse "notcommands")
tagtypes :: MPD [String]
tagtypes = liftM takeValues (getResponse "tagtypes")
urlhandlers :: MPD [String]
urlhandlers = liftM takeValues (getResponse "urlhandlers")
password :: String -> MPD ()
password = getResponse_ . ("password " ++)
ping :: MPD ()
ping = getResponse_ "ping"
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 }
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)
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)
toggle :: MPD ()
toggle = status >>= \st -> case stState st of Playing -> pause True
_ -> play Nothing
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
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 :: 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
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)
prune :: MPD ()
prune = findDuplicates >>= deleteMany Nothing
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)
lsdirs :: Maybe String
-> MPD [String]
lsdirs path = liftM ((\(x,_,_) -> x) . takeEntries)
(getResponse ("lsinfo " ++ maybe "" show path))
lsfiles :: Maybe String
-> MPD [String]
lsfiles path = liftM (map sgFilePath . (\(_,_,x) -> x) . takeEntries)
(getResponse ("lsinfo " ++ maybe "" show path))
lsplaylists :: MPD [String]
lsplaylists = liftM ((\(_,x,_) -> x) . takeEntries) (getResponse "lsinfo")
findArtist :: Artist -> MPD [Song]
findArtist = find . Query Artist
findAlbum :: Album -> MPD [Song]
findAlbum = find . Query Album
findTitle :: Title -> MPD [Song]
findTitle = find . Query Title
listArtists :: MPD [Artist]
listArtists = liftM takeValues (getResponse "list artist")
listAlbums :: Maybe Artist -> MPD [Album]
listAlbums artist = liftM takeValues (getResponse ("list album" ++
maybe "" ((" artist " ++) . show) artist))
listAlbum :: Artist -> Album -> MPD [Song]
listAlbum artist album = find (MultiQuery [Query Artist artist
,Query Album album])
searchArtist :: Artist -> MPD [Song]
searchArtist = search . Query Artist
searchAlbum :: Album -> MPD [Song]
searchAlbum = search . Query Album
searchTitle :: Title -> MPD [Song]
searchTitle = search . Query Title
getPlaylist :: MPD [Song]
getPlaylist = playlistinfo Nothing
getResponse_ :: String -> MPD ()
getResponse_ x = getResponse x >> return ()
getResponses :: [String] -> MPD [String]
getResponses cmds = getResponse (concat . intersperse "\n" $ cmds')
where cmds' = "command_list_begin" : cmds ++ ["command_list_end"]
toAssoc :: [String] -> [(String, String)]
toAssoc = map f
where f x = let (k,v) = break (== ':') x in
(k,dropWhile (== ' ') $ drop 1 v)
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
takeValues :: [String] -> [String]
takeValues = snd . unzip . toAssoc
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)
takeSongs :: [String] -> [Song]
takeSongs = map takeSongInfo . splitGroups . toAssoc
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))
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
parseNum :: (Read a, Num a) => String -> a
parseNum = fromMaybe 0 . maybeReads
where maybeReads s = do ; [(x, "")] <- return (reads s) ; return x
showBool :: Bool -> String
showBool x = if x then "1" else "0"
parseBool :: String -> Bool
parseBool = (== "1") . take 1