tests/StringConn.hs

   1 -- | Module    : StringConn
   2 -- Copyright   : (c) Ben Sinclair 2005-2008
   3 -- License     : LGPL (see LICENSE)
   4 -- Maintainer  : bsinclai@turing.une.edu.au
   5 -- Stability   : alpha
   6 -- Portability : Haskell 98
   7 --
   8 -- A testing scaffold for MPD commands
   9
  10 module StringConn (Expect, Result(..), testMPD) where
  11
  12 import Control.Monad (liftM)
  13 import Prelude hiding (exp)
  14 import Network.MPD.Core
  15 import Data.IORef
  16
  17 -- | An expected request.
  18 type Expect = String
  19
  20 data Result a = Ok | Failure (Response a) [(Expect,String)]
  21                 deriving Show
  22
  23 -- | Run an action against a set of expected requests and responses,
  24 -- and an expected result. The result is Nothing if everything matched
  25 -- what was expected. If anything differed the result of the
  26 -- computation is returned along with pairs of expected and received
  27 -- requests.
  28 testMPD :: (Eq a)
  29         => [(Expect, Response String)] -- ^ The expected requests and their
  30                                        -- ^ corresponding responses.
  31         -> Response a                  -- ^ The expected result.
  32         -> IO (Maybe String)           -- ^ An action that supplies passwords.
  33         -> MPD a                       -- ^ The MPD action to run.
  34         -> IO (Result a)
  35 testMPD pairs expected getpw m = do
  36     expectsRef    <- newIORef pairs
  37     mismatchesRef <- newIORef ([] :: [(Expect, String)])
  38     let open'  = return ()
  39         close' = return ()
  40         send'  = send expectsRef mismatchesRef
  41     result <- runMPD m $ Conn open' close' send' getpw
  42     mismatches <- liftM reverse $ readIORef mismatchesRef
  43     return $ if null mismatches && result == expected
  44              then Ok
  45              else Failure result mismatches
  46
  47 send :: IORef [(Expect, Response String)] -- Expected requests and their
  48                                           -- responses.
  49      -> IORef [(Expect, String)]          -- An initially empty list of
  50                                           -- mismatches between expected and
  51                                           -- actual requests.
  52      -> String
  53      -> IO (Response String)
  54 send expsR mmsR str = do
  55     xs <- readIORef expsR
  56     case xs of
  57         ((exp,resp):_) | exp == str -> modifyIORef expsR (drop 1) >> return resp
  58                        | otherwise  -> addMismatch exp
  59         [] -> addMismatch ""
  60     where
  61         addMismatch exp = modifyIORef mmsR ((exp,str):) >> return (Left NoMPD)