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.Core (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                   ,("commands", testCommands)
  27                   ,("notCommands", testNotCommands)
  28                   ,("tagTypes", testTagTypes)
  29                   ,("urlHandlers", testUrlHandlers)
  30                   ,("ping", testPing)
  31                   ]
  32
  33 test a b c = liftM (showResult b) $ testMPD a b (return Nothing) c
  34
  35 test_ a b = test a (Right ()) b
  36
  37 showResult :: (Show a) => Response a -> Result a -> String
  38 showResult _ Ok = "passed"
  39 showResult expectedResult (Failure result mms) =
  40     "*** FAILURE ***" ++
  41     concatMap (\(x,y) -> "\n  expected request: " ++ show x ++
  42                          "\n  actual request: " ++ show y) mms ++
  43     "\n    expected result: " ++ show expectedResult ++
  44     "\n    actual result: " ++ show result
  45
  46 --
  47 -- Admin commands
  48 --
  49
  50 testEnableOutput = test_ [("enableoutput 1", Right "OK")] (enableOutput 1)
  51
  52 testDisableOutput = test_ [("disableoutput 1", Right "OK")] (disableOutput 1)
  53
  54 testOutputs =
  55     test [("outputs", Right $ unlines ["outputid: 0"
  56                                       ,"outputname: SoundCard0"
  57                                       ,"outputenabled: 1"
  58                                       ,"outputid: 1"
  59                                       ,"outputname: SoundCard1"
  60                                       ,"outputenabled: 0"
  61                                       ,"OK"])]
  62          (Right [Device { dOutputID = 0
  63                         , dOutputName = "SoundCard0"
  64                         , dOutputEnabled = True }
  65                 ,Device { dOutputID = 1
  66                         , dOutputName = "SoundCard1"
  67                         , dOutputEnabled = False }])
  68          outputs
  69
  70 testUpdate0 = test_ [("update", Right "updating_db: 1\nOK")] (update [])
  71
  72 testUpdate1 =
  73     test_ [("update \"foo\"", Right "updating_db: 1\nOK")]
  74           (update ["foo"])
  75
  76 testUpdateMany =
  77     test_ [("command_list_begin\nupdate \"foo\"\nupdate \"bar\"\n\
  78             \command_list_end", Right "updating_db: 1\nOK")]
  79           (update ["foo","bar"])
  80
  81 --
  82 -- Database commands
  83 --
  84
  85 testLsInfo =
  86     test [("lsinfo \"\"", Right "directory: Foo\ndirectory: Bar\nOK")]
  87          (Right [Left "Bar", Left "Foo"])
  88          (lsInfo "")
  89
  90 --
  91 -- Playlist commands
  92 --
  93
  94 testAdd =
  95     test [("add \"foo\"", Right "OK"),
  96           ("listall \"foo\"", Right "file: Foo\nfile: Bar\nOK")]
  97          (Right ["Foo", "Bar"])
  98          (add "" "foo")
  99
 100 testAdd_ = test_ [("add \"foo\"", Right "OK")] (add_ "" "foo")
 101
 102 testClear = test_ [("playlistclear \"foo\"", Right "OK")] (clear "foo")
 103
 104 --
 105 -- Playback commands
 106 --
 107
 108 testPlay = test_ [("play", Right "OK")] (play Nothing)
 109
 110 testStop = test_ [("stop", Right "OK")] stop
 111
 112 --
 113 -- Miscellaneous commands
 114 --
 115
 116 testCommands =
 117     test [("commands", Right "command: foo\ncommand: bar")]
 118          (Right ["foo", "bar"])
 119          commands
 120
 121 testNotCommands =
 122     test [("notcommands", Right "command: foo\ncommand: bar")]
 123          (Right ["foo", "bar"])
 124          notCommands
 125
 126 testTagTypes =
 127     test [("tagtypes", Right "tagtype: foo\ntagtype: bar")]
 128          (Right ["foo", "bar"])
 129          tagTypes
 130
 131 testUrlHandlers =
 132     test [("urlhandlers", Right "urlhandler: foo\nurlhandler: bar")]
 133          (Right ["foo", "bar"])
 134          urlHandlers
 135
 136 testPing = test_ [("ping", Right "OK")] ping
 137
 138 --
 139 -- Extensions\/shortcuts
 140 --