libmpd 0.6.0 → 0.7.0

raw patch · 14 files changed

+328/−64 lines, 14 filesdep ~QuickCheckdep ~basedep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, base, containers

API changes (from Hackage documentation)

Files

• NEWS +9/−2
• Network/MPD/Commands.hs +10/−10
• Network/MPD/Commands/Arg.hs +2/−2
• Network/MPD/Commands/Parse.hs +3/−5
• Network/MPD/Commands/Types.hs +33/−10
• Network/MPD/Core.hs +19/−6
• Network/MPD/Utils.hs +9/−3
• README.md +6/−15
• libmpd.cabal +9/−7
• tests/Arbitrary.hs +116/−0
• tests/Commands.hs +1/−1
• tests/Displayable.hs +6/−2
• tests/Properties.hs +16/−1
• tests/StringConn.hs +89/−0

@@ -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

@@ -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)  --

@@ -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

@@ -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 

@@ -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).

@@ -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 =

@@ -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

@@ -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 \<daniel.schoepe@googlemail.com\>  Andrzej Rybczak \<electricityispower@gmail.com\>++Simon Hengel \<simon.hengel@wiktory.org\>++Daniel Wagner \<daniel@wagner-home.com\>

@@ -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)

@@ -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]

@@ -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")]

@@ -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

@@ -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)

@@ -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