{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : Network.MPD.Applicative.Connection
Copyright   : (c) Joachim Fasting 2012
License     : MIT

Maintainer  : joachifm@fastmail.fm
Stability   : stable
Portability : unportable

Connection settings.
-}

module Network.MPD.Applicative.Connection
    ( password
    , ping
    ) where

import           Network.MPD.Applicative.Internal
import           Network.MPD.Core

-- | Authenticate session. The password is sent in plain text.
password :: Password -> Command ()
password :: Password -> Command ()
password Password
pwd = Parser () -> [Password] -> Command ()
forall a. Parser a -> [Password] -> Command a
Command Parser ()
emptyResponse [Password
"password " Password -> Password -> Password
forall a. [a] -> [a] -> [a]
++ Password
pwd]

-- | Ping daemon.
ping :: Command ()
ping :: Command ()
ping = Parser () -> [Password] -> Command ()
forall a. Parser a -> [Password] -> Command a
Command Parser ()
emptyResponse [Password
"ping"]