{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings #-}
{-# 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 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
type Host = String
type Port = Integer
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 -> 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
$cfmap :: forall a b. (a -> b) -> MPD a -> MPD b
fmap :: forall a b. (a -> b) -> MPD a -> MPD b
$c<$ :: forall a b. a -> MPD b -> MPD a
<$ :: forall a b. a -> MPD b -> MPD a
Functor, Applicative MPD
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
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
$c>>= :: forall a b. MPD a -> (a -> MPD b) -> MPD b
>>= :: forall a b. MPD a -> (a -> MPD b) -> MPD b
$c>> :: forall a b. MPD a -> MPD b -> MPD b
>> :: forall a b. MPD a -> MPD b -> MPD b
$creturn :: forall a. a -> MPD a
return :: forall a. a -> MPD a
Monad, Monad MPD
Monad MPD => (forall a. IO a -> MPD a) -> MonadIO MPD
forall a. IO a -> MPD a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> MPD a
liftIO :: forall a. IO a -> MPD a
MonadIO, MonadError MPDError)
instance Applicative MPD where
<*> :: forall a b. 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 :: forall a. a -> MPD a
pure = a -> MPD a
forall a. 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 = ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Host
-> MPD Host
forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Host
-> MPD Host)
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Host
-> MPD Host
forall a b. (a -> b) -> a -> b
$ (MPDState -> Host)
-> ExceptT
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 Host
pw = ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ())
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a b. (a -> b) -> a -> b
$ (MPDState -> MPDState)
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\MPDState
st -> MPDState
st { stPassword = pw })
getVersion :: MPD (Int, Int, Int)
getVersion = ExceptT
MPDError
(StateT MPDState (ReaderT (Host, Port) IO))
(Int, Int, Int)
-> MPD (Int, Int, Int)
forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ExceptT
MPDError
(StateT MPDState (ReaderT (Host, Port) IO))
(Int, Int, Int)
-> MPD (Int, Int, Int))
-> ExceptT
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))
-> ExceptT
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 :: forall a. Host -> Port -> Host -> MPD a -> IO (Response a)
withMPDEx Host
host Port
port Host
pw 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 (ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> StateT MPDState (ReaderT (Host, Port) IO) (Response a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> StateT MPDState (ReaderT (Host, Port) IO) (Response a))
-> (MPD a
-> ExceptT 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
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
forall a.
MPD a
-> ExceptT 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 a b. MPD a -> MPD b -> MPD b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (MPD a
x MPD a -> MPD () -> MPD a
forall a b. MPD a -> MPD b -> 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 (Int
0, Int
0, Int
0)
mpdOpen :: MPD ()
mpdOpen :: MPD ()
mpdOpen = ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ())
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a b. (a -> b) -> a -> b
$ do
(Host
host, Port
port) <- ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) (Host, Port)
forall r (m :: * -> *). MonadReader r m => m r
ask
MPD ()
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall a.
MPD a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD MPD ()
forall (m :: * -> *). MonadMPD m => m ()
close
AddrInfo
addr:[AddrInfo]
_ <- IO [AddrInfo]
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [AddrInfo]
forall a.
IO a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AddrInfo]
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [AddrInfo])
-> IO [AddrInfo]
-> ExceptT
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
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Socket
forall a.
IO a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Socket
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Socket)
-> IO Socket
-> ExceptT
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)
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) (Maybe Handle)
forall a.
IO a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
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)
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\MPDState
st -> MPDState
st { stHandle = mHandle })
Maybe Handle
-> (Handle
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ExceptT 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
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> (Handle
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall a b. (a -> b) -> a -> b
$ \Handle
_ -> MPD Bool
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
forall a.
MPD a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
runMPD MPD Bool
checkConn ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
-> (Bool
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall a b.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> (a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) b)
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`unless` MPD ()
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall a.
MPD a
-> ExceptT 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@(Char
'/':Host
_) a
_ = [AddrInfo] -> IO [AddrInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [
AddrInfo
defaultHints { addrFamily = AF_UNIX
, addrSocketType = Stream
, addrAddress = SockAddrUnix addr
}
]
getAddr Host
host 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 (Socket
sock,SockAddr
addr) =
(Socket -> SockAddr -> IO ()
connect Socket
sock SockAddr
addr) IO () -> IO (Maybe Handle) -> IO (Maybe Handle)
forall a b. IO a -> IO b -> IO b
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.
(HasCallStack, 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 a. a -> IO a
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 Host
""
let [ByteString
msg] = [ByteString]
singleMsg
if ByteString
"OK MPD" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
msg
then ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
-> MPD Bool
forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
-> MPD Bool)
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool
-> MPD Bool
forall a b. (a -> b) -> a -> b
$ Maybe (Int, Int, Int)
-> ExceptT
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)
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Bool)
-> Maybe (Int, Int, Int)
-> ExceptT
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 a. a -> MPD a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
checkVersion :: Maybe (Int, Int, Int) -> m Bool
checkVersion Maybe (Int, Int, Int)
Nothing = MPDError -> m Bool
forall a. MPDError -> m a
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
"Couldn't determine MPD version"
checkVersion (Just (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 a. MPDError -> m a
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
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
(MPDState -> MPDState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\MPDState
st -> MPDState
st { stVersion = version })
Bool -> m Bool
forall a. a -> m a
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 = Char
-> (ByteString -> Maybe Int) -> ByteString -> Maybe (Int, Int, Int)
forall a.
Char -> (ByteString -> Maybe a) -> ByteString -> Maybe (a, a, a)
parseTriple Char
'.' 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 (Int
x, Int
y, Int
z) = Host -> Int -> Int -> Int -> Host
forall r. PrintfType r => Host -> r
printf Host
"%d.%d.%d" Int
x Int
y Int
z
mpdClose :: MPD ()
mpdClose :: MPD ()
mpdClose =
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ())
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
-> MPD ()
forall a b. (a -> b) -> a -> b
$ do
Maybe Handle
mHandle <- (MPDState -> Maybe Handle)
-> ExceptT
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
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ExceptT 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
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> (Handle
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
(MPDState -> MPDState)
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((MPDState -> MPDState)
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ())
-> (MPDState -> MPDState)
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) ()
forall a b. (a -> b) -> a -> b
$ \MPDState
st -> MPDState
st{stHandle = Nothing}
Maybe MPDError
r <- IO (Maybe MPDError)
-> ExceptT
MPDError
(StateT MPDState (ReaderT (Host, Port) IO))
(Maybe MPDError)
forall a.
IO a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe MPDError)
-> ExceptT
MPDError
(StateT MPDState (ReaderT (Host, Port) IO))
(Maybe MPDError))
-> IO (Maybe MPDError)
-> ExceptT
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
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Any)
-> ExceptT 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
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) Any
forall a.
MPDError
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
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" IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO Bool
hReady Handle
handle IO Bool -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe MPDError -> IO (Maybe MPDError)
forall a. a -> IO a
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.
(HasCallStack, 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 IOError
err
| IOError -> Bool
isEOFError IOError
err = Maybe MPDError -> m (Maybe MPDError)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MPDError
forall a. Maybe a
Nothing
| Bool
otherwise = (Maybe MPDError -> m (Maybe MPDError)
forall a. a -> m a
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 Host
str = MPD [ByteString]
send' MPD [ByteString]
-> (MPDError -> MPD [ByteString]) -> MPD [ByteString]
forall a. MPD a -> (MPDError -> MPD a) -> MPD a
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 MPD () -> MPD [ByteString] -> MPD [ByteString]
forall a b. MPD a -> MPD b -> MPD b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MPD [ByteString]
send'
| Bool
otherwise = MPDError -> MPD [ByteString]
forall a. MPDError -> MPD a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MPDError
err
send' :: MPD [ByteString]
send' :: MPD [ByteString]
send' = ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
-> MPD [ByteString]
forall a.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> MPD a
MPD (ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
-> MPD [ByteString])
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
-> MPD [ByteString]
forall a b. (a -> b) -> a -> b
$ (MPDState -> Maybe Handle)
-> ExceptT
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 ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) (Maybe Handle)
-> (Maybe Handle
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString])
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
forall a b.
ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
-> (a
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) b)
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
-> (Handle
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString])
-> Maybe Handle
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MPDError
-> ExceptT
MPDError (StateT MPDState (ReaderT (Host, Port) IO)) [ByteString]
forall a.
MPDError
-> ExceptT MPDError (StateT MPDState (ReaderT (Host, Port) IO)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MPDError
NoMPD) Handle
-> ExceptT
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 = (IO (Either IOError [ByteString]) -> m (Either IOError [ByteString])
forall a. IO a -> m a
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 a. [a] -> 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 a b. IO a -> IO b -> IO b
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 a b. m a -> (a -> m b) -> m b
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 (\IOError
err -> (MPDState -> MPDState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (\MPDState
st -> MPDState
st { stHandle = Nothing })
m () -> m [ByteString] -> m [ByteString]
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MPDError -> m [ByteString]
forall a. MPDError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (IOError -> MPDError
ConnectionError IOError
err)) [ByteString] -> m [ByteString]
forall a. a -> m a
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 ([ByteString] -> IO [ByteString]
forall a. a -> IO a
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 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 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 :: forall (m :: * -> *). MonadMPD m => m ()
kill = Host -> m [ByteString]
forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send Host
"kill" m [ByteString] -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
getResponse :: (MonadMPD m) => String -> m [ByteString]
getResponse :: forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
getResponse Host
cmd = (Host -> m [ByteString]
forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
send Host
cmd m [ByteString]
-> ([ByteString] -> m [ByteString]) -> m [ByteString]
forall a b. m a -> (a -> m b) -> m b
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 a. m a -> (MPDError -> m a) -> m a
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 ACKType
Auth Host
_) = do
Host
pw <- m Host
forall (m :: * -> *). MonadMPD m => m Host
getPassword
if Host -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Host
pw then MPDError -> m [ByteString]
forall a. MPDError -> m a
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 (Host
"password " Host -> Host -> Host
forall a. [a] -> [a] -> [a]
++ Host
pw) m [ByteString]
-> ([ByteString] -> m [ByteString]) -> m [ByteString]
forall a b. m a -> (a -> m b) -> m b
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 a b. m a -> m b -> m b
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 a b. m a -> (a -> m b) -> m b
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 MPDError
e =
MPDError -> m [ByteString]
forall a. MPDError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError MPDError
e
parseResponse :: (MonadError MPDError m) => [ByteString] -> m [ByteString]
parseResponse :: forall (m :: * -> *).
MonadError MPDError m =>
[ByteString] -> m [ByteString]
parseResponse [ByteString]
xs
| [ByteString] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
xs = MPDError -> m [ByteString]
forall a. MPDError -> m a
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
| ByteString
"ACK" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
x = MPDError -> m [ByteString]
forall a. MPDError -> m a
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 a. a -> m a
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 (ByteString
"OK" ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/=) [ByteString]
xs
where
x :: ByteString
x = [ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
head [ByteString]
xs
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
splitAck :: ByteString -> (Int, ByteString, ByteString)
splitAck :: ByteString -> (Int, ByteString, ByteString)
splitAck ByteString
s = (ByteString -> Int
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 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
dropWhile (Char
' ' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) ByteString
notCmd
between :: Char -> Char -> ByteString -> (ByteString, ByteString)
between Char
a Char
b ByteString
xs = let (ByteString
_, 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 Int
1 ByteString
y)