Client.hs

{-  
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2014 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

module Mp.Player.Client (
    clientSendQuitMessage,
    clientSendAddFile,
    clientSendRemove,
    clientSendClear,
    clientSendGetPlaylist,
    clientSendGetStatus,
    clientSendSetPlaying,
    clientSendGetPlaying,
    clientSendStopPlaying,
    clientSendPausePlaying,
    clientSendResumePlaying,
    clientSendPlayNext,
    clientSendPlayPrev,
    clientSendVolumeUp,
    clientSendVolumeDown,
    clientSendVolumeGet,
    clientSendSeekForward,
    clientSendSeekBackward,
    clientSendGetFlags,
    clientSendToggleRepeat,
    clientSendToggleShuffle,
    clientSendSaveState
) where

import System.FilePath.Posix
import Network.Socket hiding (send, sendTo, recv, recvFrom)

import Mp.Configuration.Configuration
import Mp.Utils.Network

withConnection :: (Socket -> IO a) -> IO a
withConnection action = do
    confPath <- configDirFilePath
    let socName = confPath </> "mp.socket"

    sock <- socket AF_UNIX Stream defaultProtocol
    connect sock $ SockAddrUnix socName

    value <- action sock

    close sock
    return value

sendMessage :: String -> Socket -> IO String
sendMessage msg sock = do
    sendString sock msg     -- send message
    rval <- recvString sock -- receive answer
    return rval

sendMessage_ :: String -> Socket -> IO ()
sendMessage_ msg sock = sendMessage msg sock >> return ()

clientSendQuitMessage :: IO ()
clientSendQuitMessage = withConnection $ sendMessage_ "Quit"

clientSendAddFile :: String -> IO ()
clientSendAddFile file = do
    withConnection $ \conn -> do
        sendMessage_ "Add" conn
        sendMessage_ file conn

clientSendRemove :: Int -> IO ()
clientSendRemove index = do
    withConnection $ \conn -> do
        sendMessage_ "Remove" conn
        sendMessage_ (show index) conn

clientSendClear :: IO ()
clientSendClear = withConnection $ sendMessage_ "Clear"

clientSendGetPlaylist :: IO [String]
clientSendGetPlaylist = do
    withConnection $ \conn -> do
        item <- sendMessage "GetPlaylist" conn
        if item == "EndPlaylist"
            then return []
            else processMessages [item] conn
    where
        processMessages xs conn = do
            item <- sendMessage "Get" conn
            if (item == "EndPlaylist")
                then return xs
                else processMessages (item : xs) conn

clientSendGetStatus :: IO (String, Integer, Integer)
clientSendGetStatus = do
    withConnection $ \conn -> do
        status <- sendMessage "GetStatus" conn
        dur    <- sendMessage "GetDuration" conn
        pos    <- sendMessage "GetPosition" conn
        return (status, (read dur :: Integer), (read pos :: Integer))

clientSendSetPlaying :: Int -> IO ()
clientSendSetPlaying index = do
    withConnection $ \conn -> do
        sendMessage_ "SetPlay" conn
        sendMessage_ (show index) conn

clientSendGetPlaying :: IO Int
clientSendGetPlaying = do
    withConnection $ \conn -> do
        index <- sendMessage "GetPlay" conn
        return (read index :: Int)

clientSendStopPlaying :: IO ()
clientSendStopPlaying = withConnection $ sendMessage_ "Stop"

clientSendPausePlaying :: IO ()
clientSendPausePlaying = withConnection $ sendMessage_ "Pause"

clientSendResumePlaying :: IO ()
clientSendResumePlaying = withConnection $ sendMessage_ "Resume"

clientSendPlayNext :: IO ()
clientSendPlayNext = withConnection $ sendMessage_ "Next"

clientSendPlayPrev :: IO ()
clientSendPlayPrev = withConnection $ sendMessage_ "Prev"

clientSendVolumeUp :: IO ()
clientSendVolumeUp = withConnection $ sendMessage_ "VolUp"

clientSendVolumeDown :: IO ()
clientSendVolumeDown = withConnection $ sendMessage_ "VolDown"

clientSendVolumeGet :: IO String
clientSendVolumeGet = withConnection $ sendMessage "VolGet"

clientSendSeekForward :: IO ()
clientSendSeekForward = withConnection $ sendMessage_ "SeekForward"

clientSendSeekBackward :: IO ()
clientSendSeekBackward = withConnection $ sendMessage_ "SeekBackward"

clientSendGetFlags :: IO String
clientSendGetFlags = withConnection $ sendMessage "GetFlags"

clientSendToggleRepeat :: IO ()
clientSendToggleRepeat = withConnection $ sendMessage_ "ToggleRepeat"

clientSendToggleShuffle :: IO ()
clientSendToggleShuffle = withConnection $ sendMessage_ "ToggleShuffle"

clientSendSaveState :: IO ()
clientSendSaveState = withConnection $ sendMessage_ "SaveState"