    {-# 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 -> 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

    -- | 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 = 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, port) <- ExceptT
      MPDError (StateT MPDState (ReaderT (Host, Port) IO)) (Host, Port)
    forall r (m :: * -> *). MonadReader r m => m r
    ask
        runMPD close
        addr:_ <- liftIO $ getAddr host port
        sock <- liftIO $ socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
        mHandle <- liftIO (safeConnectTo (sock,(addrAddress addr)))
        modify (\MPDState
    st -> MPDState
    st { stHandle = mHandle })
        F.forM_ mHandle $ \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]
    forall (t :: * -> *).
    GetAddrInfo t =>
    Maybe AddrInfo -> Maybe Host -> Maybe Host -> IO (t 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
                singleMsg <- Host -> MPD [ByteString]
    forall (m :: * -> *). MonadMPD m => Host -> m [ByteString]
    send Host
    ""
                let [msg] = singleMsg
                if "OK MPD" `isPrefixOf` msg
                    then MPD $ checkVersion $ parseVersion msg
                    else return 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
            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
            F.forM_ mHandle $ \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}
              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
              F.forM_ r 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
                l <- Handle -> IO ByteString
    B.hGetLine Handle
    handle
                if "OK" `isPrefixOf` l || "ACK" `isPrefixOf` l
                    then (return . reverse) (l:acc)
                    else getLines handle (l:acc)

    -- | Re-connect and retry for these Exceptions.
    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 ]

    -- | 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 IOErrorType -> IOErrorType -> Bool
    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 = 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 ()

    -- | 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 = (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
                pw <- m Host
    forall (m :: * -> *). MonadMPD m => m Host
    getPassword
                if null pw then throwError e
                    else send ("password " ++ pw) >>= parseResponse
                      >> send cmd >>= 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

    -- 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
        | [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

    -- 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 = (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

            -- 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 (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)