Network/MPD/StringConn.hs

   1 {-
   2     libmpd for Haskell, an MPD client library.
   3     Copyright (C) 2005-2007  Ben Sinclair <bsinclai@turing.une.edu.au>
   4
   5     This library is free software; you can redistribute it and/or
   6     modify it under the terms of the GNU Lesser General Public
   7     License as published by the Free Software Foundation; either
   8     version 2.1 of the License, or (at your option) any later version.
   9
  10     This library is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13     Lesser General Public License for more details.
  14
  15     You should have received a copy of the GNU Lesser General Public
  16     License along with this library; if not, write to the Free Software
  17     Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  18 -}
  19
  20 -- | Module    : Network.MPD.StringConn
  21 -- Copyright   : (c) Ben Sinclair 2005-2007
  22 -- License     : LGPL
  23 -- Maintainer  : bsinclai@turing.une.edu.au
  24 -- Stability   : alpha
  25 -- Portability : Haskell 98
  26 --
  27 -- Connection over a network socket.
  28
  29 module Network.MPD.StringConn (testMPD) where
  30
  31 import Control.Monad (liftM)
  32 import Network.MPD.Prim
  33 import Data.IORef
  34
  35 -- | Run an action against a set of expected requests and responses,
  36 -- and an expected result. The result is Nothing if everything matched
  37 -- what was expected. If anything differed the result of the
  38 -- computation is returned along with pairs of expected and received
  39 -- requests.
  40 testMPD :: (Eq a)
  41         => [(String, Response String)] -- ^ The expected requests and their
  42                                        -- ^ corresponding responses.
  43         -> Response a                  -- ^ The expected result.
  44         -> IO (Maybe String)           -- ^ An action that supplies passwords.
  45         -> MPD a                       -- ^ The MPD action to run.
  46         -> IO (Maybe (Response a, [(String,String)]))
  47 testMPD pairs expt getpw m = do
  48     mismatchesRef <- newIORef ([] :: [(String, String)])
  49     expectsRef    <- newIORef $ concatMap (\(x,y) -> [Left x,Right y]) pairs
  50     let open'  = return ()
  51         close' = return ()
  52         put'   = put expectsRef mismatchesRef
  53         get'   = get expectsRef
  54     result <- runMPD m $ Conn open' close' put' get' getpw
  55     mismatches <- liftM reverse $ readIORef mismatchesRef
  56     return $ if null mismatches && result == expt
  57              then Nothing else Just (result, mismatches)
  58
  59 put :: IORef [Either String a]  -- An alternating list of expected
  60                                 -- requests and responses to give.
  61     -> IORef [(String, String)] -- An initially empty list of
  62                                 -- mismatches between expected and
  63                                 -- actual requests.
  64     -> String
  65     -> IO (Response ())
  66 put expsR mmsR x =
  67     let addMismatch x' = modifyIORef mmsR ((x',x):) >> return (Left NoMPD)
  68     in do
  69         ys <- readIORef expsR
  70         case ys of
  71             (Left y:_) | y == x ->
  72                            modifyIORef expsR (drop 1) >> return (Right ())
  73                        | otherwise -> addMismatch y
  74             _ -> addMismatch ""
  75
  76 get :: IORef [Either a (Response String)]
  77     -> IO (Response String)
  78 get expsR = do
  79     xs <- readIORef expsR
  80     case xs of
  81         (Right x:_) -> modifyIORef expsR (drop 1) >> return x
  82         _           -> return $ Left NoMPD
  83