{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Network.MPD.Core (
MonadMPD(..),
MPD, MPDError(..), ACKType(..), Response, Host, Port, Password,
withMPDEx,
getResponse, kill,
) where
import Network.MPD.Util
import Network.MPD.Core.Class
import Network.MPD.Core.Error
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 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
type Host = String
type Port = Integer
newtype MPD a =
MPD { MPD a
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD :: ErrorT MPDError
(StateT MPDState
(ReaderT (Host, Port) IO)) a
} deriving (a -> MPD b -> MPD a
(a -> b) -> MPD a -> MPD b
(forall a b. (a -> b) -> MPD a -> MPD b)
-> (forall a b. a -> MPD b -> MPD a) -> Functor MPD
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
<$ :: a -> MPD b -> MPD a
$c<$ :: forall a b. a -> MPD b -> MPD a
fmap :: (a -> b) -> MPD a -> MPD b
$cfmap :: forall a b. (a -> b) -> MPD a -> MPD b
Functor, Applicative MPD
a -> MPD a
Applicative MPD =>
(forall a b. MPD a -> (a -> MPD b) -> MPD b)
-> (forall a b. MPD a -> MPD b -> MPD b)
-> (forall a. a -> MPD a)
-> Monad MPD
MPD a -> (a -> MPD b) -> MPD b
MPD a -> MPD b -> MPD b
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 :: a -> MPD a
$creturn :: forall a. a -> MPD a
>> :: MPD a -> MPD b -> MPD b
$c>> :: forall a b. MPD a -> MPD b -> MPD b
>>= :: MPD a -> (a -> MPD b) -> MPD b
$c>>= :: forall a b. MPD a -> (a -> MPD b) -> MPD b
$cp1Monad :: Applicative MPD
Monad, Monad MPD
Monad MPD => (forall a. IO a -> MPD a) -> MonadIO MPD
IO a -> MPD a
forall a. IO a -> MPD a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> MPD a
$cliftIO :: forall a. IO a -> MPD a
$cp1MonadIO :: Monad MPD
MonadIO, MonadError MPDError)
instance Applicative MPD where
<*> :: MPD (a -> b) -> MPD a -> MPD b
(<*>) = MPD (a -> b) -> MPD a -> MPD b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
pure :: a -> MPD a
pure = a -> MPD a
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 = ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Host
-> MPD Host
forall a.
ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Host
-> MPD Host)
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Host
-> MPD Host
forall a b. (a -> b) -> a -> b
$ (MPDState -> Host)
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Host
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MPDState -> Host
stPassword
setPassword :: Host -> MPD ()
setPassword pw :: Host
pw = ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a.
ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ())
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a b. (a -> b) -> a -> b
$ (MPDState -> MPDState)
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: MPDState
st -> MPDState
st { stPassword :: Host
stPassword = Host
pw })
getVersion :: MPD (Int, Int, Int)
getVersion = ErrorT
MPDError
(StateT MPDState (ReaderT (Host, Port) IO))
(Int, Int, Int)
-> MPD (Int, Int, Int)
forall a.
ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ErrorT
MPDError
(StateT MPDState (ReaderT (Host, Port) IO))
(Int, Int, Int)
-> MPD (Int, Int, Int))
-> ErrorT
MPDError
(StateT MPDState (ReaderT (Host, Port) IO))
(Int, Int, Int)
-> MPD (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ (MPDState -> (Int, Int, Int))
-> ErrorT
MPDError
(StateT MPDState (ReaderT (Host, Port) IO))
(Int, Int, Int)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MPDState -> (Int, Int, Int)
stVersion
data MPDState =
MPDState { MPDState -> Maybe Handle
stHandle :: Maybe Handle
, MPDState -> Host
stPassword :: String
, MPDState -> (Int, Int, Int)
stVersion :: (Int, Int, Int)
}
type Response = Either MPDError
withMPDEx :: Host -> Port -> Password -> MPD a -> IO (Response a)
withMPDEx :: Host -> Port -> Host -> MPD a -> IO (Response a)
withMPDEx host :: Host
host port :: Port
port pw :: Host
pw x :: MPD a
x = IO (Response a) -> IO (Response a)
forall a. IO a -> IO a
withSocketsDo (IO (Response a) -> IO (Response a))
-> IO (Response a) -> IO (Response a)
forall a b. (a -> b) -> a -> b
$
ReaderT (Host, Port) IO (Response a)
-> (Host, Port) -> IO (Response a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT MPDState (ReaderT (Host, Port) IO) (Response a)
-> MPDState -> ReaderT (Host, Port) IO (Response a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> StateT MPDState (ReaderT (Host, Port) IO) (Response a)
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT (ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> StateT MPDState (ReaderT (Host, Port) IO) (Response a))
-> (MPD a
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a)
-> MPD a
-> StateT MPDState (ReaderT (Host, Port) IO) (Response a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPD a
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
forall a.
MPD a
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD (MPD a -> StateT MPDState (ReaderT (Host, Port) IO) (Response a))
-> MPD a -> StateT MPDState (ReaderT (Host, Port) IO) (Response a)
forall a b. (a -> b) -> a -> b
$ MPD ()
forall (m :: * -> *). MonadMPD m => m ()
open MPD () -> MPD a -> MPD a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (MPD a
x MPD a -> MPD () -> MPD a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* MPD ()
forall (m :: * -> *). MonadMPD m => m ()
close)) MPDState
initState)
(Host
host, Port
port)
where initState :: MPDState
initState = Maybe Handle -> Host -> (Int, Int, Int) -> MPDState
MPDState Maybe Handle
forall a. Maybe a
Nothing Host
pw (0, 0, 0)
mpdOpen :: MPD ()
mpdOpen :: MPD ()
mpdOpen = ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a.
ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ())
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a b. (a -> b) -> a -> b
$ do
(host :: Host
host, port :: Port
port) <- ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) (Host, Port)
forall r (m :: * -> *). MonadReader r m => m r
ask
MPD ()
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall a.
MPD a
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD MPD ()
forall (m :: * -> *). MonadMPD m => m ()
close
addr :: AddrInfo
addr:_ <- IO [AddrInfo]
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [AddrInfo]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AddrInfo]
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [AddrInfo])
-> IO [AddrInfo]
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [AddrInfo]
forall a b. (a -> b) -> a -> b
$ Host -> Port -> IO [AddrInfo]
forall a. Show a => Host -> a -> IO [AddrInfo]
getAddr Host
host Port
port
Socket
sock <- IO Socket
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Socket
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Socket
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Socket)
-> IO Socket
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Socket
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 <- IO (Maybe Handle)
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) (Maybe Handle)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Socket, SockAddr) -> IO (Maybe Handle)
safeConnectTo (Socket
sock,(AddrInfo -> SockAddr
addrAddress AddrInfo
addr)))
(MPDState -> MPDState)
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: MPDState
st -> MPDState
st { stHandle :: Maybe Handle
stHandle = Maybe Handle
mHandle })
Maybe Handle
-> (Handle
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ Maybe Handle
mHandle ((Handle
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> (Handle
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall a b. (a -> b) -> a -> b
$ \_ -> MPD Bool
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
forall a.
MPD a
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD MPD Bool
checkConn ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
-> (Bool
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`unless` MPD ()
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall a.
MPD a
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD MPD ()
forall (m :: * -> *). MonadMPD m => m ()
close)
where
getAddr :: Host -> a -> IO [AddrInfo]
getAddr addr :: Host
addr@('/':_) _ = [AddrInfo] -> IO [AddrInfo]
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
host port :: a
port = Maybe AddrInfo -> Maybe Host -> Maybe Host -> IO [AddrInfo]
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
defaultHints) (Host -> Maybe Host
forall a. a -> Maybe a
Just Host
host) (Host -> Maybe Host
forall a. a -> Maybe a
Just (Host -> Maybe Host) -> Host -> Maybe Host
forall a b. (a -> b) -> a -> b
$ a -> Host
forall a. Show a => a -> Host
show a
port)
safeConnectTo :: (Socket, SockAddr) -> IO (Maybe Handle)
safeConnectTo (sock :: Socket
sock,addr :: SockAddr
addr) =
(Socket -> SockAddr -> IO ()
connect Socket
sock SockAddr
addr) IO () -> IO (Maybe Handle) -> IO (Maybe Handle)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Handle -> Maybe Handle
forall a. a -> Maybe a
Just (Handle -> Maybe Handle) -> IO Handle -> IO (Maybe Handle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Socket -> IOMode -> IO Handle
socketToHandle Socket
sock IOMode
ReadWriteMode)
IO (Maybe Handle)
-> (SomeException -> IO (Maybe Handle)) -> IO (Maybe Handle)
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
`catchAny` IO (Maybe Handle) -> SomeException -> IO (Maybe Handle)
forall a b. a -> b -> a
const (Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
forall a. Maybe a
Nothing)
checkConn :: MPD Bool
checkConn = do
[ByteString]
singleMsg <- Host -> MPD [ByteString]
forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send ""
let [msg :: ByteString
msg] = [ByteString]
singleMsg
if "OK MPD" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
msg
then ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
-> MPD Bool
forall a.
ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
-> MPD Bool)
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
-> MPD Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Int, Int, Int)
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
forall (m :: * -> *).
(MonadError MPDError m, MonadState MPDState m) =>
Maybe (Int, Int, Int) -> m Bool
checkVersion (Maybe (Int, Int, Int)
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool)
-> Maybe (Int, Int, Int)
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (Int, Int, Int)
parseVersion ByteString
msg
else Bool -> MPD Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
checkVersion :: Maybe (Int, Int, Int) -> m Bool
checkVersion Nothing = MPDError -> m Bool
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MPDError -> m Bool) -> MPDError -> m Bool
forall a b. (a -> b) -> a -> b
$ Host -> MPDError
Custom "Couldn't determine MPD version"
checkVersion (Just version :: (Int, Int, Int)
version)
| (Int, Int, Int)
version (Int, Int, Int) -> (Int, Int, Int) -> Bool
forall a. Ord a => a -> a -> Bool
< (Int, Int, Int)
requiredVersion =
MPDError -> m Bool
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MPDError -> m Bool) -> MPDError -> m Bool
forall a b. (a -> b) -> a -> b
$ Host -> MPDError
Custom (Host -> MPDError) -> Host -> MPDError
forall a b. (a -> b) -> a -> b
$ Host -> Host -> Host -> Host
forall r. PrintfType r => Host -> r
printf
"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
(MPDState -> MPDState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: MPDState
st -> MPDState
st { stVersion :: (Int, Int, Int)
stVersion = (Int, Int, Int)
version })
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
where
requiredVersion :: (Int, Int, Int)
requiredVersion = (0, 15, 0)
parseVersion :: ByteString -> Maybe (Int, Int, Int)
parseVersion = Char
-> (ByteString -> Maybe Int) -> ByteString -> Maybe (Int, Int, Int)
forall a.
Char -> (ByteString -> Maybe a) -> ByteString -> Maybe (a, a, a)
parseTriple '.' ByteString -> Maybe Int
forall a. (Read a, Integral a) => ByteString -> Maybe a
parseNum (ByteString -> Maybe (Int, Int, Int))
-> (ByteString -> ByteString)
-> ByteString
-> Maybe (Int, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit)
formatVersion :: (Int, Int, Int) -> String
formatVersion :: (Int, Int, Int) -> Host
formatVersion (x :: Int
x, y :: Int
y, z :: Int
z) = Host -> Int -> Int -> Int -> Host
forall r. PrintfType r => Host -> r
printf "%d.%d.%d" Int
x Int
y Int
z
mpdClose :: MPD ()
mpdClose :: MPD ()
mpdClose =
ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a.
ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ())
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a b. (a -> b) -> a -> b
$ do
Maybe Handle
mHandle <- (MPDState -> Maybe Handle)
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) (Maybe Handle)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MPDState -> Maybe Handle
stHandle
Maybe Handle
-> (Handle
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ Maybe Handle
mHandle ((Handle
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> (Handle
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall a b. (a -> b) -> a -> b
$ \h :: Handle
h -> do
(MPDState -> MPDState)
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MPDState -> MPDState)
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> (MPDState -> MPDState)
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall a b. (a -> b) -> a -> b
$ \st :: MPDState
st -> MPDState
st{stHandle :: Maybe Handle
stHandle = Maybe Handle
forall a. Maybe a
Nothing}
Maybe MPDError
r <- IO (Maybe MPDError)
-> ErrorT
MPDError
(StateT MPDState (ReaderT (Host, Port) IO))
(Maybe MPDError)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe MPDError)
-> ErrorT
MPDError
(StateT MPDState (ReaderT (Host, Port) IO))
(Maybe MPDError))
-> IO (Maybe MPDError)
-> ErrorT
MPDError
(StateT MPDState (ReaderT (Host, Port) IO))
(Maybe MPDError)
forall a b. (a -> b) -> a -> b
$ Handle -> IO (Maybe MPDError)
sendClose Handle
h
Maybe MPDError
-> (MPDError
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Any)
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ Maybe MPDError
r MPDError
-> ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Any
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
where
sendClose :: Handle -> IO (Maybe MPDError)
sendClose handle :: Handle
handle =
(Handle -> Host -> IO ()
hPutStrLn Handle
handle "close" IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO Bool
hReady Handle
handle IO Bool -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hClose Handle
handle IO () -> IO (Maybe MPDError) -> IO (Maybe MPDError)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe MPDError -> IO (Maybe MPDError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MPDError
forall a. Maybe a
Nothing)
IO (Maybe MPDError)
-> (IOError -> IO (Maybe MPDError)) -> IO (Maybe MPDError)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` IOError -> IO (Maybe MPDError)
forall (m :: * -> *). Monad m => IOError -> m (Maybe MPDError)
handler
handler :: IOError -> m (Maybe MPDError)
handler err :: IOError
err
| IOError -> Bool
isEOFError IOError
err = Maybe MPDError -> m (Maybe MPDError)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MPDError
forall a. Maybe a
Nothing
| Bool
otherwise = (Maybe MPDError -> m (Maybe MPDError)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe MPDError -> m (Maybe MPDError))
-> (IOError -> Maybe MPDError) -> IOError -> m (Maybe MPDError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MPDError -> Maybe MPDError
forall a. a -> Maybe a
Just (MPDError -> Maybe MPDError)
-> (IOError -> MPDError) -> IOError -> Maybe MPDError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> MPDError
ConnectionError) IOError
err
mpdSend :: String -> MPD [ByteString]
mpdSend :: Host -> MPD [ByteString]
mpdSend str :: Host
str = MPD [ByteString]
send' MPD [ByteString]
-> (MPDError -> MPD [ByteString]) -> MPD [ByteString]
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 err :: MPDError
err
| ConnectionError e :: IOError
e <- MPDError
err, IOError -> Bool
isRetryable IOError
e = MPD ()
mpdOpen MPD () -> MPD [ByteString] -> MPD [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MPD [ByteString]
send'
| Bool
otherwise = MPDError -> MPD [ByteString]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MPDError
err
send' :: MPD [ByteString]
send' :: MPD [ByteString]
send' = ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
-> MPD [ByteString]
forall a.
ErrorT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
-> MPD [ByteString])
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
-> MPD [ByteString]
forall a b. (a -> b) -> a -> b
$ (MPDState -> Maybe Handle)
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) (Maybe Handle)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets MPDState -> Maybe Handle
stHandle ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) (Maybe Handle)
-> (Maybe Handle
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString])
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
-> (Handle
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString])
-> Maybe Handle
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MPDError
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MPDError
NoMPD) Handle
-> ErrorT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
forall (m :: * -> *).
(MonadIO m, MonadState MPDState m, MonadError MPDError m) =>
Handle -> m [ByteString]
go
go :: Handle -> m [ByteString]
go handle :: Handle
handle = (IO (Either IOError [ByteString]) -> m (Either IOError [ByteString])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOError [ByteString])
-> m (Either IOError [ByteString]))
-> (IO [ByteString] -> IO (Either IOError [ByteString]))
-> IO [ByteString]
-> m (Either IOError [ByteString])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [ByteString] -> IO (Either IOError [ByteString])
forall a. IO a -> IO (Either IOError a)
tryIOError (IO [ByteString] -> m (Either IOError [ByteString]))
-> IO [ByteString] -> m (Either IOError [ByteString])
forall a b. (a -> b) -> a -> b
$ do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Host -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Host
str) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
B.hPutStrLn Handle
handle (Host -> ByteString
UTF8.fromString Host
str) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
handle
Handle -> [ByteString] -> IO [ByteString]
getLines Handle
handle [])
m (Either IOError [ByteString])
-> (Either IOError [ByteString] -> m [ByteString])
-> m [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IOError -> m [ByteString])
-> ([ByteString] -> m [ByteString])
-> Either IOError [ByteString]
-> m [ByteString]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\err :: IOError
err -> (MPDState -> MPDState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\st :: MPDState
st -> MPDState
st { stHandle :: Maybe Handle
stHandle = Maybe Handle
forall a. Maybe a
Nothing })
m () -> m [ByteString] -> m [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MPDError -> m [ByteString]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (IOError -> MPDError
ConnectionError IOError
err)) [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return
getLines :: Handle -> [ByteString] -> IO [ByteString]
getLines :: Handle -> [ByteString] -> IO [ByteString]
getLines handle :: Handle
handle acc :: [ByteString]
acc = do
ByteString
l <- Handle -> IO ByteString
B.hGetLine Handle
handle
if "OK" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
l Bool -> Bool -> Bool
|| "ACK" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
l
then ([ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> IO [ByteString])
-> ([ByteString] -> [ByteString])
-> [ByteString]
-> IO [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse) (ByteString
lByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)
else Handle -> [ByteString] -> IO [ByteString]
getLines Handle
handle (ByteString
lByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc)
isRetryable :: E.IOException -> Bool
isRetryable :: IOError -> Bool
isRetryable e :: IOError
e = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ IOError -> Bool
isEOFError IOError
e, IOError -> Bool
isResourceVanished IOError
e ]
isResourceVanished :: GE.IOException -> Bool
isResourceVanished :: IOError -> Bool
isResourceVanished e :: IOError
e = IOError -> IOErrorType
ioeGetErrorType IOError
e IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
== IOErrorType
GE.ResourceVanished
kill :: (MonadMPD m) => m ()
kill :: m ()
kill = Host -> m [ByteString]
forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send "kill" m [ByteString] -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
getResponse :: (MonadMPD m) => String -> m [ByteString]
getResponse :: Host -> m [ByteString]
getResponse cmd :: Host
cmd = (Host -> m [ByteString]
forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send Host
cmd m [ByteString]
-> ([ByteString] -> m [ByteString]) -> m [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ByteString] -> m [ByteString]
forall (m :: * -> *).
MonadError MPDError m =>
[ByteString] -> m [ByteString]
parseResponse) m [ByteString] -> (MPDError -> m [ByteString]) -> m [ByteString]
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` MPDError -> m [ByteString]
forall (m :: * -> *). MonadMPD m => MPDError -> m [ByteString]
sendpw
where
sendpw :: MPDError -> m [ByteString]
sendpw e :: MPDError
e@(ACK Auth _) = do
Host
pw <- m Host
forall (m :: * -> *). MonadMPD m => m Host
getPassword
if Host -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Host
pw then MPDError -> m [ByteString]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MPDError
e
else Host -> m [ByteString]
forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send ("password " Host -> Host -> Host
forall a. [a] -> [a] -> [a]
++ Host
pw) m [ByteString]
-> ([ByteString] -> m [ByteString]) -> m [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ByteString] -> m [ByteString]
forall (m :: * -> *).
MonadError MPDError m =>
[ByteString] -> m [ByteString]
parseResponse
m [ByteString] -> m [ByteString] -> m [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Host -> m [ByteString]
forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send Host
cmd m [ByteString]
-> ([ByteString] -> m [ByteString]) -> m [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ByteString] -> m [ByteString]
forall (m :: * -> *).
MonadError MPDError m =>
[ByteString] -> m [ByteString]
parseResponse
sendpw e :: MPDError
e =
MPDError -> m [ByteString]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MPDError
e
parseResponse :: (MonadError MPDError m) => [ByteString] -> m [ByteString]
parseResponse :: [ByteString] -> m [ByteString]
parseResponse xs :: [ByteString]
xs
| [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
xs = MPDError -> m [ByteString]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MPDError -> m [ByteString]) -> MPDError -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ MPDError
NoMPD
| "ACK" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
x = MPDError -> m [ByteString]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MPDError -> m [ByteString]) -> MPDError -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> MPDError
parseAck ByteString
x
| Bool
otherwise = [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.takeWhile ("OK" ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/=) [ByteString]
xs
where
x :: ByteString
x = [ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
xs
parseAck :: ByteString -> MPDError
parseAck :: ByteString -> MPDError
parseAck s :: ByteString
s = ACKType -> Host -> MPDError
ACK ACKType
ack (ByteString -> Host
UTF8.toString ByteString
msg)
where
ack :: ACKType
ack = case Int
code of
2 -> ACKType
InvalidArgument
3 -> ACKType
InvalidPassword
4 -> ACKType
Auth
5 -> ACKType
UnknownCommand
50 -> ACKType
FileNotFound
51 -> ACKType
PlaylistMax
52 -> ACKType
System
53 -> ACKType
PlaylistLoad
54 -> ACKType
Busy
55 -> ACKType
NotPlaying
56 -> ACKType
FileExists
_ -> ACKType
UnknownACK
(code :: Int
code, _, msg :: ByteString
msg) = ByteString -> (Int, ByteString, ByteString)
splitAck ByteString
s
splitAck :: ByteString -> (Int, ByteString, ByteString)
splitAck :: ByteString -> (Int, ByteString, ByteString)
splitAck s :: ByteString
s = (ByteString -> Int
forall a. Read a => ByteString -> a
read ByteString
code, ByteString
cmd, ByteString
msg)
where
(code :: ByteString
code, notCode :: ByteString
notCode) = Char -> Char -> ByteString -> (ByteString, ByteString)
between '[' '@' ByteString
s
(cmd :: ByteString
cmd, notCmd :: ByteString
notCmd) = Char -> Char -> ByteString -> (ByteString, ByteString)
between '{' '}' ByteString
notCode
msg :: ByteString
msg = Int -> ByteString -> ByteString
drop 1 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
dropWhile (' ' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) ByteString
notCmd
between :: Char -> Char -> ByteString -> (ByteString, ByteString)
between a :: Char
a b :: Char
b xs :: ByteString
xs = let (_, y :: ByteString
y) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
a) ByteString
xs
in (Char -> Bool) -> ByteString -> (ByteString, ByteString)
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
b) (Int -> ByteString -> ByteString
drop 1 ByteString
y)