tests/Commands.hs

   1 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
   2
   3 module Main (main) where
   4
   5 import Network.MPD.Commands
   6 import Network.MPD.Prim (Response)
   7 import Network.MPD.StringConn
   8
   9 import Control.Monad
  10 import Data.Maybe
  11 import Text.Printf
  12
  13 main = mapM_ (\(n, f) -> f >>= \x -> printf "%-14s: %s\n" n x) tests
  14     where tests = [("enableOutput", testEnableOutput)
  15                   ,("disableOutput", testDisableOutput)
  16                   ,("outputs", testOutputs)
  17                   ,("update0", testUpdate0)
  18                   ,("update1", testUpdate1)
  19                   ,("updateMany", testUpdateMany)
  20                   ,("lsInfo", testLsInfo)
  21                   ,("add", testAdd)
  22                   ,("add_", testAdd_)
  23                   ,("clear", testClear)
  24                   ,("play", testPlay)
  25                   ,("stop", testStop)
  26                   ,("urlHandlers", testUrlHandlers)
  27                   ,("ping", testPing)
  28                   ]
  29
  30 test a b c = liftM (showResult b) $ testMPD a b (return Nothing) c
  31
  32 test_ a b = test a (Right ()) b
  33
  34 showResult :: (Show a) => Response a -> Result a -> String
  35 showResult _ Ok = "passed"
  36 showResult expectedResult (Failure result mms) =
  37     "*** FAILURE ***" ++
  38     concatMap (\(x,y) -> "\n  expected request: " ++ show x ++
  39                          "\n  actual request: " ++ show y) mms ++
  40     "\n    expected result: " ++ show expectedResult ++
  41     "\n    actual result: " ++ show result
  42
  43 --
  44 -- Admin commands
  45 --
  46
  47 testEnableOutput = test_ [("enableoutput 1", Right "OK")] (enableOutput 1)
  48
  49 testDisableOutput = test_ [("disableoutput 1", Right "OK")] (disableOutput 1)
  50
  51 testOutputs =
  52     test [("outputs", Right $ unlines ["outputid: 0"
  53                                       ,"outputname: SoundCard0"
  54                                       ,"outputenabled: 1"
  55                                       ,"outputid: 1"
  56                                       ,"outputname: SoundCard1"
  57                                       ,"outputenabled: 0"
  58                                       ,"OK"])]
  59          (Right [Device { dOutputID = 0
  60                         , dOutputName = "SoundCard0"
  61                         , dOutputEnabled = True }
  62                 ,Device { dOutputID = 1
  63                         , dOutputName = "SoundCard1"
  64                         , dOutputEnabled = False }])
  65          outputs
  66
  67 testUpdate0 = test_ [("update", Right "updating_db: 1\nOK")] (update [])
  68
  69 testUpdate1 =
  70     test_ [("update \"foo\"", Right "updating_db: 1\nOK")]
  71           (update ["foo"])
  72
  73 testUpdateMany =
  74     test_ [("command_list_begin\nupdate \"foo\"\nupdate \"bar\"\n\
  75             \command_list_end", Right "updating_db: 1\nOK")]
  76           (update ["foo","bar"])
  77
  78 --
  79 -- Database commands
  80 --
  81
  82 testLsInfo =
  83     test [("lsinfo \"\"", Right "directory: Foo\ndirectory: Bar\nOK")]
  84          (Right [Left "Bar", Left "Foo"])
  85          (lsInfo "")
  86
  87 --
  88 -- Playlist commands
  89 --
  90
  91 testAdd =
  92     test [("add \"foo\"", Right "OK"),
  93           ("listall \"foo\"", Right "file: Foo\nfile: Bar\nOK")]
  94          (Right ["Foo", "Bar"])
  95          (add "" "foo")
  96
  97 testAdd_ = test_ [("add \"foo\"", Right "OK")] (add_ "" "foo")
  98
  99 testClear = test_ [("playlistclear \"foo\"", Right "OK")] (clear "foo")
 100
 101 --
 102 -- Playback commands
 103 --
 104
 105 testPlay = test_ [("play", Right "OK")] (play Nothing)
 106
 107 testStop = test_ [("stop", Right "OK")] stop
 108
 109 --
 110 -- Miscellaneous commands
 111 --
 112
 113 testUrlHandlers =
 114     test [("urlhandlers", Right "urlhandler: foo\nurlhandler: bar")]
 115          (Right ["foo", "bar"])
 116          urlHandlers
 117
 118 testPing = test_ [("ping", Right "OK")] ping
 119
 120 --
 121 -- Extensions\/shortcuts
 122 --