libmpd 0.8.0 → 0.8.0.1
raw patch · 14 files changed
+15/−1041 lines, 14 filesdep ~bytestringdep ~containersnew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: bytestring, containers
API changes (from Hackage documentation)
Files
- Network/MPD.hs +3/−3
- Network/MPD/Core.hs +6/−6
- Network/MPD/Core/Error.hs +2/−2
- README.md +1/−1
- libmpd.cabal +3/−13
- tests/Arbitrary.hs +0/−135
- tests/CommandSpec.hs +0/−435
- tests/Defaults.hs +0/−21
- tests/EnvSpec.hs +0/−80
- tests/ParserSpec.hs +0/−67
- tests/StringConn.hs +0/−96
- tests/TestUtil.hs +0/−7
- tests/Unparse.hs +0/−75
- tests/UtilSpec.hs +0/−100
Network/MPD.hs view
@@ -25,8 +25,8 @@ #endif ) where -import Prelude hiding (catch)-import Control.Exception+import Prelude+import qualified Control.Exception as E import Network.MPD.Commands import Network.MPD.Core @@ -76,7 +76,7 @@ getEnvDefault :: String -> String -> IO String getEnvDefault x dflt =- catch (getEnv x) (\e -> if isDoesNotExistError e+ E.catch (getEnv x) (\e -> if isDoesNotExistError e then return dflt else ioError e) -- Break a string by character, removing the separator.
Network/MPD/Core.hs view
@@ -27,7 +27,7 @@ import Data.Char (isDigit) import Control.Applicative (Applicative(..), (<$>), (<*))-import Control.Exception hiding (handle)+import qualified Control.Exception as E import Control.Monad (ap, unless) import Control.Monad.Error (ErrorT(..), MonadError(..)) import Control.Monad.Reader (ReaderT(..), ask)@@ -40,7 +40,7 @@ import Text.Printf (printf) import qualified Prelude-import Prelude hiding (break, catch, drop, dropWhile, read)+import Prelude hiding (break, drop, dropWhile, read) import Data.ByteString.Char8 (ByteString, isPrefixOf, break, drop, dropWhile) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.UTF8 as UTF8@@ -113,10 +113,10 @@ where safeConnectTo host@('/':_) _ = (Just <$> connectTo "" (UnixSocket host))- `catch` (\(_ :: SomeException) -> return Nothing)+ `E.catch` (\(_ :: E.SomeException) -> return Nothing) safeConnectTo host port = (Just <$> connectTo host (PortNumber $ fromInteger port))- `catch` (\(_ :: SomeException) -> return Nothing)+ `E.catch` (\(_ :: E.SomeException) -> return Nothing) checkConn = do [msg] <- send "" if "OK MPD" `isPrefixOf` msg@@ -149,7 +149,7 @@ where sendClose handle = (hPutStrLn handle "close" >> hReady handle >> hClose handle)- `catch` whenEOF (return ())+ `E.catch` whenEOF (return ()) whenEOF result err | isEOFError err = result@@ -166,7 +166,7 @@ go handle = do unless (null str) $ liftIO $ U.hPutStrLn handle str >> hFlush handle- liftIO ((Right <$> getLines handle []) `catch` (return . Left))+ liftIO ((Right <$> getLines handle []) `E.catch` (return . Left)) >>= either (\err -> if isEOFError err then modify (\st -> st { stHandle = Nothing }) >> throwError TimedOut
Network/MPD/Core/Error.hs view
@@ -10,7 +10,7 @@ module Network.MPD.Core.Error where -import Control.Exception+import qualified Control.Exception as E import Control.Monad.Error (Error(..)) import Data.Typeable @@ -26,7 +26,7 @@ -- server deriving (Eq, Typeable) -instance Exception MPDError+instance E.Exception MPDError instance Show MPDError where show NoMPD = "Could not connect to MPD"
README.md view
@@ -45,7 +45,7 @@ > :set -XOverloadedStrings > import Network.MPD > withMPD $ lsInfo ""- Right [LsDirectory "Tool", LsDirectory "Tom Waits",...]+ Right [Left "Tool", Left "Tom Waits",...] > withMPD $ add "Tom Waits/Big Time" Right ["Tom Waits/Big Time/01 - 16 Shells from a Thirty-Ought-Six.mp3",...]
libmpd.cabal view
@@ -1,5 +1,5 @@ Name: libmpd-Version: 0.8.0+Version: 0.8.0.1 Synopsis: An MPD client library. Description: A client library for MPD, the Music Player Daemon (<http://www.musicpd.org/>).@@ -22,16 +22,6 @@ Extra-Source-Files: README.md NEWS- tests/Arbitrary.hs- tests/CommandSpec.hs- tests/Defaults.hs- tests/EnvSpec.hs- tests/ParserSpec.hs- tests/StringConn.hs- tests/TestUtil.hs- tests/Unparse.hs- tests/UtilSpec.hs- tests/Main.hs Source-Repository head type: git@@ -48,8 +38,8 @@ , utf8-string >= 0.3.1 && < 0.4 , old-locale >= 1.0 && < 2.0 , time >= 1.1 && < 2.0- , containers >= 0.3 && < 0.5- , bytestring == 0.9.*+ , containers >= 0.3 && < 0.6+ , bytestring >= 0.9 && < 0.11 , text == 0.11.* Exposed-Modules:
− tests/Arbitrary.hs
@@ -1,135 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--{-# 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--import Data.ByteString (ByteString)-import qualified Data.ByteString.UTF8 as UTF8--instance Arbitrary ByteString where- arbitrary = UTF8.fromString <$> arbitrary---- 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--fieldBS :: Gen ByteString-fieldBS = UTF8.fromString <$> field---- Orphan instances for built-in types-instance Arbitrary (M.Map Metadata [Value]) where- arbitrary = do- size <- choose (1, 1000)- vals <- replicateM size (listOf1 arbitrary)- keys <- replicateM size arbitrary- return $ M.fromList (zip keys vals)--instance Arbitrary Value where- arbitrary = Value <$> fieldBS--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 ByteString ByteString ByteString--instance Show AssocString where- show (AS str _ _) = UTF8.toString str--instance Arbitrary AssocString where- arbitrary = do- key <- filter (/= ':') <$> arbitrary- val <- dropWhile (== ' ') <$> arbitrary- return $ AS (UTF8.fromString (key ++ ": " ++ val))- (UTF8.fromString key)- (UTF8.fromString val)--newtype BoolString = BS ByteString- deriving Show--instance Arbitrary BoolString where- arbitrary = BS <$> elements ["1", "0"]---- Simple date representation, like "2004" and "1998".-newtype YearString = YS ByteString- deriving Show--instance Arbitrary YearString where- arbitrary = YS . UTF8.fromString . show <$> (positive :: Gen Integer)---- Complex date representations, like "2004-20-30".-newtype DateString = DS ByteString- deriving Show--instance Arbitrary DateString where- arbitrary = do- (y,m,d) <- three (positive :: Gen Integer)- return . DS . UTF8.fromString . 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 <$> arbitrary- <*> arbitrary- <*> possibly arbitrary- <*> positive- <*> possibly arbitrary- <*> possibly positive--instance Arbitrary Path where- arbitrary = Path <$> fieldBS--instance Arbitrary Stats where- arbitrary = Stats <$> positive <*> positive <*> positive <*> positive- <*> positive <*> positive <*> positive--instance Arbitrary Metadata where- arbitrary = elements [minBound .. maxBound]
− tests/CommandSpec.hs
@@ -1,435 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}---- This module provides a way of verifying that the interface to the MPD--- commands is correct. It does so by capturing the data flow between the--- command and a dummy socket, checking the captured data against a set of--- predefined values that are known to be correct. Of course, this does not--- verify that the external behaviour is correct, it's simply a way of--- catching silly mistakes and subtle bugs in the interface itself, without--- having to actually send any requests to a real server.--module CommandSpec (main, spec) where--import Arbitrary ()-import Defaults ()-import StringConn-import TestUtil-import Unparse--import Test.Hspec.Monadic-import Test.Hspec.HUnit ()--import Network.MPD.Commands-import Network.MPD.Commands.Extensions-import Network.MPD.Core (MPDError(..), ACKType(..))--import Prelude hiding (repeat)-import Data.Default (Default(def))--main :: IO ()-main = hspecX spec--spec :: Specs-spec = do- -- * Admin commands- describe "enableOutput" $ do- it "sends an enableoutput command" $ testEnableOutput- - describe "disableOutput" $ do- it "sends an disableoutput command" $ testDisableOutput-- describe "outputs" $ do- it "lists available outputs" $ testOutputs-- describe "update" $ do- it "updates entire collection by default" $ testUpdate0- it "can update single paths" $ testUpdate1- it "can update multiple paths" $ testUpdateMany-- -- * Database commands-- describe "list" $ do- it "returns a list of values for a given metadata type" $ testListAny- it "can constrain listing to entries matching a query" $ testListQuery-- describe "listAll" $ do- it "lists everything" $ testListAll-- describe "lsInfo" $ do- it "lists information" $ testLsInfo-- describe "listAllInfo" $ do- it "lists information" $ testListAllInfo-- describe "count" $ do- it "returns a count of items matching a query" $ testCount-- -- * Playlist commands-- describe "add" $ do- it "adds a url to the current playlist" $ testAdd-- describe "add_" $ do- it "adds a url to current playlist, returning nothing" $ testAdd_-- describe "playlistAdd" $ do- it "adds a url to a stored playlist" $ testPlaylistAdd-- describe "addId" $ do- it "adds a url to a stored playlist, returning the pl index" $ testAddId-- describe "playlistClear" $ do- it "clears a stored playlist" $ testPlaylistClear-- describe "clear" $ do- it "clears current play list" $ testClear-- describe "plChangesPosid" $ do- it "does something ..." $ testPlChangesPosId- it "fails on weird input" $ testPlChangesPosIdWeird-- -- XXX: this is ill-defined- {-- describe "currentSong" $ do- it "can handle cases where playback is stopped" $ testCurrentSong- -}-- describe "playlistDelete" $ do- it "deletes an item from a stored playlist" $ testPlaylistDelete-- describe "load" $ do- it "loads a stored playlist" $ testLoad-- describe "playlistMove" $ do- it "moves an item within a stored playlist" $ testMove2- describe "rm" $ do- it "deletes a stored playlist" $ testRm- describe "rename" $ do- it "renames a stored playlist" $ testRename- describe "save" $ do- it "creates a stored playlist" $ testSave- describe "shuffle" $ do- it "enables shuffle mode" $ testShuffle- describe "listPlaylist" $ do- it "returns a listing of paths in a stored playlist" $ testListPlaylist-- -- * Playback commands-- describe "crossfade" $ do- it "sets crossfade between songs" $ testCrossfade- describe "play" $ do- it "toggles playback" $ testPlay- describe "pause" $ do- it "pauses playback" $ testPause- describe "stop" $ do- it "stops playback" $ testStop- describe "next" $ do- it "starts playback of next song" $ testNext- describe "previous" $ do- it "play previous song" $ testPrevious- describe "random" $ do- it "toggles random playback" $ testRandom- describe "repeat" $ do- it "toggles repeating playback" $ testRepeat- describe "setVolume" $ do- it "sets playback volume" $ testSetVolume- describe "consume" $ do- it "toggles consume mode" $ testConsume- describe "single" $ do- it "toggles single mode" $ testSingle-- -- * Misc- describe "clearError" $ do- it "removes errors" $ testClearError- describe "commands" $ do- it "lists available commands" $ testCommands- describe "notCommands" $ do- it "lists unavailable commands" $ testNotCommands- describe "tagTypes" $ do- it "lists available tag types" $ testTagTypes- describe "urlHandlers" $ do- it "lists available url handlers" $ testUrlHandlers- describe "password" $ do- it "sends a password to the server" $ testPassword- it "gives access to restricted commmands" $ testPasswordSucceeds- it "returns failure on incorrect password" $ testPasswordFails- describe "ping" $ do- it "sends a ping command" $ testPing- describe "stats" $ do- it "gets database stats" $ testStats-- -- * Extensions- - describe "updateId" $ do- it "returns the job id" $ do- testUpdateId0- testUpdateId1- describe "toggle" $ do- it "starts playback if paused" $ testTogglePlay- it "stops playback if playing" $ testToggleStop- describe "addMany" $ do- it "adds multiple paths in one go" $ testAddMany0- it "can also add to stored playlists" $ testAddMany1- describe "volume" $ do- it "adjusts volume relative to current volume" $ testVolume- -cmd_ expect f = cmd expect (Right ()) f -cmd expect resp f = testMPD expect resp "" f `shouldBe` Ok------- Admin commands-----testEnableOutput = cmd_ [("enableoutput 1", Right "OK")] (enableOutput 1)-testDisableOutput = cmd_ [("disableoutput 1", Right "OK")] (disableOutput 1)---- XXX: this should be generalized to arbitrary inputs-testOutputs = do- let obj1 = def { dOutputName = "SoundCard0", dOutputEnabled = True }- obj2 = def { dOutputName = "SoundCard1", dOutputID = 1 }- resp = concatMap unparse [obj1, obj2] ++ "OK"- cmd [("outputs", Right resp)] (Right [obj1, obj2]) outputs--testUpdate0 = cmd_ [("update", Right "updating_db: 1\nOK")] (update [])-testUpdate1 =- cmd_ [("update \"foo\"", Right "updating_db: 1\nOK")] (update ["foo"])--testUpdateMany =- cmd_ [("command_list_begin\nupdate \"foo\"\nupdate \"bar\"\ncommand_list_end", Right "updating_db: 1\nOK")]- (update ["foo","bar"])------- Database commands------- XXX: generalize to arbitrary Metadata values-testListAny = cmd [("list Title", Right "Title: Foo\nTitle: Bar\nOK")]- (Right ["Foo", "Bar"])- (list Title anything)--testListQuery = cmd [("list Title Artist \"Muzz\"", Right "Title: Foo\nOK")]- (Right ["Foo"])- (list Title (Artist =? "Muzz"))--testListAll =- cmd [("listall \"\"", Right "directory: FooBand\n\- \directory: FooBand/album1\n\- \file: FooBand/album1/01 - songA.ogg\n\- \file: FooBand/album1/02 - songB.ogg\nOK")]- (Right ["FooBand/album1/01 - songA.ogg"- ,"FooBand/album1/02 - songB.ogg"])- (listAll "")---- XXX: generalize to arbitrary input-testLsInfo = do- let song = defaultSong "Bar.ogg"- cmd [("lsinfo \"\"", Right $ "directory: Foo\n" ++ unparse song ++ "playlist: Quux\nOK")]- (Right [LsDirectory "Foo", LsSong song, LsPlaylist "Quux"])- (lsInfo "")--testListAllInfo =- cmd [("listallinfo \"\"", Right "directory: Foo\ndirectory: Bar\nOK")]- (Right [LsDirectory "Foo", LsDirectory "Bar"])- (listAllInfo "")---- XXX: generalize to arbitrary input-testCount = do- let obj = Count 1 60- resp = unparse obj ++ "OK"- cmd [("count Title \"Foo\"", Right resp)] (Right obj)- (count (Title =? "Foo"))------- Playlist commands-----testAdd =- cmd [("add \"foo\"", Right "OK"),- ("listall \"foo\"", Right "file: Foo\nfile: Bar\nOK")]- (Right ["Foo", "Bar"])- (add "foo")--testAdd_ =- cmd_ [("add \"foo\"", Right "OK")] (add_ "foo")--testPlaylistAdd =- cmd_ [("playlistadd \"foo\" \"bar\"", Right "OK")]- (playlistAdd_ "foo" "bar")--testAddId =- cmd [("addid \"dir/Foo-Bar.ogg\"", Right "Id: 20\nOK")]- (Right $ Id 20)- (addId "dir/Foo-Bar.ogg" Nothing)--testPlaylistClear =- cmd_ [("playlistclear \"foo\"", Right "OK")]- (playlistClear "foo")--testClear =- cmd_ [("clear", Right "OK")] clear--testPlChangesPosId =- cmd [("plchangesposid 10", Right "OK")]- (Right [])- (plChangesPosId 10)--testPlChangesPosIdWeird =- cmd [("plchangesposid 10", Right "cpos: foo\nId: bar\nOK")]- (Left $ Unexpected "[(\"cpos\",\"foo\"),(\"Id\",\"bar\")]")- (plChangesPosId 10)---- XXX: this is ill-defined-{--testCurrentSong = do- let obj = def { stState = Stopped, stPlaylistVersion = 253 }- resp = unparse obj ++ "OK"- cmd [("status", Right resp)] (Right Nothing) currentSong--}--testPlaylistDelete =- cmd_ [("playlistdelete \"foo\" 1", Right "OK")] (playlistDelete "foo" 1)--testLoad =- cmd_ [("load \"foo\"", Right "OK")] (load "foo")--testMove2 = cmd_ [("playlistmove \"foo\" 1 2", Right "OK")] (playlistMove "foo" 1 2)--testRm = cmd_ [("rm \"foo\"", Right "OK")] (rm "foo")--testRename = cmd_ [("rename \"foo\" \"bar\"", Right "OK")] (rename "foo" "bar")--testSave = cmd_ [("save \"foo\"", Right "OK")] (save "foo")--testShuffle = cmd_ [("shuffle", Right "OK")] (shuffle Nothing)--testListPlaylist = cmd [("listplaylist \"foo\""- ,Right "file: dir/Foo-bar.ogg\n\- \file: dir/Quux-quuz.ogg\n\- \OK")]- (Right ["dir/Foo-bar.ogg", "dir/Quux-quuz.ogg"])- (listPlaylist "foo")------- Playback commands-----testCrossfade = cmd_ [("crossfade 0", Right "OK")] (crossfade 0)--testPlay = cmd_ [("play", Right "OK")] (play Nothing)--testPause = cmd_ [("pause 0", Right "OK")] (pause False)--testStop = cmd_ [("stop", Right "OK")] stop--testNext = cmd_ [("next", Right "OK")] next--testPrevious = cmd_ [("previous", Right "OK")] previous--testRandom = cmd_ [("random 0", Right "OK")] (random False)--testRepeat = cmd_ [("repeat 0", Right "OK")] (repeat False)--testSetVolume = cmd_ [("setvol 10", Right "OK")] (setVolume 10)--testConsume = cmd_ [("consume 1", Right "OK")] (consume True)--testSingle = cmd_ [("single 1", Right "OK")] (single True)------- Miscellaneous commands-----testClearError = cmd_ [("clearerror", Right "OK")] clearError--testCommands =- cmd [("commands", Right "command: foo\ncommand: bar")]- (Right ["foo", "bar"])- commands--testNotCommands =- cmd [("notcommands", Right "command: foo\ncommand: bar")]- (Right ["foo", "bar"])- notCommands--testTagTypes =- cmd [("tagtypes", Right "tagtype: foo\ntagtype: bar")]- (Right ["foo", "bar"])- tagTypes--testUrlHandlers =- cmd [("urlhandlers", Right "urlhandler: foo\nurlhandler: bar")]- (Right ["foo", "bar"])- urlHandlers--testPassword = cmd_ [("password foo", Right "OK")] (password "foo")--testPasswordSucceeds =- testMPD convo expected_resp "foo" cmd_in `shouldBe` Ok- where- convo = [("lsinfo \"/\"", Right "ACK [4@0] {play} you don't have \- \permission for \"play\"")- ,("password foo", Right "OK")- ,("lsinfo \"/\"", Right "directory: /bar\nOK")]- expected_resp = Right [LsDirectory "/bar"]- cmd_in = lsInfo "/"--testPasswordFails =- testMPD convo expected_resp "foo" cmd_in `shouldBe` Ok- where- convo = [("play", Right "ACK [4@0] {play} you don't have \- \permission for \"play\"")- ,("password foo",- Right "ACK [3@0] {password} incorrect password")]- expected_resp =- Left $ ACK InvalidPassword " incorrect password"- cmd_in = play Nothing--testPing = cmd_ [("ping", Right "OK")] ping--testStats = cmd [("stats", Right resp)] (Right obj) stats- where obj = def { stsArtists = 1, stsAlbums = 1, stsSongs = 1- , stsUptime = 100, stsPlaytime = 100, stsDbUpdate = 10- , stsDbPlaytime = 100 }- resp = unparse obj ++ "OK"------- Extensions\/shortcuts-----testUpdateId0 = cmd [("update", Right "updating_db: 1")]- (Right 1)- (updateId [])--testUpdateId1 = cmd [("update \"foo\"", Right "updating_db: 1")]- (Right 1)- (updateId ["foo"])--testTogglePlay = cmd_- [("status", Right resp)- ,("pause 1", Right "OK")]- toggle- where resp = unparse def { stState = Playing }--testToggleStop = cmd_- [("status", Right resp)- ,("play", Right "OK")]- toggle- where resp = unparse def { stState = Stopped }--{- this overlaps with testToggleStop, no?-testTogglePause = cmd_- [("status", Right resp)- ,("play", Right "OK")]- toggle- where resp = unparse def { stState = Paused }--}--testAddMany0 = cmd_ [("add \"bar\"", Right "OK")]- (addMany "" ["bar"])--testAddMany1 = cmd_ [("playlistadd \"foo\" \"bar\"", Right "OK")]- (addMany "foo" ["bar"])--testVolume = cmd_ [("status", Right st), ("setvol 90", Right "OK")] (volume (-10))- where st = unparse def { stVolume = 100 }
− tests/Defaults.hs
@@ -1,21 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Defaults where--import Data.Default-import Network.MPD.Commands.Types--instance Default Count where- def = defaultCount--instance Default Device where- def = defaultDevice---- XXX: note Song has no sensible default value--- XXX: or does it?--instance Default Stats where- def = defaultStats--instance Default Status where- def = defaultStatus
− tests/EnvSpec.hs
@@ -1,80 +0,0 @@-module EnvSpec (main, spec) where--import TestUtil-import Test.Hspec.Monadic--import Network.MPD-import System.Posix.Env hiding (getEnvDefault)--main :: IO ()-main = hspecX spec--spec :: Specs-spec = do- describe "getEnvDefault" $ do- it "returns the value of an environment variable" $ do- setEnv "FOO" "foo" True- r <- getEnvDefault "FOO" "bar"- r `shouldBe` "foo"-- it "returns a given default value if that environment variable is not set" $ do- unsetEnv "FOO"- r <- getEnvDefault "FOO" "bar"- r `shouldBe` "bar"-- describe "getConnectionSettings" $ do- it "takes an optional argument, that overrides MPD_HOST" $ do- setEnv "MPD_HOST" "user@example.com" True- Right (host, _, pw) <- getConnectionSettings (Just "foo@bar") Nothing- pw `shouldBe` "foo"- host `shouldBe` "bar"-- it "takes an optional argument, that overrides MPD_PORT" $ do- setEnv "MPD_PORT" "8080" True- Right (_, port, _) <- getConnectionSettings Nothing (Just "23")- port `shouldBe` 23-- it "returns an error message, if MPD_PORT is not an int" $ do- setEnv "MPD_PORT" "foo" True- r <- getConnectionSettings Nothing Nothing- r `shouldBe` Left "\"foo\" is not a valid port!"- unsetEnv "MPD_PORT"-- describe "host" $ do- it "is taken from MPD_HOST" $ do- setEnv "MPD_HOST" "example.com" True- Right (host, _, _) <- getConnectionSettings Nothing Nothing- host `shouldBe` "example.com"-- it "is 'localhost' if MPD_HOST is not set" $ do- unsetEnv "MPD_HOST"- Right (host, _, _) <- getConnectionSettings Nothing Nothing- host `shouldBe` "localhost"-- describe "port" $ do- it "is taken from MPD_PORT" $ do- setEnv "MPD_PORT" "8080" True- Right (_, port, _) <- getConnectionSettings Nothing Nothing- port `shouldBe` 8080-- it "is 6600 if MPD_PORT is not set" $ do- unsetEnv "MPD_PORT"- Right (_, port, _) <- getConnectionSettings Nothing Nothing- port `shouldBe` 6600-- describe "password" $ do- it "is taken from MPD_HOST if MPD_HOST is of the form password@host" $ do- setEnv "MPD_HOST" "password@host" True- Right (host, _, pw) <- getConnectionSettings Nothing Nothing- host `shouldBe` "host"- pw `shouldBe` "password"-- it "is '' if MPD_HOST is not of the form password@host" $ do- setEnv "MPD_HOST" "example.com" True- Right (_, _, pw) <- getConnectionSettings Nothing Nothing- pw `shouldBe` ""-- it "is '' if MPD_HOST is not set" $ do- unsetEnv "MPD_HOST"- Right (_, _, pw) <- getConnectionSettings Nothing Nothing- pw `shouldBe` ""
− tests/ParserSpec.hs
@@ -1,67 +0,0 @@-{-# LANGUAGE StandaloneDeriving, OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module ParserSpec (main, spec) where--import Arbitrary ()-import Defaults ()-import Unparse--import Test.Hspec.Monadic-import Test.Hspec.HUnit ()-import Test.Hspec.QuickCheck (prop)--import Network.MPD.Commands.Parse-import Network.MPD.Commands.Types-import Network.MPD.Util hiding (read)--import qualified Data.ByteString.UTF8 as UTF8-import Data.List-import qualified Data.Map as M-import Data.Time--main :: IO ()-main = hspecX spec--spec :: Specs-spec = do- describe "parseIso8601" $ do- prop "parses dates in ISO8601 format" prop_parseIso8601-- describe "parseCount" $ do- prop "parses counts" prop_parseCount-- describe "parseOutputs" $ do- prop "parses outputs" prop_parseOutputs-- describe "parseSong" $ do- prop "parses songs" prop_parseSong-- describe "parseStats" $ do- prop "parses stats" prop_parseStats---- 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 . UTF8.fromString . formatIso8601) t--prop_parseCount :: Count -> Bool-prop_parseCount c = Right c == (parseCount . map UTF8.fromString . lines . unparse) c--prop_parseOutputs :: [Device] -> Bool-prop_parseOutputs ds =- Right ds == (parseOutputs . map UTF8.fromString . lines . concatMap unparse) ds--deriving instance Ord Value--prop_parseSong :: Song -> Bool-prop_parseSong s = Right (sortTags s) == sortTags `fmap` (parseSong . toAssocList . map UTF8.fromString . lines . unparse) 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 . map UTF8.fromString . lines . unparse) s
− tests/StringConn.hs
@@ -1,96 +0,0 @@-{-# 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--import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.UTF8 as UTF8---- | 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- getVersion = error "StringConn.getVersion: undefined"- getHandle = error "StringConn.getHandle: undefined"- setPassword = error "StringConn.setPassword: undefined"-- 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 . B.lines . UTF8.fromString) 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
− tests/TestUtil.hs
@@ -1,7 +0,0 @@-module TestUtil (shouldBe) where--import Test.Hspec.HUnit ()-import Test.HUnit--shouldBe :: (Eq a, Show a) => a -> a -> Assertion-shouldBe = (@?=)
− tests/Unparse.hs
@@ -1,75 +0,0 @@--- | Unparsing for MPD objects--module Unparse (Unparse(..)) where--import qualified Data.Map as M-import Network.MPD.Commands.Types-import Network.MPD.Util--class Unparse parsed where- unparse :: parsed -> String--instance Unparse Count where- unparse x = unlines- [ "songs: " ++ show (cSongs x)- , "playtime: " ++ show (cPlaytime x) - ]--instance Unparse Device where- unparse x = unlines- [ "outputid: " ++ show (dOutputID x)- , "outputname: " ++ dOutputName x- , "outputenabled: " ++ showBool (dOutputEnabled x)- ]--instance Unparse Song where- unparse s =- let fs = concatMap toF . M.toList $ sgTags 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: " ++ (toString . sgFilePath) s]- ++ ["Time: " ++ (show . sgLength) s]- ++ fs- ++ lastModified- ++ id_- ++ idx- where- toF (k, vs) = map (toF' k) vs- toF' k v = show k ++ ": " ++ toString v--instance Unparse Stats where- unparse s = unlines- [ "artists: " ++ show (stsArtists s)- , "albums: " ++ show (stsAlbums s)- , "songs: " ++ show (stsSongs s)- , "uptime: " ++ show (stsUptime s)- , "playtime: " ++ show (stsPlaytime s)- , "db_playtime: " ++ show (stsDbPlaytime s)- , "db_update: " ++ show (stsDbUpdate s)- ]--instance Unparse Status where- unparse s = unlines $- [ "state: " ++ (case stState s of Playing -> "play"- Paused -> "pause"- _ -> "stop")- , "volume: " ++ show (stVolume s)- , "repeat: " ++ showBool (stRepeat s)- , "random: " ++ showBool (stRandom s)- , "playlist: " ++ show (stPlaylistVersion s)- , "playlistlength: " ++ show (stPlaylistLength s)- , "xfade: " ++ show (stXFadeWidth s)- , "time: " ++ (let (x, y) = stTime s in show x ++ ":" ++ show y)- , "bitrate: " ++ show (stBitrate s)- , "xfade: " ++ show (stXFadeWidth s)-- , "audio: " ++ (let (x, y, z) = stAudio s in show x ++ ":" ++ show y ++- ":" ++ show z)- , "updating_db: " ++ show (stUpdatingDb s)- , "error: " ++ show (stError s)- , "single: " ++ showBool (stSingle s)- , "consume: " ++ showBool (stConsume s) - ]- ++ maybe [] (\n -> ["song: " ++ show n]) (stSongPos s)- ++ maybe [] (\n -> ["songid: " ++ show n]) (stSongID s)
− tests/UtilSpec.hs
@@ -1,100 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-}--module UtilSpec (main, spec) where--import Arbitrary-import TestUtil--import Test.Hspec.Monadic-import Test.Hspec.HUnit ()-import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck--import Data.List (sort)-import Data.Maybe (fromJust, isJust)-import Data.ByteString.Char8 (ByteString)-import qualified Data.ByteString.UTF8 as UTF8--import Network.MPD.Util--main :: IO ()-main = hspecX spec--spec :: Specs-spec = do- describe "splitGroups" $ do- it "breaks an association list into sublists" $ do- splitGroups ["1", "5"]- [("1","a"),("2","b"),- ("5","c"),("6","d"),- ("1","z"),("2","y"),("3","x")]- `shouldBe`- [[("1","a"),("2","b")],- [("5","c"),("6","d")],- [("1","z"),("2","y"),("3","x")]]- prop "is reversible" prop_splitGroups_rev- prop "preserves input" prop_splitGroups_integrity-- describe "parseDate" $ do- prop "simple year strings" prop_parseDate_simple- prop "complex year strings" prop_parseDate_complex-- describe "toAssoc" $ do- prop "is reversible" prop_toAssoc_rev-- describe "parseBool" $ do- prop "parses boolean values" prop_parseBool- prop "is reversible" prop_parseBool_rev-- describe "showBool" $ do- prop "unparses boolean values" prop_showBool-- describe "parseNum" $ do- prop "parses positive and negative integers" prop_parseNum---prop_parseDate_simple :: YearString -> Bool-prop_parseDate_simple (YS x) = isJust $ parseDate x--prop_parseDate_complex :: DateString -> Bool-prop_parseDate_complex (DS x) = isJust $ parseDate x--prop_toAssoc_rev :: AssocString -> Bool-prop_toAssoc_rev x = k == k' && v == v'- where- AS str k v = x- (k',v') = toAssoc str--prop_parseBool_rev :: BoolString -> Bool-prop_parseBool_rev (BS x) = showBool (fromJust $ parseBool x) == x--prop_parseBool :: BoolString -> Bool-prop_parseBool (BS xs) =- case parseBool xs of- Nothing -> False- Just True -> xs == "1"- Just False -> xs == "0"--prop_showBool :: Bool -> Bool-prop_showBool True = showBool True == "1"-prop_showBool x = showBool x == "0"--prop_splitGroups_rev :: [(ByteString, ByteString)] -> Property-prop_splitGroups_rev xs = not (null xs) ==>- let wrappers = [fst $ head xs]- r = splitGroups wrappers xs- in r == splitGroups wrappers (concat r)--prop_splitGroups_integrity :: [(ByteString, ByteString)] -> Property-prop_splitGroups_integrity xs = not (null xs) ==>- sort (concat $ splitGroups [fst $ head xs] xs) == sort xs--prop_parseNum :: Integer -> Bool-prop_parseNum x =- case xs of- '-':_ -> ((<= 0) `fmap` parseNum bs) == Just True- _ -> ((>= 0) `fmap` parseNum bs) == Just True- where- xs = show x- bs = UTF8.fromString xs