{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Module    : Network.MPD.Core
-- Copyright   : (c) Ben Sinclair 2005-2009, Joachim Fasting 2010
-- License     : MIT (see LICENSE)
-- Maintainer  : Joachim Fasting <joachifm@fastmail.fm>
-- Stability   : alpha
--
-- The core datatypes and operations are defined here, including the
-- primary instance of the 'MonadMPD' class, 'MPD'.

module Network.MPD.Core (
    -- * Classes
    MonadMPD(..),
    -- * Data types
    MPD, MPDError(..), ACKType(..), Response, Host, Port, Password,
    -- * Running
    withMPDEx,
    -- * Interacting
    getResponse, kill,
    ) where

import           Network.MPD.Util
import           Network.MPD.Core.Class
import           Network.MPD.Core.Error

import           Data.Char (isDigit)
import qualified Control.Exception as E
import           Control.Exception.Safe (catch, catchAny)
import           Control.Monad (ap, unless)
import           Control.Monad.Except (ExceptT(..),runExceptT, MonadError(..))
import           Control.Monad.Reader (ReaderT(..), ask)
import           Control.Monad.State (StateT, MonadIO(..), modify, gets, evalStateT)
import qualified Data.Foldable as F
import           System.IO (IOMode(..))
import Network.Socket
  ( Family(..)
  , SockAddr(..)
  , SocketType(..)
  , 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)
import qualified GHC.IO.Exception as GE

import qualified Prelude
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
--
-- Data types.
--

type Host = String
type Port = Integer

--
-- IO based MPD client implementation.
--

-- | The main implementation of an MPD client.  It actually connects
--   to a server and interacts with it.
--
-- To use the error throwing\/catching capabilities:
--
-- > import Control.Monad.Except (throwError, catchError)
--
-- To run IO actions within the MPD monad:
--
-- > import Control.Monad.Trans (liftIO)

newtype MPD a =
    MPD { forall a.
MPD a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD :: ExceptT MPDError
                    (StateT MPDState
                     (ReaderT (Host, Port) IO)) a
        } deriving (forall a b. a -> MPD b -> MPD a
forall a b. (a -> b) -> MPD a -> MPD b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MPD b -> MPD a
$c<$ :: forall a b. a -> MPD b -> MPD a
fmap :: forall a b. (a -> b) -> MPD a -> MPD b
$cfmap :: forall a b. (a -> b) -> MPD a -> MPD b
Functor, Applicative MPD
forall a. a -> MPD a
forall a b. MPD a -> MPD b -> MPD b
forall a b. MPD a -> (a -> MPD b) -> MPD b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> MPD a
$creturn :: forall a. a -> MPD a
>> :: forall a b. MPD a -> MPD b -> MPD b
$c>> :: forall a b. MPD a -> MPD b -> MPD b
>>= :: forall a b. MPD a -> (a -> MPD b) -> MPD b
$c>>= :: forall a b. MPD a -> (a -> MPD b) -> MPD b
Monad, Monad MPD
forall a. IO a -> MPD a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> MPD a
$cliftIO :: forall a. IO a -> MPD a
MonadIO, MonadError MPDError)

instance Applicative MPD where
    <*> :: forall a b. MPD (a -> b) -> MPD a -> MPD b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
    pure :: forall a. a -> MPD a
pure  = forall (m :: * -> *) a. Monad m => a -> m a
return

instance MonadMPD MPD where
    open :: MPD ()
open  = MPD ()
mpdOpen
    close :: MPD ()
close = MPD ()
mpdClose
    send :: Host -> MPD [ByteString]
send  = Host -> MPD [ByteString]
mpdSend
    getPassword :: MPD Host
getPassword    = forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MPDState -> Host
stPassword
    setPassword :: Host -> MPD ()
setPassword Host
pw = forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\MPDState
st -> MPDState
st { stPassword :: Host
stPassword = Host
pw })
    getVersion :: MPD (Int, Int, Int)
getVersion     = forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MPDState -> (Int, Int, Int)
stVersion

-- | Inner state for MPD
data MPDState =
    MPDState { MPDState -> Maybe Handle
stHandle   :: Maybe Handle
             , MPDState -> Host
stPassword :: String
             , MPDState -> (Int, Int, Int)
stVersion  :: (Int, Int, Int)
             }

-- | A response is either an 'MPDError' or some result.
type Response = Either MPDError

-- | The most configurable API for running an MPD action.
withMPDEx :: Host -> Port -> Password -> MPD a -> IO (Response a)
withMPDEx :: forall a. Host -> Port -> Host -> MPD a -> IO (Response a)
withMPDEx Host
host Port
port Host
pw MPD a
x = forall a. IO a -> IO a
withSocketsDo forall a b. (a -> b) -> a -> b
$
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
MPD a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadMPD m => m ()
open forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (MPD a
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). MonadMPD m => m ()
close)) MPDState
initState)
               (Host
host, Port
port)
    where initState :: MPDState
initState = Maybe Handle -> Host -> (Int, Int, Int) -> MPDState
MPDState forall a. Maybe a
Nothing Host
pw (Int
0, Int
0, Int
0)

mpdOpen :: MPD ()
mpdOpen :: MPD ()
mpdOpen = forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD forall a b. (a -> b) -> a -> b
$ do
    (Host
host, Port
port) <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall a.
MPD a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD forall (m :: * -> *). MonadMPD m => m ()
close
    AddrInfo
addr:[AddrInfo]
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall {a}. Show a => Host -> a -> IO [AddrInfo]
getAddr Host
host Port
port
    Socket
sock <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
addr) (AddrInfo -> SocketType
addrSocketType AddrInfo
addr) (AddrInfo -> ProtocolNumber
addrProtocol AddrInfo
addr)
    Maybe Handle
mHandle <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Socket, SockAddr) -> IO (Maybe Handle)
safeConnectTo (Socket
sock,(AddrInfo -> SockAddr
addrAddress AddrInfo
addr)))
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\MPDState
st -> MPDState
st { stHandle :: Maybe Handle
stHandle = Maybe Handle
mHandle })
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ Maybe Handle
mHandle forall a b. (a -> b) -> a -> b
$ \Handle
_ -> forall a.
MPD a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD MPD Bool
checkConn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`unless` forall a.
MPD a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD forall (m :: * -> *). MonadMPD m => m ()
close)
    where
        getAddr :: Host -> a -> IO [AddrInfo]
getAddr addr :: Host
addr@(Char
'/':Host
_) a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return [
                AddrInfo
defaultHints { addrFamily :: Family
addrFamily = Family
AF_UNIX
                             , addrSocketType :: SocketType
addrSocketType = SocketType
Stream
                             , addrAddress :: SockAddr
addrAddress = Host -> SockAddr
SockAddrUnix Host
addr
                             }
            ]

        getAddr Host
host a
port = Maybe AddrInfo -> Maybe Host -> Maybe Host -> IO [AddrInfo]
getAddrInfo (forall a. a -> Maybe a
Just AddrInfo
defaultHints) (forall a. a -> Maybe a
Just Host
host) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Host
show a
port)

        safeConnectTo :: (Socket, SockAddr) -> IO (Maybe Handle)
safeConnectTo (Socket
sock,SockAddr
addr) =
            (Socket -> SockAddr -> IO ()
connect Socket
sock SockAddr
addr) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> IOMode -> IO Handle
socketToHandle Socket
sock IOMode
ReadWriteMode)
            forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
`catchAny` forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
        checkConn :: MPD Bool
checkConn = do
            [ByteString]
singleMsg <- forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send Host
""
            let [ByteString
msg] = [ByteString]
singleMsg
            if ByteString
"OK MPD" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
msg
                then forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}.
(MonadError MPDError m, MonadState MPDState m) =>
Maybe (Int, Int, Int) -> m Bool
checkVersion forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (Int, Int, Int)
parseVersion ByteString
msg
                else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

        checkVersion :: Maybe (Int, Int, Int) -> m Bool
checkVersion Maybe (Int, Int, Int)
Nothing = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Host -> MPDError
Custom Host
"Couldn't determine MPD version"
        checkVersion (Just (Int, Int, Int)
version)
            | (Int, Int, Int)
version forall a. Ord a => a -> a -> Bool
< (Int, Int, Int)
requiredVersion =
                forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Host -> MPDError
Custom forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => Host -> r
printf
                    Host
"MPD %s is not supported, upgrade to MPD %s or above!"
                    ((Int, Int, Int) -> Host
formatVersion (Int, Int, Int)
version) ((Int, Int, Int) -> Host
formatVersion (Int, Int, Int)
requiredVersion)
            | Bool
otherwise = do
                forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\MPDState
st -> MPDState
st { stVersion :: (Int, Int, Int)
stVersion = (Int, Int, Int)
version })
                forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
            where
                requiredVersion :: (Int, Int, Int)
requiredVersion = (Int
0, Int
19, Int
0)

        parseVersion :: ByteString -> Maybe (Int, Int, Int)
parseVersion = forall a.
Char -> (ByteString -> Maybe a) -> ByteString -> Maybe (a, a, a)
parseTriple Char
'.' forall a. (Read a, Integral a) => ByteString -> Maybe a
parseNum forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit)

        formatVersion :: (Int, Int, Int) -> String
        formatVersion :: (Int, Int, Int) -> Host
formatVersion (Int
x, Int
y, Int
z) = forall r. PrintfType r => Host -> r
printf Host
"%d.%d.%d" Int
x Int
y Int
z


mpdClose :: MPD ()
mpdClose :: MPD ()
mpdClose =
    forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD forall a b. (a -> b) -> a -> b
$ do
        Maybe Handle
mHandle <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MPDState -> Maybe Handle
stHandle
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ Maybe Handle
mHandle forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
          forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \MPDState
st -> MPDState
st{stHandle :: Maybe Handle
stHandle = forall a. Maybe a
Nothing}
          Maybe MPDError
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> IO (Maybe MPDError)
sendClose Handle
h
          forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ Maybe MPDError
r forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    where
        sendClose :: Handle -> IO (Maybe MPDError)
sendClose Handle
handle =
            (Handle -> Host -> IO ()
hPutStrLn Handle
handle Host
"close" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO Bool
hReady Handle
handle forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
handle forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
            forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` forall {m :: * -> *}. Monad m => IOError -> m (Maybe MPDError)
handler

        handler :: IOError -> m (Maybe MPDError)
handler IOError
err
            | IOError -> Bool
isEOFError IOError
err = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            | Bool
otherwise      = (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> MPDError
ConnectionError) IOError
err

mpdSend :: String -> MPD [ByteString]
mpdSend :: Host -> MPD [ByteString]
mpdSend Host
str = MPD [ByteString]
send' forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` MPDError -> MPD [ByteString]
handler
    where
        handler :: MPDError -> MPD [ByteString]
handler MPDError
err
          | ConnectionError IOError
e <- MPDError
err, IOError -> Bool
isRetryable IOError
e = MPD ()
mpdOpen forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MPD [ByteString]
send'
          | Bool
otherwise = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MPDError
err

        send' :: MPD [ByteString]
        send' :: MPD [ByteString]
send' = forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MPDState -> Maybe Handle
stHandle forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MPDError
NoMPD) forall {m :: * -> *}.
(MonadIO m, MonadState MPDState m, MonadError MPDError m) =>
Handle -> m [ByteString]
go

        go :: Handle -> m [ByteString]
go Handle
handle = (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> IO (Either IOError a)
tryIOError forall a b. (a -> b) -> a -> b
$ do
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Host
str) forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
B.hPutStrLn Handle
handle (Host -> ByteString
UTF8.fromString Host
str) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
handle
            Handle -> [ByteString] -> IO [ByteString]
getLines Handle
handle [])
                forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\IOError
err -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\MPDState
st -> MPDState
st { stHandle :: Maybe Handle
stHandle = forall a. Maybe a
Nothing })
                                 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (IOError -> MPDError
ConnectionError IOError
err)) forall (m :: * -> *) a. Monad m => a -> m a
return

        getLines :: Handle -> [ByteString] -> IO [ByteString]
        getLines :: Handle -> [ByteString] -> IO [ByteString]
getLines Handle
handle [ByteString]
acc = do
            ByteString
l <- Handle -> IO ByteString
B.hGetLine Handle
handle
            if ByteString
"OK" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
l Bool -> Bool -> Bool
|| ByteString
"ACK" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
l
                then (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse) (ByteString
lforall a. a -> [a] -> [a]
:[ByteString]
acc)
                else Handle -> [ByteString] -> IO [ByteString]
getLines Handle
handle (ByteString
lforall a. a -> [a] -> [a]
:[ByteString]
acc)

-- | Re-connect and retry for these Exceptions.
isRetryable :: E.IOException -> Bool
isRetryable :: IOError -> Bool
isRetryable IOError
e = forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ IOError -> Bool
isEOFError IOError
e, IOError -> Bool
isResourceVanished IOError
e ]

-- | Predicate to identify ResourceVanished exceptions.
-- Note: these are GHC only!
isResourceVanished :: GE.IOException -> Bool
isResourceVanished :: IOError -> Bool
isResourceVanished IOError
e = IOError -> IOErrorType
ioeGetErrorType IOError
e forall a. Eq a => a -> a -> Bool
== IOErrorType
GE.ResourceVanished

--
-- Other operations.
--

-- | Kill the server. Obviously, the connection is then invalid.
kill :: (MonadMPD m) => m ()
kill :: forall (m :: * -> *). MonadMPD m => m ()
kill = forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send Host
"kill" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Send a command to the MPD server and return the result.
getResponse :: (MonadMPD m) => String -> m [ByteString]
getResponse :: forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
getResponse Host
cmd = (forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send Host
cmd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
MonadError MPDError m =>
[ByteString] -> m [ByteString]
parseResponse) forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` forall {m :: * -> *}. MonadMPD m => MPDError -> m [ByteString]
sendpw
    where
        sendpw :: MPDError -> m [ByteString]
sendpw e :: MPDError
e@(ACK ACKType
Auth Host
_) = do
            Host
pw <- forall (m :: * -> *). MonadMPD m => m Host
getPassword
            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Host
pw then forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MPDError
e
                else forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send (Host
"password " forall a. [a] -> [a] -> [a]
++ Host
pw) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
MonadError MPDError m =>
[ByteString] -> m [ByteString]
parseResponse
                  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send Host
cmd forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
MonadError MPDError m =>
[ByteString] -> m [ByteString]
parseResponse
        sendpw MPDError
e =
            forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MPDError
e

-- Consume response and return a Response.
parseResponse :: (MonadError MPDError m) => [ByteString] -> m [ByteString]
parseResponse :: forall (m :: * -> *).
MonadError MPDError m =>
[ByteString] -> m [ByteString]
parseResponse [ByteString]
xs
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
xs                    = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ MPDError
NoMPD
    | ByteString
"ACK" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
x       = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ ByteString -> MPDError
parseAck ByteString
x
    | Bool
otherwise                  = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
Prelude.takeWhile (ByteString
"OK" forall a. Eq a => a -> a -> Bool
/=) [ByteString]
xs
    where
        x :: ByteString
x = forall a. [a] -> a
head [ByteString]
xs

-- Turn MPD ACK into the corresponding 'MPDError'
parseAck :: ByteString -> MPDError
parseAck :: ByteString -> MPDError
parseAck ByteString
s = ACKType -> Host -> MPDError
ACK ACKType
ack (ByteString -> Host
UTF8.toString ByteString
msg)
    where
        ack :: ACKType
ack = case Int
code of
                Int
2  -> ACKType
InvalidArgument
                Int
3  -> ACKType
InvalidPassword
                Int
4  -> ACKType
Auth
                Int
5  -> ACKType
UnknownCommand
                Int
50 -> ACKType
FileNotFound
                Int
51 -> ACKType
PlaylistMax
                Int
52 -> ACKType
System
                Int
53 -> ACKType
PlaylistLoad
                Int
54 -> ACKType
Busy
                Int
55 -> ACKType
NotPlaying
                Int
56 -> ACKType
FileExists
                Int
_  -> ACKType
UnknownACK
        (Int
code, ByteString
_, ByteString
msg) = ByteString -> (Int, ByteString, ByteString)
splitAck ByteString
s

-- Break an ACK into (error code, current command, message).
-- ACKs are of the form:
-- ACK [error@command_listNum] {current_command} message_text\n
splitAck :: ByteString -> (Int, ByteString, ByteString)
splitAck :: ByteString -> (Int, ByteString, ByteString)
splitAck ByteString
s = (forall a. Read a => ByteString -> a
read ByteString
code, ByteString
cmd, ByteString
msg)
    where
        (ByteString
code, ByteString
notCode) = Char -> Char -> ByteString -> (ByteString, ByteString)
between Char
'[' Char
'@' ByteString
s
        (ByteString
cmd, ByteString
notCmd)   = Char -> Char -> ByteString -> (ByteString, ByteString)
between Char
'{' Char
'}' ByteString
notCode
        msg :: ByteString
msg             = Int -> ByteString -> ByteString
drop Int
1 forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
dropWhile (Char
' ' forall a. Eq a => a -> a -> Bool
==) ByteString
notCmd

        -- take whatever is between 'f' and 'g'.
        between :: Char -> Char -> ByteString -> (ByteString, ByteString)
between Char
a Char
b ByteString
xs  = let (ByteString
_, ByteString
y) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
break (forall a. Eq a => a -> a -> Bool
== Char
a) ByteString
xs
                          in (Char -> Bool) -> ByteString -> (ByteString, ByteString)
break (forall a. Eq a => a -> a -> Bool
== Char
b) (Int -> ByteString -> ByteString
drop Int
1 ByteString
y)