{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2016 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
-}
{-# LANGUAGE MultiWayIf #-}

module Mp.Player.Server (
    startServerBlocking
) where

import qualified Control.Monad.State            as State
import qualified Data.Text                      as T
import qualified GI.Gst                         as G

import           Control.Concurrent
import           Control.Concurrent.Async
import           Control.Monad
import           Control.Monad.Catch
import           Control.Monad.Trans
import           Control.Monad.Trans.Resource
import           Data.Binary
import           Data.Maybe
import           Network.Socket
import           Simple.UI.Utils
import           System.Directory
import           System.FilePath.Posix
import           System.Random

import           Mp.Configuration.Configuration
import           Mp.Player.GstPlayer
import           Mp.Player.ServerState
import           Mp.Utils.Network
import           Mp.Utils.Shuffle

makeServerSocket :: MonadResource m => String -> m (ReleaseKey, Socket)
makeServerSocket socName = do
    (sockKey, sock) <- allocate (socket AF_UNIX Stream defaultProtocol) closeSocket
    liftIO $ bind sock $ SockAddrUnix socName
    liftIO $ listen sock 5
    return (sockKey, sock)
  where
    closeSocket sock = do
        close sock
        catchAll (removeFile socName) (const $ return ())

saveServerState :: MonadIO m => MVar ServerState -> m ()
saveServerState serverState = liftIO $ do
    cfgDir <- configDirFilePath
    state <- readMVar serverState
    encodeFile (cfgDir </> "server.state") state

saveServerIndex :: MonadIO m => Int -> m ()
saveServerIndex index = liftIO $ do
    cfgDir <- configDirFilePath
    encodeFile (cfgDir </> "server.index") (PlayingIndex index)

startServerBlocking :: MonadResource m => String -> m ()
startServerBlocking socName = do

    player <- initGstPlayer

    serverState <- readServerState player
    schedulePlayerInfo player serverState

    (sockKey, sock) <- makeServerSocket socName

    server <- liftIO $ async $ talkBlocking serverState player sock

    gstBusAddWatch player $ \_ message -> do
        messageType <- G.getMessageType message
        when (G.MessageTypeError `elem` messageType) $ do
            modifyMVar_ serverState $ flip modifyPlayerStop player
            (_, errText) <- G.messageParseError message
            putStrLn $ T.unpack errText
        when (G.MessageTypeEos `elem` messageType) $ playerPlay serverState player succ
        return True

    gstPlayerMainLoopBlocking player

    liftIO $ wait server

    release sockKey
  where
    readServerState player = liftIO $ do
        cfgDir <- configDirFilePath
        let file0 = cfgDir </> "server.state"
        let file1 = cfgDir </> "server.index"

        state0                <- readStateFromFile file0 :: IO ServerState
        (PlayingIndex index)  <- readIndexFromFile file1 :: IO PlayingIndex

        let state = state0 {
            getPlaying = index
        }
        stateVar <- newMVar state

        gstPlayerSetVolume player $ getVolume state

        when (getStatus state == "Playing") $
            catchAll
                (do
                    let f = getPlaylist state !! shuffleFunc state index
                    -- gstPlayerPlay adds play command to queue
                    -- need to force evaluation of f
                    gstPlayerPlay player $! f)
                (\_ -> do
                    newState <- modifyPlayerStop state player
                    modifyMVar_ stateVar $ const $ return newState)

        return stateVar

    schedulePlayerInfo player serverState =
        gstPlayerTimeoutAdd 100 $ do
            maybeInfo <- gstPlayerGetTimeInfo player
            if isJust maybeInfo then do
                let (pos, dur) = fromJust maybeInfo
                modifyMVar_ serverState $ \st ->
                    return st {
                        getCurrentPosition = pos,
                        getCurrentDuration = dur
                    }
            else
                modifyMVar_ serverState $ \st ->
                    return st {
                        getCurrentPosition = 0,
                        getCurrentDuration = 0
                    }
            return True

modifyPlayerStop :: ServerState -> GstPlayer -> IO ServerState
modifyPlayerStop st player = do
    saveServerIndex 0
    gstPlayerStop player
    return st {
        getCurrentPosition = 0,
        getCurrentDuration = 0,
        getPlaying = -1,
        getStatus = "Stopped"
    }

modifyPlayerPlay :: ServerState -> GstPlayer -> Int -> IO ServerState
modifyPlayerPlay st player index = do
    saveServerIndex index
    let list = getPlaylist st
    let (f, d) = if isShuffleMode st then
                     State.runState shuffleFunction $ shuffleData st
                 else
                    (id, shuffleData st)
    gstPlayerPlay player $ list !! f index
    return st {
        getPlaying = index,
        getStatus = "Playing",
        shuffleFunc = f,
        shuffleData = d
    }

playerPlay :: MonadIO m => MVar ServerState -> GstPlayer -> (Int -> Int) -> m ()
playerPlay serverState player indexFunction = liftIO $
    modifyMVar_ serverState $ \st -> do
        let list = getPlaylist st
        let index = indexFunction $ getPlaying st

        if index >= 0 && index < length list
            then
                modifyPlayerPlay st player index
            else
                if isRepeatMode st
                    then
                        if | null list            -> modifyPlayerStop st player
                           | index < 0            -> modifyPlayerPlay st player (length list - 1)
                           | index >= length list -> modifyPlayerPlay st player 0
                    else
                        modifyPlayerStop st player

talkBlocking :: MVar ServerState -> GstPlayer -> Socket -> IO ()
talkBlocking serverState player sock =
    processMessages `finally` shutdownServer
  where
    shutdownServer = do
        gstPlayerStop player
        gstPlayerQuit player

    processMessages = do
        (conn, _ ) <- accept sock

        msg <- talkServer conn `finally` close conn

        when (msg /= "Quit") processMessages

    talkServer conn = do
        msg <- liftIO $ recvString' conn

        case msg of
            "Add"           -> talkAdd serverState conn
            "Remove"        -> talkRemove serverState player conn
            "Clear"         -> talkClear serverState player conn
            "GetPlaylist"   -> talkGetPlaylist serverState conn
            "GetStatus"     -> talkGetStatus serverState conn
            "SetPlay"       -> talkSetPlay serverState conn player
            "GetPlay"       -> talkGetPlay serverState conn
            "Stop"          -> talkStop serverState conn player
            "Pause"         -> talkPause serverState conn player
            "Resume"        -> talkResume serverState conn player
            "Next"          -> talkNext serverState conn player
            "Prev"          -> talkPrev serverState conn player
            "SeekForward"   -> talkSeekForward serverState conn player
            "SeekBackward"  -> talkSeekBackward serverState conn player
            "VolUp"         -> talkVolumeUp serverState conn player
            "VolDown"       -> talkVolumeDown serverState conn player
            "VolGet"        -> talkVolumeGet serverState conn
            "GetFlags"      -> talkGetFlags serverState conn
            "ToggleRepeat"  -> talkToggleRepeat serverState conn
            "ToggleShuffle" -> talkToggleShuffle serverState player conn
            "SaveState"     -> talkSaveState serverState conn
            "Quit"          -> sendString conn "OK"
            _               -> sendString conn "NOK"

        return msg

talkSaveState :: MonadIO m => MVar ServerState -> Socket -> m ()
talkSaveState serverState conn = do
    sendString conn "OK"
    liftIO $ saveServerState serverState

talkGetPlaylist :: MonadIO m => MVar ServerState -> Socket -> m ()
talkGetPlaylist serverState conn = do
    list <- liftIO $ readMVar serverState
    forM_ (reverse $ getPlaylist list) $ \item -> do
        sendString conn item
        recvString_' conn

    sendString conn "EndPlaylist"

talkGetStatus :: MonadIO m => MVar ServerState -> Socket -> m ()
talkGetStatus serverState conn = do
    st <- liftIO $ readMVar serverState

    let status = getStatus st
    sendString conn status

    recvString_' conn
    let dur = getCurrentDuration st
    sendString conn $ show dur

    recvString_' conn
    let pos = getCurrentPosition st
    sendString conn $ show pos

talkSetPlay :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m ()
talkSetPlay serverState conn player = do
    sendString conn "OK"
    index <- recvString' conn
    sendString conn "OK"

    st <- liftIO $ readMVar serverState
    if isShuffleMode st
        then
            playerPlay serverState player $ const 0
        else
            playerPlay serverState player $ const (read index :: Int)

talkGetPlay :: MonadIO m => MVar ServerState -> Socket -> m ()
talkGetPlay serverState conn = do
    st <- liftIO $ readMVar serverState
    if getStatus st == "Stopped" then
        sendString conn "-1"
    else
        sendString conn $ show $ shuffleFunc st $ getPlaying st

talkAdd :: MonadIO m => MVar ServerState -> Socket -> m ()
talkAdd serverState conn = do
    sendString conn "OK"
    file <- recvString' conn
    sendString conn "OK"

    liftIO $ modifyMVar_ serverState $ \st -> do
        let (_, d) = State.runState shuffleAdd $ shuffleData st
        return st {
            getPlaylist = getPlaylist st ++ [file],
            shuffleData = d
        }

talkRemove :: MonadIO m => MVar ServerState -> GstPlayer -> Socket -> m ()
talkRemove serverState player conn = do
    sendString conn "OK"
    sIndex <- recvString' conn
    sendString conn "OK"

    st <- liftIO $ takeMVar serverState
    let shuffleEnabled = isShuffleMode st
    let playing = getPlaying st
    let index = read sIndex :: Int
    let (_, d) = State.runState shuffleRemove $ shuffleData st
    liftIO $ putMVar serverState $ update index playing d st

    when (shuffleEnabled || playing == index) $ playerPlay serverState player id

    where
        update index playing d st
            | index < playing  =
                  st {
                      getPlaying  = pred playing,
                      getPlaylist = removeAt index $ getPlaylist st,
                      shuffleData = d
                  }
            | otherwise =
                  st {
                      getPlaylist = removeAt index $ getPlaylist st,
                      shuffleData = d
                  }

talkClear :: MonadIO m => MVar ServerState -> GstPlayer -> Socket -> m ()
talkClear serverState player conn = do
    sendString conn "OK"
    liftIO $ gstPlayerStop player
    liftIO $ modifyMVar_ serverState (const $ return defaultServerState)

talkStop :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m ()
talkStop serverState conn player = do
    sendString conn "OK"
    liftIO $ modifyMVar_ serverState $ flip modifyPlayerStop player

talkPause :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m ()
talkPause serverState conn player = do
    sendString conn "OK"
    liftIO $ modifyMVar_ serverState $ \st -> do
        gstPlayerPause player
        return st {
            getStatus = "Paused"
        }

talkResume :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m ()
talkResume serverState conn player = do
    sendString conn "OK"
    liftIO $ modifyMVar_ serverState $ \st -> do
        gstPlayerResume player
        return st {
            getStatus = "Playing"
        }

talkNext :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m ()
talkNext serverState conn player = do
    sendString conn "OK"
    st <- liftIO $ takeMVar serverState
    let status = getStatus st
    let index  = succ $ getPlaying st
    let len    = length $ getPlaylist st
    let rpt    = isRepeatMode st
    liftIO $ putMVar serverState st

    if rpt then
        when (status == "Playing") $ playerPlay serverState player succ
    else
        when (status == "Playing" && index < len) $ playerPlay serverState player succ

talkPrev :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m ()
talkPrev serverState conn player = do
    sendString conn "OK"
    st <- liftIO $ takeMVar serverState
    let status = getStatus st
    let index  = pred $ getPlaying st
    let rpt    = isRepeatMode st
    liftIO $ putMVar serverState st

    if rpt then
        when (status == "Playing") $ playerPlay serverState player pred
    else
        when (status == "Playing" && index >= 0) $ playerPlay serverState player pred

talkVolumeUp :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m ()
talkVolumeUp serverState conn player = do
    sendString conn "OK"
    liftIO $ modifyMVar_ serverState $ \st -> do
        let vol0 = getVolume st + 0.04
        let vol1 = if vol0 > 1.0 then 1.0 else vol0
        gstPlayerSetVolume player vol1
        return st {
            getVolume = vol1
        }

talkVolumeDown :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m ()
talkVolumeDown serverState conn player = do
    sendString conn "OK"
    liftIO $ modifyMVar_ serverState $ \st -> do
        let vol0 = getVolume st - 0.04
        let vol1 = if vol0 < 0.0 then 0.0 else vol0
        gstPlayerSetVolume player vol1
        return st {
            getVolume = vol1
        }

talkVolumeGet :: MonadIO m => MVar ServerState -> Socket -> m ()
talkVolumeGet serverState conn = do
    st <- liftIO $ readMVar serverState
    let vol = ceiling $ getVolume st * 100 :: Int
    sendString conn $ show vol

talkSeekForward :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m ()
talkSeekForward serverState conn player = do
    sendString conn "OK"
    st <- liftIO $ readMVar serverState
    let pos0 = getCurrentPosition st + 15
    let pos1 = if pos0 > getCurrentDuration st then getCurrentDuration st else pos0
    liftIO $ gstPlayerSeek player pos1

talkSeekBackward :: MonadIO m => MVar ServerState -> Socket -> GstPlayer -> m ()
talkSeekBackward serverState conn player = do
    sendString conn "OK"
    st <- liftIO $ readMVar serverState
    let pos0 = getCurrentPosition st - 15
    let pos1 = if pos0 < 0 then 0 else pos0
    liftIO $ gstPlayerSeek player pos1

talkGetFlags :: MonadIO m => MVar ServerState -> Socket -> m ()
talkGetFlags serverState conn = do
    st <- liftIO $ readMVar serverState
    let r = if isRepeatMode st then 'r' else '-'
    let z = if isShuffleMode st then 'z' else '-'
    sendString conn [r, z]

talkToggleRepeat :: MonadIO m => MVar ServerState -> Socket -> m ()
talkToggleRepeat serverState conn = do
    sendString conn "OK"
    liftIO $ modifyMVar_ serverState $ \st ->
        return st {
            isRepeatMode = not $ isRepeatMode st
        }

talkToggleShuffle :: MonadIO m => MVar ServerState -> GstPlayer -> Socket -> m ()
talkToggleShuffle serverState player conn = do
    sendString conn "OK"

    shuffleEnabled <- liftIO $ modifyMVar serverState $ \st ->
        if isShuffleMode st then do
            newSt <- disableShuffle st
            return (newSt, False)
        else do
            newSt <- enableShuffle st
            return (newSt, getStatus st == "Playing")

    when shuffleEnabled $ playerPlay serverState player id

disableShuffle :: MonadIO m => ServerState -> m ServerState
disableShuffle st =
    return st {
        getPlaying = shuffleFunc st $ getPlaying st,
        isShuffleMode = False,
        shuffleFunc = id
    }

enableShuffle :: MonadIO m => ServerState -> m ServerState
enableShuffle st = do
    r <- liftIO randomIO
    let (f, d) = State.runState (shuffleFilled $ length $ getPlaylist st) $ shuffleInitial (mkStdGen r)
    return st {
        getPlaying = 0,
        isShuffleMode = True,
        randomInitializer = r,
        shuffleFunc = f,
        shuffleData = d
    }