libmpd-0.7.0: tests/Commands.hs
{-# OPTIONS_GHC -Wwarn -fno-warn-missing-signatures #-}
-- |
-- This module provides a way of verifying that the interface to the MPD
-- commands is correct. It does so by capturing the data flow between the
-- command and a dummy socket, checking the captured data against a set of
-- predefined values that are known to be correct. Of course, this does not
-- verify that the external behaviour is correct, it's simply a way of
-- catching silly mistakes and subtle bugs in the interface itself, without
-- having to actually send any requests to a real server.
module Commands (main) where
import Arbitrary ()
import Displayable
import Network.MPD.Commands
import Network.MPD.Commands.Extensions
import Network.MPD.Core (MPDError(..), Response, ACKType(..))
import StringConn
import Prelude hiding (repeat)
import Data.Char (isPrint, isSpace)
import Data.Maybe (fromJust, isJust)
import Text.Printf
import qualified Test.QuickCheck as QC
import Test.QuickCheck ((==>))
main = mapM_ (\(n, f) -> printf "%-25s : " n >> f) tests
where tests = [("enableOutput", testEnableOutput)
,("disableOutput", testDisableOutput)
,("outputs", testOutputs)
,("update0", testUpdate0)
,("update1", testUpdate1)
,("updateMany", testUpdateMany)
{-
,("prop_find", mycheck prop_find 100)
-}
{-
,("prop_lsFiles", mycheck prop_lsFiles 100)
,("prop_lsDirs", mycheck prop_lsDirs 100)
-}
,("list(Nothing)", testListNothing)
,("list(Just)", testListJust)
,("listAll", testListAll)
,("lsInfo", testLsInfo)
,("listAllInfo", testListAllInfo)
{-
,("search", testSearch)
-}
,("count", testCount)
,("add", testAdd)
,("add_", testAdd_)
,("add_ / playlist", testAdd_pl)
,("addId", testAddId)
,("clear / playlist", testClearPlaylist)
,("clear / current", testClearCurrent)
,("plChangesPosId 0", testPlChangesPosId_0)
{-
,("plChangesPosId 1", testPlChangesPosId_1)
-}
,("plChangesPosId weird", testPlChangesPosId_Weird)
,("currentSong(_)", testCurrentSongStopped)
{-
,("currentSong(>)", testCurrentSongPlaying)
-}
{-
,("delete0", testDelete0)
,("delete1", testDelete1)
-}
,("delete2", testDelete2)
,("load", testLoad)
{-
,("move0", testMove0)
,("move1", testMove1)
,("move2", testMove2)
-}
,("rm", testRm)
,("rename", testRename)
,("save", testSave)
{-
,("swap0", testSwap0)
,("swap1", testSwap1)
-}
,("shuffle", testShuffle)
{-
,("playlistInfo0", testPlaylistInfo0)
-}
{-
,("playlistInfo / pos", testPlaylistInfoPos)
,("playlistInfo / id", testPlaylistInfoId)
-}
{-
,("listPlaylistInfo", testListPlaylistInfo)
-}
,("listPlaylist", testListPlaylist)
{-
,("playlist", testPlaylist)
-}
{-
,("plchanges", testPlChanges)
,("playlistFind", testPlaylistFind)
,("playlistSearch", testPlaylistSearch)
-}
,("crossfade", testCrossfade)
,("play", testPlay)
{-
,("play / pos", testPlayPos)
,("play / id", testPlayId)
-}
,("pause", testPause)
,("stop", testStop)
,("next", testNext)
,("previous", testPrevious)
{-
,("seek / pos", testSeekPos)
,("seek / id", testSeekId)
,("seek / current", testSeekCur)
-}
,("random", testRandom)
,("repeat", testRepeat)
,("setVolume", testSetVolume)
,("volume", testVolume)
,("consume", testConsume)
,("single", testSingle)
,("clearError", testClearError)
,("commands", testCommands)
,("notCommands", testNotCommands)
,("tagTypes", testTagTypes)
,("urlHandlers", testUrlHandlers)
,("password", testPassword)
,("passwordSucceeds", testPasswordSucceeds)
,("passwordFails", testPasswordFails)
,("ping", testPing)
,("stats", testStats)
,("updateId0", testUpdateId0)
,("updateId1", testUpdateId1)
,("toggle / stop", testToggleStop)
,("toggle / play", testTogglePlay)
,("toggle / pause", testTogglePause)
,("addMany0", testAddMany0)
,("addMany1", testAddMany1)
{-
,("deleteMany1", testDeleteMany1)
-}
]
test :: (Show a, Eq a)
=> [(Expect, Response String)] -> Response a -> StringMPD a -> IO ()
test a b c = putStrLn . showResult $ testMPD a b "" c
test_ :: [(Expect, Response String)] -> StringMPD () -> IO ()
test_ a b = test a (Right ()) b
mycheck :: QC.Testable a => a -> Int -> IO ()
mycheck a n = QC.quickCheckWith QC.stdArgs { QC.maxSize = n } a
showResult :: Show a => Result a -> String
showResult Ok =
"OK, passed."
showResult (BadRequest TooManyRequests) = unlines
["*** FAILURE ***"
," more requests were made than expected."]
showResult (BadRequest (UnexpectedRequest expected actual)) = unlines
["*** FAILURE ***"
," expected request: " ++ show expected
," actual request: " ++ show actual]
showResult (BadResult expected actual) = unlines
["*** FAILURE ***"
," expected result: " ++ show expected
," actual result: " ++ show actual]
--
-- Admin commands
--
testEnableOutput = test_ [("enableoutput 1", Right "OK")] (enableOutput 1)
testDisableOutput = test_ [("disableoutput 1", Right "OK")] (disableOutput 1)
testOutputs =
test [("outputs", Right resp)] (Right [obj1, obj2]) outputs
where obj1 = empty { dOutputName = "SoundCard0", dOutputEnabled = True }
obj2 = empty { dOutputName = "SoundCard1", dOutputID = 1 }
resp = concatMap display [obj1, obj2] ++ "OK"
testUpdate0 = test_ [("update", Right "updating_db: 1\nOK")] (update [])
testUpdate1 =
test_ [("update \"foo\"", Right "updating_db: 1\nOK")]
(update ["foo"])
testUpdateMany =
test_ [("command_list_begin\nupdate \"foo\"\nupdate \"bar\"\n\
\command_list_end", Right "updating_db: 1\nOK")]
(update ["foo","bar"])
--
-- Database commands
--
{-
prop_find :: Song -> Metadata -> QC.Property
prop_find song meta = isJust (sgDisc song) ==> result == Ok
where
result = testMPD [("find "++ show meta ++ " \"" ++ query ++ "\""
,Right (display song ++ "OK"))]
(Right [song])
""
(find (meta =? query))
query = case meta of
Artist -> sgArtist song
Album -> sgAlbum song
Title -> sgTitle song
Track -> show $ fst $ sgTrack song
Name -> sgName song
Genre -> sgGenre song
Date -> show $ sgDate song
Composer -> sgComposer song
Performer -> sgPerformer song
Disc -> show $ fromJust $ sgDisc song
{-
Filename -> sgFilePath song
Any -> "Foo"
-}
-}
{- XXX: where did these go?
prop_lsFiles :: [Song] -> Bool
prop_lsFiles ss = result == Ok
where
result =
testMPD [("lsinfo \"\"", Right (concatMap display ss ++ "OK"))]
(Right (map sgFilePath ss))
""
(lsFiles "")
prop_lsDirs :: [Path] -> QC.Property
prop_lsDirs ds = all (all goodChar) ds ==> result == Ok
where
goodChar c = ('\n' /= c) && (isPrint c)
asDir d = "directory: " ++ d ++ "\n"
result =
testMPD [("lsinfo \"\"", Right (concatMap asDir ds ++ "OK"))]
(Right $ map (dropWhile isSpace) ds)
""
(lsDirs "")
-}
testListNothing =
test [("list Title", Right "Title: Foo\nTitle: Bar\nOK")]
(Right ["Foo", "Bar"])
(list Title anything)
testListJust =
test [("list Title Artist \"Muzz\"", Right "Title: Foo\nOK")]
(Right ["Foo"])
(list Title (Artist =? "Muzz"))
testListAll =
test [("listall \"\"", Right "directory: FooBand\n\
\directory: FooBand/album1\n\
\file: FooBand/album1/01 - songA.ogg\n\
\file: FooBand/album1/02 - songB.ogg\nOK")]
(Right ["FooBand/album1/01 - songA.ogg"
,"FooBand/album1/02 - songB.ogg"])
(listAll "")
testLsInfo =
test [("lsinfo \"\"",
Right $ "directory: Foo\n" ++ display song ++ "playlist: Quux\nOK")]
(Right [Left "Foo", Right song])
(lsInfo "")
where
song = empty { sgFilePath = "Bar.ogg" }
testListAllInfo =
test [("listallinfo \"\"", Right "directory: Foo\ndirectory: Bar\nOK")]
(Right [Left "Foo", Left "Bar"])
(listAllInfo "")
{-
testSearch =
test [("search Artist \"oo\"", Right resp)] (Right [obj])
(search (Artist =? "oo"))
where obj = empty { sgArtist = "Foo", sgTitle = "Bar"
, sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60 }
resp = display obj ++ "OK"
-}
testCount =
test [("count Title \"Foo\"", Right resp)] (Right obj)
(count (Title =? "Foo"))
where obj = Count 1 60
resp = display obj ++ "OK"
--
-- Playlist commands
--
testAdd =
test [("add \"foo\"", Right "OK"),
("listall \"foo\"", Right "file: Foo\nfile: Bar\nOK")]
(Right ["Foo", "Bar"])
(add "foo")
testAdd_ = test_ [("add \"foo\"", Right "OK")] (add_ "foo")
testAdd_pl = test_ [("playlistadd \"foo\" \"bar\"", Right "OK")]
(playlistAdd_ "foo" "bar")
testAddId =
test [("addid \"dir/Foo-Bar.ogg\"", Right "Id: 20\nOK")]
(Right $ Id 20)
(addId "dir/Foo-Bar.ogg" Nothing)
testClearPlaylist = test_ [("playlistclear \"foo\"", Right "OK")]
(playlistClear "foo")
testClearCurrent = test_ [("clear", Right "OK")] clear
testPlChangesPosId_0 =
test [("plchangesposid 10", Right "OK")]
(Right [])
(plChangesPosId 10)
{- XXX: port this?
testPlChangesPosId_1 =
test [("plchangesposid 10", Right "cpos: 0\nId: 20\nOK")]
(Right [(Pos 0, ID 20)])
(plChangesPosId 10)
-}
testPlChangesPosId_Weird =
test [("plchangesposid 10", Right "cpos: foo\nId: bar\nOK")]
(Left $ Unexpected "[(\"cpos\",\"foo\"),(\"Id\",\"bar\")]")
(plChangesPosId 10)
testCurrentSongStopped =
test [("status", Right resp)] (Right Nothing) currentSong
where obj = empty { stState = Stopped, stPlaylistVersion = 253 }
resp = display obj ++ "OK"
{- XXX: port this
testCurrentSongPlaying =
test [("status", Right resp2)
,("currentsong", Right resp1)]
(Right $ Just song)
(currentSong)
where song = empty { sgArtist = "Foo", sgTitle = "Bar"
, sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60 }
resp1 = display song
estatus = empty { stVolume = 80, stPlaylistVersion = 252
, stPlaylistLength = 21, stSongPos = Just (Pos 20)
, stSongID = Just (ID 238), stTime = (158, 376)
, stBitrate = 192, stAudio = (44100, 16, 2)
, stState = Playing }
resp2 = display estatus ++ "OK"
testDelete0 = test_ [("delete 1", Right "OK")] (delete (Pos 1))
testDelete1 = test_ [("deleteid 1", Right "OK")] (delete (ID 1))
-}
testDelete2 = test_ [("playlistdelete \"foo\" 1", Right "OK")] (playlistDelete "foo" 1)
testLoad = test_ [("load \"foo\"", Right "OK")] (load "foo")
{- XXX: port this
testMove0 = test_ [("move 1 2", Right "OK")] (move (Pos 1) 2)
testMove1 = test_ [("moveid 1 2", Right "OK")] (move (ID 1) 2)
-}
testMove2 = test_ [("playlistmove \"foo\" 1 2", Right "OK")] (playlistMove "foo" 1 2)
testRm = test_ [("rm \"foo\"", Right "OK")] (rm "foo")
testRename = test_ [("rename \"foo\" \"bar\"", Right "OK")] (rename "foo" "bar")
testSave = test_ [("save \"foo\"", Right "OK")] (save "foo")
{-
testSwap0 = test_ [("swap 1 2", Right "OK")] (swap (Pos 1) (Pos 2))
testSwap1 = test_ [("swapid 1 2", Right "OK")] (swap (ID 1) (ID 2))
-}
testShuffle = test_ [("shuffle", Right "OK")] (shuffle Nothing)
{-
testPlaylistInfo0 = test [("playlistinfo", Right resp)] (Right [obj])
(playlistInfo Nothing)
where obj = empty { sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60
, sgArtist = "Foo", sgTitle = "Bar" }
resp = display obj ++ "OK"
-}
{- XXX: port this
testPlaylistInfoPos = test [("playlistinfo 1", Right resp)] (Right [obj])
(playlistInfo (Just (Left (Pos 1))))
where obj = empty { sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60
, sgArtist = "Foo", sgTitle = "Bar" }
resp = display obj ++ "OK"
-}
{- XXX: port this
testPlaylistInfoId = test [("playlistid 1", Right resp)] (Right [obj])
(playlistInfo (Just (Left (ID 1))))
where obj = empty { sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60
, sgArtist = "Foo", sgTitle = "Bar" }
resp = display obj ++ "OK"
-}
{-
testListPlaylistInfo = test [("listplaylistinfo \"foo\"", Right resp)]
(Right [obj])
(listPlaylistInfo "foo")
where obj = empty { sgFilePath = "dir/Foo-Bar.ogg", sgLength = 60
, sgArtist = "Foo", sgTitle = "Bar" }
resp = display obj ++ "OK"
-}
testListPlaylist = test [("listplaylist \"foo\""
,Right "file: dir/Foo-bar.ogg\n\
\file: dir/Quux-quuz.ogg\n\
\OK")]
(Right ["dir/Foo-bar.ogg", "dir/Quux-quuz.ogg"])
(listPlaylist "foo")
{-
testPlaylist = test [("playlist"
,Right "1:Foo.ogg\n\
\2:Bar.ogg\n\
\OK")]
(Right [(Pos 1, "Foo.ogg")
,(Pos 2, "Bar.ogg")])
playlist
-}
{-
testPlChanges = test [("plchanges 0", Right resp)] (Right [obj]) (plChanges 0)
where obj = empty { sgArtist = "Foo", sgTitle = "Bar"
, sgFilePath = "foo/bar.ogg" }
resp = display obj ++ "OK"
-}
{-
testPlaylistFind = test [("playlistfind Artist \"Foo\"", Right resp)]
(Right [obj])
(playlistFind (Artist =? "Foo"))
where obj = empty { sgFilePath = "dir/Foo/Bar.ogg", sgArtist = "Foo" }
resp = display obj ++ "OK"
-}
{-
testPlaylistSearch = test [("playlistsearch Artist \"Foo\"", Right resp)]
(Right [obj])
(playlistSearch (Artist =? "Foo"))
where obj = empty { sgFilePath = "dir/Foo/Bar.ogg", sgArtist = "Foo" }
resp = display obj ++ "OK"
-}
--
-- Playback commands
--
testCrossfade = test_ [("crossfade 0", Right "OK")] (crossfade 0)
testPlay = test_ [("play", Right "OK")] (play Nothing)
{- XXX: port this
testPlayPos = test_ [("play 1", Right "OK")] (play . Just $ Pos 1)
-}
{- XXX: port this
testPlayId = test_ [("playid 1", Right "OK")] (play . Just $ ID 1)
-}
testPause = test_ [("pause 0", Right "OK")] (pause False)
testStop = test_ [("stop", Right "OK")] stop
testNext = test_ [("next", Right "OK")] next
testPrevious = test_ [("previous", Right "OK")] previous
{- XXX: port this
testSeekPos = test_ [("seek 1 10", Right "OK")] (seek (Just $ Pos 1) 10)
testSeekId = test_ [("seekid 1 10", Right "OK")] (seek (Just $ ID 1) 10)
-}
{- XXX: port this
testSeekCur = test_ [("status", Right resp)
,("seekid 1 10", Right "OK")]
(seek Nothing 10)
where obj = empty { stState = Playing, stSongID = Just (ID 1) }
resp = display obj ++ "OK"
-}
testRandom = test_ [("random 0", Right "OK")] (random False)
testRepeat = test_ [("repeat 0", Right "OK")] (repeat False)
testSetVolume = test_ [("setvol 10", Right "OK")] (setVolume 10)
testConsume = test_ [("consume 1", Right "OK")] (consume True)
testSingle = test_ [("single 1", Right "OK")] (single True)
--
-- Miscellaneous commands
--
testClearError = test_ [("clearerror", Right "OK")] clearError
testCommands =
test [("commands", Right "command: foo\ncommand: bar")]
(Right ["foo", "bar"])
commands
testNotCommands =
test [("notcommands", Right "command: foo\ncommand: bar")]
(Right ["foo", "bar"])
notCommands
testTagTypes =
test [("tagtypes", Right "tagtype: foo\ntagtype: bar")]
(Right ["foo", "bar"])
tagTypes
testUrlHandlers =
test [("urlhandlers", Right "urlhandler: foo\nurlhandler: bar")]
(Right ["foo", "bar"])
urlHandlers
testPassword = test_ [("password foo", Right "OK")] (password "foo")
testPasswordSucceeds =
putStrLn . showResult $ testMPD convo expected_resp "foo" cmd
where
convo = [("lsinfo \"/\"", Right "ACK [4@0] {play} you don't have \
\permission for \"play\"")
,("password foo", Right "OK")
,("lsinfo \"/\"", Right "directory: /bar\nOK")]
expected_resp = Right [Left "/bar"]
cmd = lsInfo "/"
testPasswordFails =
putStrLn . showResult $ testMPD convo expected_resp "foo" cmd
where
convo = [("play", Right "ACK [4@0] {play} you don't have \
\permission for \"play\"")
,("password foo",
Right "ACK [3@0] {password} incorrect password")]
expected_resp =
Left $ ACK InvalidPassword " incorrect password"
cmd = play Nothing
testPing = test_ [("ping", Right "OK")] ping
testStats = test [("stats", Right resp)] (Right obj) stats
where obj = empty { stsArtists = 1, stsAlbums = 1, stsSongs = 1
, stsUptime = 100, stsPlaytime = 100, stsDbUpdate = 10
, stsDbPlaytime = 100 }
resp = display obj ++ "OK"
--
-- Extensions\/shortcuts
--
testUpdateId0 = test [("update", Right "updating_db: 1")]
(Right 1)
(updateId [])
testUpdateId1 = test [("update \"foo\"", Right "updating_db: 1")]
(Right 1)
(updateId ["foo"])
testTogglePlay = test_
[("status", Right resp)
,("pause 1", Right "OK")]
toggle
where resp = display empty { stState = Playing }
testToggleStop = test_
[("status", Right resp)
,("play", Right "OK")]
toggle
where resp = display empty { stState = Stopped }
testTogglePause = test_
[("status", Right resp)
,("play", Right "OK")]
toggle
where resp = display empty { stState = Paused }
testAddMany0 = test_ [("add \"bar\"", Right "OK")]
(addMany "" ["bar"])
testAddMany1 = test_ [("playlistadd \"foo\" \"bar\"", Right "OK")]
(addMany "foo" ["bar"])
{- XXX: where did this go?
testDeleteMany1 = test_ [("playlistdelete \"foo\" 1", Right "OK")]
(deleteMany "foo" [Pos 1])
-}
testVolume = test_ [("status", Right st), ("setvol 90", Right "OK")] (volume (-10))
where st = display empty { stVolume = 100 }