libmpd 0.9.0.9 → 0.9.0.10

raw patch · 26 files changed

+369/−66 lines, 26 filesdep +safe-exceptionsdep ~QuickCheckdep ~basedep ~containersnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: safe-exceptions

Dependency ranges changed: QuickCheck, base, containers, network, time

API changes (from Hackage documentation)

Files

• README.md +20/−11
• changelog.md +3/−0
• libmpd.cabal +10/−6
• src/Network/MPD/Applicative.hs +8/−0
• src/Network/MPD/Applicative/CurrentPlaylist.hs +27/−0
• src/Network/MPD/Applicative/Database.hs +5/−0
• src/Network/MPD/Applicative/Internal.hs +5/−1
• src/Network/MPD/Applicative/Mount.hs +52/−0
• src/Network/MPD/Applicative/Output.hs +5/−0
• src/Network/MPD/Applicative/PlaybackControl.hs +2/−2
• src/Network/MPD/Applicative/PlaybackOptions.hs +2/−2
• src/Network/MPD/Applicative/Status.hs +4/−4
• src/Network/MPD/Commands.hs +6/−1
• src/Network/MPD/Commands/CurrentPlaylist.hs +26/−0
• src/Network/MPD/Commands/Database.hs +5/−0
• src/Network/MPD/Commands/Mount.hs +36/−0
• src/Network/MPD/Commands/Output.hs +5/−0
• src/Network/MPD/Commands/PlaybackControl.hs +2/−2
• src/Network/MPD/Commands/PlaybackOptions.hs +2/−2
• src/Network/MPD/Commands/Types.hs +65/−10
• src/Network/MPD/Core.hs +23/−10
• tests/Arbitrary.hs +5/−2
• tests/ParserSpec.hs +10/−10
• tests/StringConn.hs +2/−2
• tests/TypeSpec.hs +34/−0
• tests/Unparse.hs +5/−1

@@ -1,5 +1,8 @@ # libmpd-haskell: a client library for MPD +[![Hackage](https://budueba.com/hackage/libmpd)](http://hackage.haskell.org/package/libmpd)+[![Build Status](https://secure.travis-ci.org/vimus/libmpd-haskell.png?branch=master)](http://travis-ci.org/vimus/libmpd-haskell)+ ## About libmpd-haskell is a pure [Haskell] client library for [MPD], the music playing daemon.@@ -11,14 +14,14 @@ * [Latest release on Hackage] * `git clone git://github.com/vimus/libmpd-haskell.git` -[Latest release on Hackage]: http://hackage.haskell.org/package/libmpd "libmpd-haskell on Hackage"+[Latest release on Hackage]: https://hackage.haskell.org/package/libmpd "libmpd-haskell on Hackage"  ## Installation With [cabal-install], do  `cd libmpd-haskell && cabal install` -[cabal-install]: http://hackage.haskell.org/package/cabal-install+[cabal-install]: https://hackage.haskell.org/package/cabal-install  ## Usage With GHCi:@@ -46,25 +49,31 @@  Well-formatted patches are appreciated. New features should have a test case. +## See also+* [vimus], an MPD client with vim-like keybindings++[vimus]: https://github.com/vimus/vimus+ ## Resources * [API documentation] * [MPD protocol reference] * [Using GitHub] * \#vimus @ irc.freenode.net -[bug tracker]: http://github.com/vimus/libmpd-haskell/issues-[GitHub]: http://www.github.com-[GitHub repository]: http://www.github.com/vimus/libmpd-haskell-[API documentation]: http://hackage.haskell.org/packages/archive/libmpd/latest/doc/html/Network-MPD.html+[bug tracker]: https://github.com/vimus/libmpd-haskell/issues+[GitHub]: https://github.com+[GitHub repository]: https://github.com/vimus/libmpd-haskell+[API documentation]: https://hackage.haskell.org/packages/archive/libmpd/latest/doc/html/Network-MPD.html [MPD protocol reference]: http://www.musicpd.org/doc/protocol/-[Using GitHub]: http://help.github.com+[Using GitHub]: https://help.github.com  ## License libmpd-haskell is distributed under the [MIT license]. -[MIT license]: http://www.opensource.org/licenses/MIT+[MIT license]: http://opensource.org/licenses/MIT  ## Contributors-See `CONTRIBUTORS` in the source distribution.-Feel free to add yourself to this list if you deem it appropriate-to do so.+See [CONTRIBUTORS](https://github.com/vimus/libmpd-haskell/blob/master/CONTRIBUTORS) in the+source distribution.+Feel free to add yourself to this list if you deem it appropriate to do+so.

@@ -1,3 +1,6 @@+* v0.9.10+    - Port it for newer network library+ * v0.9.0, 2014-09-21     - New commands: `deleteRange`, `moveRange`, `playlistInfoRange`,       `searchAdd`, `searchAddpl`.

@@ -1,5 +1,5 @@ Name:               libmpd-Version:            0.9.0.9+Version:            0.9.0.10 Synopsis:           An MPD client library. Description:        A client library for MPD, the Music Player Daemon. Category:           Network, Sound@@ -19,7 +19,7 @@ Homepage:           http://github.com/vimus/libmpd-haskell#readme Bug-reports:        http://github.com/vimus/libmpd-haskell/issues -Tested-With:        GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.1, GHC ==8.0.1+Tested-With:        GHC ==8.0.1, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1 Build-Type:         Simple Cabal-Version:      >= 1.10 @@ -39,7 +39,7 @@      Build-Depends:         -- Platform dependencies-        base >= 4 && < 5+        base >= 4.9 && < 5       , attoparsec >= 0.10.1 && < 1       , bytestring >= 0.9 && < 1       , containers >= 0.3 && < 1@@ -50,12 +50,13 @@          -- Additional dependencies       , data-default-class >= 0.0.1 && < 1-      , network >= 2.1 && < 3+      , network >= 2.6.3.5+      , safe-exceptions >= 0.1 && < 0.2       , utf8-string >= 0.3.1 && < 1.1      if impl(ghc >= 7.10.0)         Build-Depends:-            time >= 1.5 && <1.9+            time >= 1.5     else         Build-Depends:             time >= 1.1 && <1.5@@ -67,6 +68,7 @@       , Network.MPD.Applicative.Connection       , Network.MPD.Applicative.CurrentPlaylist       , Network.MPD.Applicative.Database+      , Network.MPD.Applicative.Mount       , Network.MPD.Applicative.Output       , Network.MPD.Applicative.PlaybackControl       , Network.MPD.Applicative.PlaybackOptions@@ -96,6 +98,7 @@       , Network.MPD.Commands.Connection       , Network.MPD.Commands.Output       , Network.MPD.Commands.Reflection+      , Network.MPD.Commands.Mount       , Network.MPD.Applicative.Util       , Network.MPD.Applicative.Internal       , Network.MPD.Util@@ -125,9 +128,10 @@         -- Additional dependencies       , data-default-class       , network+      , safe-exceptions       , utf8-string          -- Test dependencies       , unix-      , QuickCheck >= 2.1+      , QuickCheck >= 2.10       , hspec >= 1.3

@@ -31,13 +31,21 @@  -- * Reflection , module Network.MPD.Applicative.Reflection++-- * Mounting+, module Network.MPD.Applicative.Mount++-- * Client-to-client+, module Network.MPD.Applicative.ClientToClient ) where  import Network.MPD.Applicative.Internal +import Network.MPD.Applicative.ClientToClient import Network.MPD.Applicative.Connection import Network.MPD.Applicative.CurrentPlaylist import Network.MPD.Applicative.Database+import Network.MPD.Applicative.Mount import Network.MPD.Applicative.Output import Network.MPD.Applicative.PlaybackControl import Network.MPD.Applicative.PlaybackOptions

@@ -29,9 +29,14 @@     , playlistSearch     , plChanges     , plChangesPosId+    , prio+    , prioId     , shuffle     , swap     , swapId+    , addTagId+    , clearTagId+    , rangeId     ) where  import           Network.MPD.Commands.Arg hiding (Command)@@ -135,6 +140,14 @@              = Right (x', Id y')              | otherwise = Left "" +-- | Set the priority of the specified songs.+prio :: Priority -> (Position, Position) -> Command ()+prio p range = Command emptyResponse ["prio" <@> p <++> range]++-- | Set priority by song id.+prioId :: Priority -> Id -> Command ()+prioId p ids = Command emptyResponse ["prioid" <@> p <++> ids]+ -- | Shuffle the current playlist. -- Optionally restrict to a range of songs. shuffle :: Maybe (Position, Position) -> Command ()@@ -147,3 +160,17 @@ -- | Swap songs by id. swapId :: Id -> Id -> Command () swapId id1 id2 = Command emptyResponse ["swapid" <@> id1 <++> id2]++-- | Add tag to specified (remote) song.+addTagId :: Id -> Metadata -> Value -> Command ()+addTagId id' tag val = Command emptyResponse ["addtagid" <@> id' <++> tag <++> val]++-- | Remove tag from specified (remote) song.+clearTagId :: Id -> Metadata -> Command ()+clearTagId id' tags = Command emptyResponse ["cleartagid" <@> id' <++> tags]++-- | Specify portion of song that shall be played.+-- Both ends of the range are optional; omitting both plays everything.+rangeId :: Id -> (Maybe Double, Maybe Double) -> Command ()+rangeId id' (mbStart, mbEnd) = Command emptyResponse ["rangeid " ++ show id' ++ " " ++ arg ]+  where arg = maybe "" show mbStart ++ ":" ++ maybe "" show mbEnd

@@ -77,6 +77,11 @@ lsInfo :: Path -> Command [LsResult] lsInfo = lsInfo' "lsinfo" +-- | Read comments from the file at the specified path.+readComments :: Path -> Command [(String, String)]+readComments uri = Command p ["readcomments" <@> uri]+  where p = map decodePair . toAssocList <$> getResponse+ -- | Like 'find' but with inexact matching. search :: Query -> Command [Song] search q = Command p ["search" <@> q]

@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE CPP #-}  {- | Module      : Network.MPD.Applicative.Internal@@ -38,6 +39,7 @@ import           Network.MPD.Core hiding (getResponse) import qualified Network.MPD.Core as Core import           Control.Monad.Error+import qualified Control.Monad.Fail as Fail  -- | A line-oriented parser that returns a value along with any remaining input. newtype Parser a@@ -45,9 +47,11 @@       deriving Functor  instance Monad Parser where-    fail      = Parser . const . Left     return a  = Parser $ \input -> Right (a, input)     p1 >>= p2 = Parser $ \input -> runParser p1 input >>= uncurry (runParser . p2)++instance Fail.MonadFail Parser where+    fail = Prelude.fail  instance Applicative Parser where     pure  = return

@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Applicative.Mount+Copyright   : (c) Joachim Fasting 2014+License     : MIT++Maintainer  : joachifm@fastmail.fm+Stability   : stable+Portability : unportable++Mounting remote storage.+-}++module Network.MPD.Applicative.Mount+  ( mount+  , unmount+  , listMounts+  , listNeighbors+  ) where++import           Network.MPD.Commands.Arg hiding (Command)+import           Network.MPD.Applicative.Internal+import           Network.MPD.Util++import           Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.UTF8 as UTF8++mount :: String -- Path+      -> String -- Uri+      -> Command ()+mount p u = Command emptyResponse ["mount" <@> p <++> u]++unmount :: String -- Path+        -> Command ()+unmount p = Command emptyResponse ["unmount" <@> p]++listMounts :: Command [(String, String)] -- (Path, Uri)+listMounts = Command (liftParser p) ["listmounts"]+  where+    p = mapM parseMount . splitGroups ["mount"] . toAssocList+    parseMount :: [(ByteString, ByteString)] -> Either String (String, String)+    parseMount [("mount", mo), ("storage", st)] = Right (UTF8.toString mo, UTF8.toString st)+    parseMount _ = Left "Unexpected result from listMounts"++listNeighbors :: Command [(String, String)] -- (Uri, Name)+listNeighbors = Command (liftParser p) ["listneighbors"]+  where+    p = mapM parseNeighbor . splitGroups ["neighbor"] . toAssocList+    parseNeighbor :: [(ByteString, ByteString)] -> Either String (String, String)+    parseNeighbor [("neighbor", ne), ("name", na)] = Right (UTF8.toString ne, UTF8.toString na)+    parseNeighbor _ = Left "Unexpected result from listNeighbors"

@@ -15,6 +15,7 @@ module Network.MPD.Applicative.Output     ( disableOutput     , enableOutput+    , toggleOutput     , outputs     ) where @@ -30,6 +31,10 @@ -- | Turn on output. enableOutput :: Int -> Command () enableOutput n = Command emptyResponse ["enableoutput" <@> n]++-- | Toggle output.+toggleOutput :: Int -> Command ()+toggleOutput n = Command emptyResponse ["toggleoutput" <@> n]  -- | Get information about all available output devices. outputs :: Command [Device]

@@ -50,11 +50,11 @@ previous = Command emptyResponse ["previous"]  -- | Seek to time in the song at the given position.-seek :: Position -> Seconds -> Command ()+seek :: Position -> FractionalSeconds -> Command () seek pos time = Command emptyResponse ["seek" <@> pos <++> time]  -- | Seek to time in the song with the given id.-seekId :: Id -> Seconds -> Command ()+seekId :: Id -> FractionalSeconds -> Command () seekId id' time = Command emptyResponse ["seekid" <@> id' <++> time]  -- | Stop playback.

@@ -50,8 +50,8 @@ repeat :: Bool -> Command () repeat f = Command emptyResponse ["repeat" <@> f] --- | Set volume in percent.-setVolume :: Int -> Command ()+-- | Set volume.+setVolume :: Volume -> Command () setVolume vol = Command emptyResponse ["setvol" <@> vol]  -- | Toggle single mode.

@@ -96,7 +96,7 @@                 "nextsongid"     -> int   $ \x -> a { stNextSongID      = Just $ Id x }                 "time"           -> time  $ \x -> a { stTime            = Just x }                 "elapsed"        -> frac  $ \x -> a { stTime            = fmap ((x,) . snd) (stTime a) }-                "duration"       -> frac  $ \x -> a { stTime            = fmap ((, round x) . fst) (stTime a) }+                "duration"       -> frac  $ \x -> a { stTime            = fmap ((,x) . fst) (stTime a) }                 "bitrate"        -> int   $ \x -> a { stBitrate         = Just x }                 "xfade"          -> num   $ \x -> a { stXFadeWidth      = x }                 "mixrampdb"      -> frac  $ \x -> a { stMixRampdB       = x }@@ -116,7 +116,7 @@                     -- errors.                     audio f = Right $ maybe a f (parseTriple ':' parseNum v) -                    time f = case parseFrac *** parseNum $ breakChar ':' v of+                    time f = case parseFrac *** parseFrac $ breakChar ':' v of                                  (Just a_, Just b) -> (Right . f) (a_, b)                                  _                 -> unexpectedPair @@ -127,8 +127,8 @@                         _       -> unexpectedPair                      -- A volume of -1 indicates an audio backend w/o a mixer-                    vol f = case parseNum v of+                    vol f = case (parseNum v :: Maybe Int) of                       Nothing -> unexpectedPair -- does it really make sense to fail here? when does this occur?                       Just v' -> (Right . f) (g v')                       where g n | n < 0     = Nothing-                                | otherwise = Just (n::Int)+                                | otherwise = Just $ fromIntegral n

@@ -23,15 +23,18 @@     , Value     , ObjectType(..)     , Seconds+    , FractionalSeconds     , Decibels-    , State(..)+    , PlaybackState(..)     , Subsystem(..)     , ReplayGainMode(..)     , Count(..)     , LsResult(..)     , Device(..)     , Song(..)+    , Priority(..)     , Position+    , Volume     , Id(..)     , sgGetTag     , sgAddTag@@ -50,6 +53,7 @@     , module Network.MPD.Commands.Output     , module Network.MPD.Commands.Reflection     , module Network.MPD.Commands.ClientToClient+    , module Network.MPD.Commands.Mount     ) where  import           Network.MPD.Commands.Query@@ -66,3 +70,4 @@ import           Network.MPD.Commands.Output import           Network.MPD.Commands.Reflection import           Network.MPD.Commands.ClientToClient+import           Network.MPD.Commands.Mount

@@ -28,9 +28,14 @@     , playlistSearch     , plChanges     , plChangesPosId+    , prio+    , prioId     , shuffle     , swap     , swapId+    , addTagId+    , clearTagId+    , rangeId     ) where  import qualified Network.MPD.Applicative.Internal as A@@ -114,6 +119,14 @@ plChangesPosId :: MonadMPD m => Integer -> m [(Position, Id)] plChangesPosId = A.runCommand . A.plChangesPosId +-- | Set the priority of the specified songs.+prio :: MonadMPD m => Priority -> (Position, Position) -> m ()+prio p = A.runCommand . A.prio p++-- | Set priority by song id.+prioId :: MonadMPD m => Priority -> Id -> m ()+prioId p = A.runCommand . A.prioId p+ -- | Shuffle the playlist. shuffle :: MonadMPD m => Maybe (Position, Position) -- ^ Optional range (start, end)         -> m ()@@ -126,3 +139,16 @@ -- | Swap the positions of two songs (Id version) swapId :: MonadMPD m => Id -> Id -> m () swapId id1 = A.runCommand . A.swapId id1++-- | Add tag to (remote) song.+addTagId :: (MonadMPD m) => Id -> Metadata -> Value -> m ()+addTagId id' tag = A.runCommand . A.addTagId id' tag++-- | Remove tag from (remote) song.+clearTagId :: (MonadMPD m) => Id -> Metadata -> m ()+clearTagId id' = A.runCommand . A.clearTagId id'++-- | Specify portion of song that shall be played.+-- Both ends of the range are optional; omitting both plays everything.+rangeId :: (MonadMPD m) => Id -> (Maybe Double, Maybe Double) -> m ()+rangeId id' = A.runCommand . A.rangeId id'

@@ -20,6 +20,7 @@     , listAll     , listAllInfo     , lsInfo+    , readComments     , search     , update     , rescan@@ -60,6 +61,10 @@ -- | Non-recursively list the contents of a database directory. lsInfo :: MonadMPD m => Path -> m [LsResult] lsInfo = A.runCommand . A.lsInfo++-- | Read comments from file at path.+readComments :: MonadMPD m => Path -> m [(String, String)]+readComments = A.runCommand . A.readComments  -- | Search the database using case insensitive matching. search :: MonadMPD m => Query -> m [Song]

@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module      : Network.MPD.Commands.Mount+Copyright   : (c) Joachim Fasting 2014+License     : MIT++Maintainer  : joachifm@fastmail.fm+Stability   : stable+Portability : unportable++Mounting remote storage.+-}++module Network.MPD.Commands.Mount+  ( mount+  , unmount+  , listMounts+  , listNeighbors+  ) where++import qualified Network.MPD.Applicative.Internal as A+import qualified Network.MPD.Applicative.Mount as A+import           Network.MPD.Core++mount :: (MonadMPD m) => String -> String -> m ()+mount p = A.runCommand . A.mount p++unmount :: (MonadMPD m) => String -> m ()+unmount = A.runCommand . A.unmount++listMounts :: (MonadMPD m) => m [(String, String)]+listMounts = A.runCommand A.listMounts++listNeighbors :: (MonadMPD m) => m [(String, String)]+listNeighbors = A.runCommand A.listNeighbors

@@ -15,6 +15,7 @@ module Network.MPD.Commands.Output     ( disableOutput     , enableOutput+    , toggleOutput     , outputs     ) where @@ -30,6 +31,10 @@ -- | Turn on an output device. enableOutput :: MonadMPD m => Int -> m () enableOutput = A.runCommand . A.enableOutput++-- | Toggle output device.+toggleOutput :: MonadMPD m => Int -> m ()+toggleOutput = A.runCommand . A.toggleOutput  -- | Retrieve information for all output devices. outputs :: MonadMPD m => m [Device]

@@ -49,11 +49,11 @@ previous = A.runCommand A.previous  -- | Seek to some point in a song.-seek :: MonadMPD m => Position -> Seconds -> m ()+seek :: MonadMPD m => Position -> FractionalSeconds -> m () seek pos = A.runCommand . A.seek pos  -- | Seek to some point in a song (id version)-seekId :: MonadMPD m => Id -> Seconds -> m ()+seekId :: MonadMPD m => Id -> FractionalSeconds -> m () seekId id' = A.runCommand . A.seekId id'  -- | Stop playing.

@@ -46,8 +46,8 @@ repeat :: MonadMPD m => Bool -> m () repeat = A.runCommand . A.repeat --- | Set the volume (0-100 percent).-setVolume :: MonadMPD m => Int -> m ()+-- | Set the volume.+setVolume :: MonadMPD m => Volume -> m () setVolume = A.runCommand . A.setVolume  -- | Set single mode

@@ -18,8 +18,9 @@     , Value(..)     , ObjectType(..)     , Seconds+    , FractionalSeconds     , Decibels-    , State(..)+    , PlaybackState(..)     , Subsystem(..)     , ReplayGainMode(..)     , Count(..)@@ -28,8 +29,10 @@     , Song(..)     , Position     , Id(..)+    , Priority(..)     , sgGetTag     , sgAddTag+    , Volume(..)     , Stats(..)     , Status(..)     , def@@ -138,15 +141,18 @@ instance MPDArg ObjectType where     prep SongObj = Args ["song"] +type FractionalSeconds = Double+ type Seconds = Integer  type Decibels = Integer  -- | Represents the different playback states.-data State = Playing-           | Stopped-           | Paused-    deriving (Show, Eq)+data PlaybackState+  = Playing+  | Stopped+  | Paused+    deriving (Eq, Enum, Ord, Bounded, Show)  -- | Represents the various MPD subsystems. data Subsystem@@ -161,7 +167,7 @@     | StickerS           -- ^ Sticker database     | SubscriptionS      -- ^ Subscription     | MessageS           -- ^ Message on subscribed channel-      deriving (Eq, Show)+      deriving (Eq, Enum, Ord, Bounded, Show)  instance MPDArg Subsystem where     prep DatabaseS = Args ["database"]@@ -180,7 +186,7 @@     = Off       -- ^ Disable replay gain     | TrackMode -- ^ Per track mode     | AlbumMode -- ^ Per album mode-      deriving (Eq, Show)+      deriving (Eq, Enum, Ord, Bounded, Show)  instance MPDArg ReplayGainMode where     prep Off = Args ["off"]@@ -246,6 +252,12 @@ instance (MPDArg Id) where     prep (Id x) = prep x +newtype Priority = Priority Int+  deriving (Eq, Show)++instance (MPDArg Priority) where+  prep (Priority x) = prep x+ -- | Get list of specific tag type sgGetTag :: Metadata -> Song -> Maybe [Value] sgGetTag meta s = M.lookup meta $ sgTags s@@ -280,13 +292,56 @@ instance Default Stats where     def = defaultStats +-- | Volume values.+--+-- Values of this type are always in the range 0-100.+--+-- Arithmetic on volumes has the property that:+--+-- @current + new = 100 if current + new > 100@+--+-- @current - new = 0   if current - new < 0@+--+-- but @current / 0@ still yields a division by zero exception.+newtype Volume = Volume Int deriving (Eq, Ord, Show)++instance Enum Volume where+    toEnum = Volume . min 100 . max 0+    fromEnum (Volume x) = x++instance Bounded Volume where+    minBound = 0+    maxBound = 100++instance Num Volume where+    Volume x + Volume y = toEnum (x + y)+    Volume x - Volume y = toEnum (x - y)+    Volume x * Volume y = toEnum (x * y)++    negate = id+    abs    = id+    signum = const 0++    fromInteger = toEnum . fromIntegral++instance Integral Volume where+    quotRem (Volume x) (Volume y) =+        let (x', y') = x `quotRem` y in (Volume x', Volume y')+    toInteger (Volume x) = fromIntegral x++instance Real Volume where+    toRational (Volume x) = toRational x++instance MPDArg Volume where+    prep (Volume x) = prep x+ -- | Container for MPD status. data Status =-    Status { stState :: State+    Status { stState :: PlaybackState              -- | A percentage (0-100).              --              -- 'Nothing' indicates that the output lacks mixer support.-           , stVolume          :: Maybe Int+           , stVolume          :: Maybe Volume            , stRepeat          :: Bool            , stRandom          :: Bool              -- | A value that is incremented by the server every time the@@ -303,7 +358,7 @@              -- | Next song's playlist ID.            , stNextSongID      :: Maybe Id              -- | Time elapsed\/total time of playing song (if any).-           , stTime            :: Maybe (Double, Seconds)+           , stTime            :: Maybe (FractionalSeconds, FractionalSeconds)              -- | Bitrate (in kilobytes per second) of playing song (if any).            , stBitrate         :: Maybe Int              -- | Crossfade time.

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, CPP #-} {-# LANGUAGE ScopedTypeVariables #-}  -- | Module    : Network.MPD.Core@@ -28,12 +28,26 @@ import           Data.Char (isDigit) import           Control.Applicative (Applicative(..), (<$>), (<*)) import qualified Control.Exception as E+import           Control.Exception.Safe (catch, catchAny) import           Control.Monad (ap, unless) import           Control.Monad.Error (ErrorT(..), MonadError(..)) import           Control.Monad.Reader (ReaderT(..), ask) import           Control.Monad.State (StateT, MonadIO(..), modify, gets, evalStateT) import qualified Data.Foldable as F-import           Network (PortID(..), withSocketsDo, connectTo)+import           System.IO (IOMode(..))+import Network.Socket+  ( SockAddr(..)+  , addrAddress+  , addrFamily+  , addrProtocol+  , addrSocketType+  , connect+  , defaultHints+  , getAddrInfo+  , socket+  , socketToHandle+  , withSocketsDo+  ) import           System.IO (Handle, hPutStrLn, hReady, hClose, hFlush) import           System.IO.Error (isEOFError, tryIOError, ioeGetErrorType) import           Text.Printf (printf)@@ -105,16 +119,15 @@ mpdOpen = MPD $ do     (host, port) <- ask     runMPD close-    mHandle <- liftIO (safeConnectTo host port)+    addr:_ <- liftIO $ getAddrInfo (Just defaultHints) (Just host) (Just $ show port)+    sock <- liftIO $ socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+    mHandle <- liftIO (safeConnectTo (sock,(addrAddress addr)))     modify (\st -> st { stHandle = mHandle })     F.forM_ mHandle $ \_ -> runMPD checkConn >>= (`unless` runMPD close)     where-        safeConnectTo host@('/':_) _ =-            (Just <$> connectTo "" (UnixSocket host))-            `E.catch` (\(_ :: E.SomeException) -> return Nothing)-        safeConnectTo host port =-            (Just <$> connectTo host (PortNumber $ fromInteger port))-            `E.catch` (\(_ :: E.SomeException) -> return Nothing)+        safeConnectTo (sock,addr) =+            (connect sock addr) >> (Just <$> socketToHandle sock ReadWriteMode)+            `catchAny` const (return Nothing)         checkConn = do             singleMsg <- send ""             let [msg] = singleMsg@@ -151,7 +164,7 @@     where         sendClose handle =             (hPutStrLn handle "close" >> hReady handle >> hClose handle >> return Nothing)-            `E.catch` handler+            `catch` handler          handler err             | isEOFError err = return Nothing

@@ -20,14 +20,17 @@ import qualified Data.Map as M import           Data.Time import           Test.QuickCheck+import           Test.QuickCheck.Arbitrary+import           Test.QuickCheck.Gen  import           Network.MPD.Commands.Types  import           Data.ByteString (ByteString) import qualified Data.ByteString.UTF8 as UTF8 + instance Arbitrary ByteString where-  arbitrary = UTF8.fromString <$> arbitrary+  arbitrary = UTF8.fromString <$> listOf1 arbitraryPrintableChar  -- No longer provided by QuickCheck 2 -- two :: Monad m => m a -> m (a, a)@@ -46,7 +49,7 @@  -- MPD fields can't contain newlines and the parser skips initial spaces. field :: Gen String-field = (filter (/= '\n') . dropWhile isSpace) <$> arbitrary+field = (filter (/= '\n') . dropWhile isSpace) <$> listOf1 arbitraryPrintableChar  fieldBS :: Gen ByteString fieldBS = UTF8.fromString <$> field

@@ -41,25 +41,25 @@ -- 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_parseIso8601 :: UTCTime -> Expectation+prop_parseIso8601 t = Just t `shouldBe` (parseIso8601 . UTF8.fromString . formatIso8601) t -prop_parseCount :: Count -> Bool-prop_parseCount c = Right c == (parseCount . map UTF8.fromString . lines . unparse) c+prop_parseCount :: Count -> Expectation+prop_parseCount c = Right c `shouldBe` (parseCount . map UTF8.fromString . lines . unparse) c -prop_parseOutputs :: [Device] -> Bool+prop_parseOutputs :: [Device] -> Expectation prop_parseOutputs ds =-    Right ds == (parseOutputs . map UTF8.fromString . lines . concatMap unparse) ds+    Right ds `shouldBe` (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+prop_parseSong :: Song -> Expectation+prop_parseSong s = Right (sortTags s) `shouldBe` 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+prop_parseStats :: Stats -> Expectation+prop_parseStats s = Right s `shouldBe` (parseStats . map UTF8.fromString . lines . unparse) s

@@ -1,10 +1,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} {-# OPTIONS_GHC -Wwarn #-} --- | Module    : StringConn+-- |+-- Module      : StringConn -- Copyright   : (c) Ben Sinclair 2005-2009 -- License     : MIT (see LICENSE)--- Maintainer  : bsinclai@turing.une.edu.au -- Stability   : alpha -- -- A testing scaffold for MPD commands

@@ -0,0 +1,34 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module TypeSpec (main, spec) where++import           Test.Hspec+import           Test.Hspec.QuickCheck (prop)+import qualified Test.QuickCheck as QC++import           Network.MPD.Commands.Types (Volume)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+    describe "Volume arithmetic is closed over 0-100" $ do+        prop "for addition" prop_volume_add+        prop "for subtraction" prop_volume_sub+        prop "for multiplication" prop_volume_mul+        prop "for division" prop_volume_div++instance QC.Arbitrary Volume where+    arbitrary = QC.elements [0..100]++inRange :: Ord a => a -> a -> a -> Bool+inRange l h x = l <= x && x <= h++prop_volume_arith op cur new = inRange 0 100 ((cur :: Volume) `op` new)++prop_volume_add = prop_volume_arith (+)+prop_volume_sub = prop_volume_arith (-)+prop_volume_mul = prop_volume_arith (*)+prop_volume_div cur new = new /= 0 QC.==> prop_volume_arith div cur new

@@ -53,12 +53,16 @@         , "db_update: " ++ show (stsDbUpdate s)         ] +instance Unparse Volume where+    unparse (Volume x) = show x+ instance Unparse Status where     unparse s = unlines $         [ "state: " ++ (case stState s of Playing -> "play"                                           Paused  -> "pause"                                           _       -> "stop")-        , "volume: " ++ maybe "-1" show (stVolume s)+        , "volume: " ++ maybe "-1" unparse (stVolume s)+        , "volume: " ++ unparse (stVolume s)         , "repeat: " ++ showBool (stRepeat s)         , "random: " ++ showBool (stRandom s)         , "playlist: " ++ show (stPlaylistVersion s)