diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,4 +1,11 @@ -* v0.6.0, 2011-03-31 +* v0.7.0, 2011-11-22 + - Several fixes to the test harness (Simon Hengel) + - Fixed issue with the (<$>) operator (Simon Hengel) + - Type safe handling of song IDs (Simon Hengel) + - Check MPD version on connect (now depends on MPD >= 0.15) (Simon Hengel) + - Compatibility with GHC 7.2 (Daniel Wagner) + +* v0.6.0, 2011-04-01 - Reverted some changes from 0.5.0 that caused problems, most notably the parser improvements have been removed for now. - Support for GHC 7 @@ -19,7 +26,7 @@ - The version of the MPD server is available via `getVersion' - Added support for connecting via unix sockets -* v0.4.1, 2010-08-31 +* v0.4.2, 2010-08-31 - Only depend on QuickCheck when building the test target * v0.4.1, 2010-03-26 diff --git a/Network/MPD/Commands.hs b/Network/MPD/Commands.hs --- a/Network/MPD/Commands.hs +++ b/Network/MPD/Commands.hs @@ -163,7 +163,7 @@ play _ = getResponse_ "play" -- | Play a file with given id. -playId :: MonadMPD m => Int -> m () +playId :: MonadMPD m => Id -> m () playId id' = getResponse_ ("playid" <$> id') -- | Play the previous song. @@ -175,7 +175,7 @@ seek pos time = getResponse_ ("seek" <$> pos <++> time) -- | Seek to some point in a song (id version) -seekId :: MonadMPD m => Int -> Seconds -> m () +seekId :: MonadMPD m => Id -> Seconds -> m () seekId id' time = getResponse_ ("seekid" <$> id' <++> time) -- | Stop playing. @@ -189,8 +189,8 @@ -- This might do better to throw an exception than silently return 0. -- | Like 'add', but returns a playlist id. addId :: MonadMPD m => Path -> Maybe Integer -- ^ Optional playlist position - -> m Int -addId p pos = liftM (parse parseNum id 0 . snd . head . toAssocList) + -> m Id +addId p pos = liftM (parse parseNum Id (Id 0) . snd . head . toAssocList) $ getResponse1 ("addid" <$> p <++> pos) -- | Like 'add_' but returns a list of the files added. @@ -210,7 +210,7 @@ delete pos = getResponse_ ("delete" <$> pos) -- | Remove a song from the current playlist. -deleteId :: MonadMPD m => Int -> m () +deleteId :: MonadMPD m => Id -> m () deleteId id' = getResponse_ ("deleteid" <$> id') -- | Move a song to a given position in the current playlist. @@ -219,7 +219,7 @@ -- | Move a song from (songid) to (playlist index) in the playlist. If to is -- negative, it is relative to the current song in the playlist (if there is one). -moveId :: MonadMPD m => Int -> Int -> m () +moveId :: MonadMPD m => Id -> Int -> m () moveId id' to = getResponse_ ("moveid" <$> id' <++> to) -- | Retrieve file paths and positions of songs in the current playlist. @@ -243,7 +243,7 @@ -- | Displays a list of songs in the playlist. -- If id is specified, only its info is returned. -playlistId :: MonadMPD m => Maybe Int -> m [Song] +playlistId :: MonadMPD m => Maybe Id -> m [Song] playlistId id' = takeSongs =<< getResponse ("playlistinfo" <$> id') -- | Search case-insensitively with partial matches for songs in the @@ -257,13 +257,13 @@ plChanges version = takeSongs =<< getResponse ("plchanges" <$> version) -- | Like 'plChanges' but only returns positions and ids. -plChangesPosId :: MonadMPD m => Integer -> m [(Int, Int)] +plChangesPosId :: MonadMPD m => Integer -> m [(Int, Id)] plChangesPosId plver = getResponse ("plchangesposid" <$> plver) >>= mapM f . splitGroups [("cpos",id)] . toAssocList where f xs | [("cpos", x), ("Id", y)] <- xs , Just (x', y') <- pair parseNum (x, y) - = return (x', y') + = return (x', Id y') | otherwise = throwError . Unexpected $ show xs -- | Shuffle the playlist. @@ -276,7 +276,7 @@ swap pos1 pos2 = getResponse_ ("swap" <$> pos1 <++> pos2) -- | Swap the positions of two songs (Id version -swapId :: MonadMPD m => Int -> Int -> m () +swapId :: MonadMPD m => Id -> Id -> m () swapId id1 id2 = getResponse_ ("swapid" <$> id1 <++> id2) -- diff --git a/Network/MPD/Commands/Arg.hs b/Network/MPD/Commands/Arg.hs --- a/Network/MPD/Commands/Arg.hs +++ b/Network/MPD/Commands/Arg.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} -- | Module : Network.MPD.Commands.Arg -- Copyright : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010 @@ -41,7 +41,7 @@ -- to hand to getResponse. infix 2 <$> (<$>) :: (MPDArg a) => String -> a -> String -x <$> y = x ++ " " ++ unwords (filter (not . null) y') +x <$> y = unwords $ x : filter (not . null) y' where Args y' = prep y instance MPDArg Args where prep = id diff --git a/Network/MPD/Commands/Parse.hs b/Network/MPD/Commands/Parse.hs --- a/Network/MPD/Commands/Parse.hs +++ b/Network/MPD/Commands/Parse.hs @@ -70,10 +70,8 @@ return s { sgLastModified = parseIso8601 v } f s ("Time", v) = return s { sgLength = fromMaybe 0 $ parseNum v } - -- We prefer Id... f s ("Id", v) = - return $ parse parseNum (\v' -> s { sgIndex = Just v' }) s v - -- .. but will make due with Pos + return $ parse parseNum (\v' -> s { sgId = Just $ Id v' }) s v f s ("Pos", v) = maybe (return $ parse parseNum (\v' -> s { sgIndex = Just v' }) s v) @@ -123,7 +121,7 @@ f a ("song", x) = return $ parse parseNum (\x' -> a { stSongPos = Just x' }) a x f a ("songid", x) - = return $ parse parseNum (\x' -> a { stSongID = Just x' }) a x + = return $ parse parseNum (\x' -> a { stSongID = Just $ Id x' }) a x f a ("time", x) = return $ parse time (\x' -> a { stTime = x' }) a x f a ("elapsed", x) @@ -143,7 +141,7 @@ f a ("nextsong", x) = return $ parse parseNum (\x' -> a { stNextSongPos = Just x' }) a x f a ("nextsongid", x) - = return $ parse parseNum (\x' -> a { stNextSongID = Just x' }) a x + = return $ parse parseNum (\x' -> a { stNextSongID = Just $ Id x' }) a x f _ x = fail $ show x diff --git a/Network/MPD/Commands/Types.hs b/Network/MPD/Commands/Types.hs --- a/Network/MPD/Commands/Types.hs +++ b/Network/MPD/Commands/Types.hs @@ -27,12 +27,27 @@ -- | Available metadata types\/scope modifiers, used for searching the -- database for entries with certain metadata values. -data Metadata = Artist | ArtistSort | Album | AlbumArtist - | AlbumArtistSort | Title | Track | Name | Genre - | Date | Composer | Performer | Comment | Disc - | MUSICBRAINZ_ARTISTID | MUSICBRAINZ_ALBUMID - | MUSICBRAINZ_ALBUMARTISTID | MUSICBRAINZ_TRACKID - deriving (Eq, Enum, Ord, Show) +data Metadata = Artist + -- NOTE: The commented constructors are not yet handled by the + -- parser. If you uncomment them, some test will fail. + -- | ArtistSort + | Album + -- | AlbumArtist + -- | AlbumArtistSort + | Title + | Track + | Name + | Genre + | Date + | Composer + | Performer + -- | Comment + | Disc + | MUSICBRAINZ_ARTISTID + -- | MUSICBRAINZ_ALBUMID + -- | MUSICBRAINZ_ALBUMARTISTID + | MUSICBRAINZ_TRACKID + deriving (Eq, Enum, Ord, Bounded, Show) instance MPDArg Metadata @@ -115,10 +130,18 @@ , sgLastModified :: Maybe UTCTime -- | Length of the song in seconds , sgLength :: Seconds - -- | Id (preferred) or position in playlist + -- | Id in playlist + , sgId :: Maybe Id + -- | Position in playlist , sgIndex :: Maybe Int } deriving (Eq, Show) +newtype Id = Id Int + deriving (Eq, Show) + +instance (MPDArg Id) where + prep (Id x) = prep x + -- | Get list of specific tag type sgGetTag :: Metadata -> Song -> Maybe [String] sgGetTag meta s = M.lookup meta $ sgTags s @@ -130,7 +153,7 @@ defaultSong :: Song defaultSong = Song { sgFilePath = "", sgTags = M.empty, sgLastModified = Nothing - , sgLength = 0, sgIndex = Nothing } + , sgLength = 0, sgId = Nothing, sgIndex = Nothing } -- | Container for database statistics. data Stats = @@ -165,11 +188,11 @@ -- | Current song's position in the playlist. , stSongPos :: Maybe Int -- | Current song's playlist ID. - , stSongID :: Maybe Int + , stSongID :: Maybe Id -- | Next song's position in the playlist. , stNextSongPos :: Maybe Int -- | Next song's playlist ID. - , stNextSongID :: Maybe Int + , stNextSongID :: Maybe Id -- | Time elapsed\/total time. , stTime :: (Double, Seconds) -- | Bitrate (in kilobytes per second) of playing song (if any). diff --git a/Network/MPD/Core.hs b/Network/MPD/Core.hs --- a/Network/MPD/Core.hs +++ b/Network/MPD/Core.hs @@ -36,6 +36,7 @@ import System.IO (Handle, hPutStrLn, hReady, hClose, hFlush) import System.IO.Error (isEOFError) import qualified System.IO.UTF8 as U +import Text.Printf (printf) -- -- Data types. @@ -113,14 +114,26 @@ checkConn = do [msg] <- lines <$> send "" if isPrefixOf "OK MPD" msg - then do - MPD $ maybe (throwError $ Custom "Couldn't determine MPD version") - (\v -> modify (\st -> st { stVersion = v })) - (parseVersion msg) - return True - else return False + then MPD $ checkVersion $ parseVersion msg + else return False + checkVersion Nothing = throwError $ Custom "Couldn't determine MPD version" + checkVersion (Just version) + | version < requiredVersion = + throwError $ Custom $ printf + "MPD %s is not supported, upgrade to MPD %s or above!" + (formatVersion version) (formatVersion requiredVersion) + | otherwise = do + modify (\st -> st { stVersion = version }) + return True + where + requiredVersion = (0, 15, 0) + parseVersion = parseTriple '.' parseNum . dropWhile (not . isDigit) + + formatVersion :: (Int, Int, Int) -> String + formatVersion (x, y, z) = printf "%d.%d.%d" x y z + mpdClose :: MPD () mpdClose = diff --git a/Network/MPD/Utils.hs b/Network/MPD/Utils.hs --- a/Network/MPD/Utils.hs +++ b/Network/MPD/Utils.hs @@ -7,14 +7,14 @@ -- Utilities. module Network.MPD.Utils ( - parseDate, parseIso8601, parseNum, parseFrac, + parseDate, parseIso8601, formatIso8601, parseNum, parseFrac, parseBool, showBool, breakChar, parseTriple, toAssoc, toAssocList, splitGroups ) where import Data.Char (isDigit) import Data.Maybe (fromMaybe) -import Data.Time.Format (ParseTime, parseTime) +import Data.Time.Format (ParseTime, parseTime, FormatTime, formatTime) import System.Locale (defaultTimeLocale) -- Break a string by character, removing the separator. @@ -30,7 +30,13 @@ -- Parse date in iso 8601 format parseIso8601 :: (ParseTime t) => String -> Maybe t -parseIso8601 = parseTime defaultTimeLocale "%FT%TZ" +parseIso8601 = parseTime defaultTimeLocale iso8601Format + +formatIso8601 :: FormatTime t => t -> String +formatIso8601 = formatTime defaultTimeLocale iso8601Format + +iso8601Format :: String +iso8601Format = "%FT%TZ" -- Parse a positive or negative integer value, returning 'Nothing' on failure. parseNum :: (Read a, Integral a) => String -> Maybe a diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -59,25 +59,14 @@ ## Development -### Branches - -* `master`: - Stable branch, should never break. -* `trunk`: - Development branch, turns into master -* `integrate`: - New, untested stuff - -Develop against `trunk` unless the patch is fixing a problem known to exist in `master`. - ### Getting started Create the clone thus: -`git clone git://github.com/joachifm/libmpd-haskell.git trunk` +`git clone git://github.com/joachifm/libmpd-haskell.git master` To pull in new changes from upstream, use: -`git pull origin trunk` +`git pull origin master` To set up GIT hooks, see `hooks/README` in the source distribution. @@ -107,8 +96,6 @@ file and note why it is necessary to use it. This does not apply to the test harness -* Branches are cheap, use them - ### Submitting patches To submit a patch, use `git format-patch` and email the resulting file(s) to one of the developers or upload it to the [bug tracker]. @@ -184,3 +171,7 @@ Daniel Schoepe \ Andrzej Rybczak \ + +Simon Hengel \ + +Daniel Wagner \ diff --git a/libmpd.cabal b/libmpd.cabal --- a/libmpd.cabal +++ b/libmpd.cabal @@ -1,5 +1,5 @@ Name: libmpd -Version: 0.6.0 +Version: 0.7.0 License: LGPL License-file: LICENSE Copyright: Ben Sinclair 2005-2009, Joachim Fasting 2010, 2011 @@ -15,9 +15,11 @@ Tested-With: GHC == 7.0.2 Build-Type: Simple Cabal-Version: >= 1.6 -Extra-Source-Files: README.md NEWS tests/Properties.hs - tests/Commands.hs tests/Main.hs tests/Displayable.hs - tests/run-tests.lhs tests/coverage.lhs +Extra-Source-Files: README.md NEWS + tests/Arbitrary.hs tests/Commands.hs + tests/Displayable.hs tests/Properties.hs + tests/StringConn.hs tests/Main.hs + tests/coverage.lhs tests/run-tests.lhs flag test Description: Build test driver @@ -39,7 +41,7 @@ utf8-string >= 0.3.1 && < 0.4, old-locale >= 1.0 && < 2.0, time >= 1.1 && < 2.0, - containers >= 0.4 && < 0.5 + containers >= 0.3 && < 0.5 Exposed-Modules: Network.MPD, Network.MPD.Commands.Extensions, Network.MPD.Core Other-Modules: Network.MPD.Core.Class, @@ -63,8 +65,8 @@ Build-Depends: base ==4.*, network, mtl, filepath, utf8-string -- Dependencies that are only required by the test-suite: if flag(test) - Build-Depends: QuickCheck ==2.1.*, time, containers - ghc-options: -Wall -Werror -fno-warn-warnings-deprecations + Build-Depends: QuickCheck >= 2.1, time, containers + ghc-options: -Wall -fno-warn-warnings-deprecations -fno-warn-type-defaults if flag(coverage) diff --git a/tests/Arbitrary.hs b/tests/Arbitrary.hs new file mode 100644 --- /dev/null +++ b/tests/Arbitrary.hs @@ -0,0 +1,116 @@ +{-# OPTIONS_GHC -Wwarn -fno-warn-orphans -fno-warn-missing-methods -XFlexibleInstances #-} + +-- | This module contains Arbitrary instances for various types. + +module Arbitrary + ( AssocString(..) + , BoolString(..) + , YearString(..) + , DateString(..) + , positive, field + ) where + +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (liftM2, liftM3, replicateM) +import Data.Char (isSpace) +import Data.List (intersperse) +import qualified Data.Map as M +import Data.Time +import Test.QuickCheck + +import Network.MPD.Commands.Types + +-- No longer provided by QuickCheck 2 +two :: Monad m => m a -> m (a, a) +two m = liftM2 (,) m m + +three :: Monad m => m a -> m (a, a, a) +three m = liftM3 (,,) m m m + +-- Generate a positive number. +positive :: (Arbitrary a, Num a) => Gen a +positive = abs <$> arbitrary + +possibly :: Gen a -> Gen (Maybe a) +possibly m = arbitrary >>= bool (Just <$> m) (return Nothing) + where bool thenE elseE b = if b then thenE else elseE + +-- MPD fields can't contain newlines and the parser skips initial spaces. +field :: Gen String +field = (filter (/= '\n') . dropWhile isSpace) <$> arbitrary + +-- Orphan instances for built-in types +instance Arbitrary (M.Map Metadata [String]) where + arbitrary = do + size <- choose (1, 1000) + vals <- replicateM size (listOf1 field) + keys <- replicateM size arbitrary + return $ M.fromList (zip keys vals) + +instance Arbitrary Day where + arbitrary = ModifiedJulianDay <$> arbitrary + +instance Arbitrary DiffTime where + arbitrary = secondsToDiffTime <$> positive + +instance Arbitrary UTCTime where + arbitrary = UTCTime <$> arbitrary <*> arbitrary + +-- an assoc. string is a string of the form "key: value", followed by +-- the key and value separately. +data AssocString = AS String String String + +instance Show AssocString where + show (AS str _ _) = str + +instance Arbitrary AssocString where + arbitrary = do + key <- filter (/= ':') <$> arbitrary + val <- dropWhile (== ' ') <$> arbitrary + return $ AS (key ++ ": " ++ val) key val + +newtype BoolString = BS String + deriving Show + +instance Arbitrary BoolString where + arbitrary = BS `fmap` elements ["1", "0"] + +-- Simple date representation, like "2004" and "1998". +newtype YearString = YS String + deriving Show + +instance Arbitrary YearString where + arbitrary = YS . show <$> (positive :: Gen Integer) + +-- Complex date representations, like "2004-20-30". +newtype DateString = DS String + deriving Show + +instance Arbitrary DateString where + arbitrary = do + (y,m,d) <- three (positive :: Gen Integer) + return . DS . concat . intersperse "-" $ map show [y,m,d] + +instance Arbitrary Count where + arbitrary = liftM2 Count arbitrary arbitrary + +instance Arbitrary Device where + arbitrary = liftM3 Device arbitrary field arbitrary + +instance Arbitrary Id where + arbitrary = Id <$> arbitrary + +instance Arbitrary Song where + arbitrary = Song <$> field + <*> arbitrary + <*> possibly arbitrary + <*> positive + <*> possibly arbitrary + <*> possibly positive + +instance Arbitrary Stats where + arbitrary = Stats <$> positive <*> positive <*> positive <*> positive + <*> positive <*> positive <*> positive + +instance Arbitrary Metadata where + arbitrary = elements [minBound .. maxBound] diff --git a/tests/Commands.hs b/tests/Commands.hs --- a/tests/Commands.hs +++ b/tests/Commands.hs @@ -310,7 +310,7 @@ testAddId = test [("addid \"dir/Foo-Bar.ogg\"", Right "Id: 20\nOK")] - (Right 20) + (Right $ Id 20) (addId "dir/Foo-Bar.ogg" Nothing) testClearPlaylist = test_ [("playlistclear \"foo\"", Right "OK")] diff --git a/tests/Displayable.hs b/tests/Displayable.hs --- a/tests/Displayable.hs +++ b/tests/Displayable.hs @@ -30,10 +30,14 @@ empty = defaultSong display s = let fs = concatMap toF . M.toList $ sgTags s - idx = maybe [] (\n -> ["Id: " ++ show n]) (sgIndex s) + id_ = maybe [] (\(Id n) -> ["Id: " ++ show n]) (sgId s) + idx = maybe [] (\n -> ["Pos: " ++ show n]) (sgIndex s) + lastModified = maybe [] (return . ("Last-Modified: " ++) . formatIso8601) (sgLastModified s) in unlines $ ["file: " ++ sgFilePath s] + ++ ["Time: " ++ (show . sgLength) s] ++ fs - ++ ["Last-Modified: " ++ show (sgLastModified s)] + ++ lastModified + ++ id_ ++ idx where toF (k, vs) = map (toF' k) vs diff --git a/tests/Properties.hs b/tests/Properties.hs --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -11,10 +11,13 @@ import Control.Monad import Data.List import Data.Maybe +import qualified Data.Map as M +import Data.Time import System.Environment import Text.Printf import Test.QuickCheck + main :: IO () main = do n <- (maybe 100 read . listToMaybe) `liftM` getArgs @@ -34,6 +37,7 @@ mytest prop_parseDate_simple) ,("parseDate / complex", mytest prop_parseDate_complex) + ,("parseIso8601", mytest prop_parseIso8601) ,("parseCount", mytest prop_parseCount) ,("parseOutputs", mytest prop_parseOutputs) ,("parseSong", mytest prop_parseSong) @@ -91,6 +95,12 @@ -- Parsers -------------------------------------------------------------------------- +-- This property also ensures, that (instance Arbitrary UTCTime) is sound. +-- Indeed, a bug in the instance declaration was the primary motivation to add +-- this property. +prop_parseIso8601 :: UTCTime -> Bool +prop_parseIso8601 t = Just t == (parseIso8601 . formatIso8601) t + prop_parseCount :: Count -> Bool prop_parseCount c = Right c == (parseCount . lines $ display c) @@ -99,7 +109,12 @@ Right ds == (parseOutputs . lines $ concatMap display ds) prop_parseSong :: Song -> Bool -prop_parseSong s = Right s == (parseSong . toAssocList . lines $ display s) +prop_parseSong s = Right (sortTags s) == sortTags `fmap` (parseSong . toAssocList . lines $ display s) + where + -- We consider lists of tag values equal if they contain the same elements. + -- To ensure that two lists with the same elements are equal, we bring the + -- elements in a deterministic order. + sortTags song = song {sgTags = M.map sort $ sgTags song} prop_parseStats :: Stats -> Bool prop_parseStats s = Right s == (parseStats . lines $ display s) diff --git a/tests/StringConn.hs b/tests/StringConn.hs new file mode 100644 --- /dev/null +++ b/tests/StringConn.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} +{-# OPTIONS_GHC -Wwarn #-} + +-- | Module : StringConn +-- Copyright : (c) Ben Sinclair 2005-2009 +-- License : LGPL (see LICENSE) +-- Maintainer : bsinclai@turing.une.edu.au +-- Stability : alpha +-- +-- A testing scaffold for MPD commands + +module StringConn where + +import Prelude hiding (exp) +import Control.Monad.Error +import Control.Monad.Identity +import Control.Monad.Reader +import Control.Monad.State +import Network.MPD.Core + +-- | An expected request. +type Expect = String + +data StringMPDError + = TooManyRequests + | UnexpectedRequest Expect String + deriving (Show, Eq) + +data Result a + = Ok + | BadResult (Response a) (Response a) -- expected, then actual + | BadRequest StringMPDError + deriving (Show, Eq) + +newtype MatchError = MErr (Either StringMPDError MPDError) +instance Error MatchError where + strMsg = MErr . Right . strMsg + +newtype StringMPD a = + SMPD { runSMPD :: ErrorT MatchError + (StateT [(Expect, Response String)] + (ReaderT Password Identity)) a + } deriving (Functor, Monad) + +instance MonadError MPDError StringMPD where + throwError = SMPD . throwError . MErr . Right + catchError m f = SMPD $ catchError (runSMPD m) handler + where + handler err@(MErr (Left _)) = throwError err + handler (MErr (Right err)) = runSMPD (f err) + +instance MonadMPD StringMPD where + open = return () + close = return () + getPassword = SMPD ask + send request = + SMPD $ do + ~pairs@((expected_request,response):rest) <- get + when (null pairs) + (throwError . MErr $ Left TooManyRequests) + when (expected_request /= request) + (throwError . MErr . Left + $ UnexpectedRequest expected_request request) + put rest + either (throwError . MErr . Right) return response + +-- | Run an action against a set of expected requests and responses, +-- and an expected result. The result is Nothing if everything matched +-- what was expected. If anything differed the result of the +-- computation is returned along with pairs of expected and received +-- requests. +testMPD :: (Eq a) + => [(Expect, Response String)] -- ^ The expected requests and their + -- ^ corresponding responses. + -> Response a -- ^ The expected final result. + -> Password -- ^ A password to be supplied. + -> StringMPD a -- ^ The MPD action to run. + -> Result a +testMPD pairs expected passwd m = + let result = runIdentity + $ runReaderT (evalStateT (runErrorT $ runSMPD m) pairs) passwd + in case result of + Right r + | Right r == expected -> Ok + | otherwise -> BadResult expected (Right r) + Left (MErr (Right r)) + | Left r == expected -> Ok + | otherwise -> BadResult expected (Left r) + Left (MErr (Left e)) -> BadRequest e