QueuePage.hs

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

module Mp.UI.QueuePage (
    QueuePageClass,
    QueuePage,
    castToQueuePage,
    queuePageNew
) where

import           Control.Lens        (ix, makeLensesFor, (^?))
import           Control.Monad
import           Control.Monad.Catch
import qualified Graphics.Vty        as Vty
import           Simple.UI.All

import           Mp.Player.Client
import           Mp.UI.MpData
import           Mp.Utils.Utils

data QueuePage = QueuePage
        { _queuePageParent    :: Widget
        , _queuePageSongIndex :: Attribute Int
        }

makeLensesFor [("_queuePageParent", "queuePageParent")] ''QueuePage

class QueuePageClass w where
    castToQueuePage :: w -> QueuePage

instance QueuePageClass QueuePage where
    castToQueuePage = id

instance WidgetClass QueuePage where
    castToWidget = _queuePageParent

    overrideWidget = overrideWidgetHelper queuePageParent

queuePageNew :: UIApp MpData QueuePage
queuePageNew = do
    mpData <- view appUserData
    songIndex <- attributeNew (-1 :: Int)

    textListView <- textListViewNew $ \item index -> do
        files <- readAttr (mpData ^. mpSongList)
        i <- readAttr songIndex
        case files ^? ix index of
            Just song -> do
                let (_, s) = separateFilePath song
                set item text $ Just s
                set item itemData $ Just index
                if i == index
                    then do
                        set item colorForeground $ mpData ^. mpColors . queueSelectedForeground
                        set item colorStyle DrawStyleBold
                    else do
                        set item colorForeground $ mpData ^. mpColors . queueForeground
                        set item colorStyle DrawStyleNormal
            Nothing -> do
                set item text Nothing
                set item itemData Nothing

    let queue = overrideWidget
                      QueuePage { _queuePageParent = castToWidget textListView
                                , _queuePageSongIndex = songIndex
                                }
                      $ virtualWidgetName .= "queuepage"

    set queue colorForeground $ mpData ^. mpColors . queueForeground
    set queue colorBackground $ mpData ^. mpColors . queueBackground
    set queue colorBackgroundSelected $ mpData ^. mpColors . queueActiveBackground

    on_ textListView textItemActivated $ \item -> do
        maybeIndex <- get item itemData
        forM_ maybeIndex (catchIgnoreAll . clientSendSetPlaying)

    getColors queue >>= setColors textListView

    on_ queue keyPressed $ \key _ ->
        case key of
            Vty.KChar 'p' -> catchIgnoreAll $ do
                (status, _, _) <- clientSendGetStatus
                case status of
                    "Paused"  -> clientSendResumePlaying
                    "Playing" -> clientSendPausePlaying
                    _         -> error "QueuePage.hs:105: Internal error."

            Vty.KChar 's' ->
                catchIgnoreAll clientSendStopPlaying

            Vty.KChar 'c' ->
                catchIgnoreAll $ do
                    clientSendClear
                    liftUIApp mpData $ readFullStatusFromServer queue

            Vty.KChar 'l' ->
                centerQueue mpData textListView

            Vty.KChar '>' -> do
                catchIgnoreAll clientSendPlayNext
                centerQueue mpData textListView

            Vty.KChar '<' -> do
                catchIgnoreAll clientSendPlayPrev
                centerQueue mpData textListView

            Vty.KChar 'f' ->
                catchIgnoreAll clientSendSeekForward

            Vty.KChar 'b' ->
                catchIgnoreAll clientSendSeekBackward

            Vty.KChar 'r' ->
                catchIgnoreAll clientSendToggleRepeat

            Vty.KChar 'z' ->
                catchIgnoreAll clientSendToggleShuffle

            Vty.KChar '[' ->
                catchIgnoreAll clientSendVolumeDown

            Vty.KChar ']' ->
                catchIgnoreAll clientSendVolumeUp

            Vty.KChar 'd' -> do
                viewIndex <- textListViewGetPos textListView
                when (viewIndex >= 0) $ do
                    files <- readAttr (mpData ^. mpSongList)
                    void $ liftUIApp mpData $ mpSongRemove (files !! viewIndex)
                    clientSendRemove viewIndex
                    textListViewUpdate textListView

            _ ->
                return ()

    readFullStatusFromServer queue
    scheduleIndexFromServer queue

    return queue
  where
    readFullStatusFromServer = readFullStatusFromServer' (100 :: Int)

    readFullStatusFromServer' 0 _ = return ()
    readFullStatusFromServer' counter queuePage =
        catchAll
            (do
                items <- clientSendGetPlaylist
                index <- clientSendGetPlaying
                set queuePage _queuePageSongIndex index
                mpSongInit items)
            (\_ -> do
                mpData <- view appUserData
                mainScheduleAfter 100 $
                    liftUIApp mpData $ readFullStatusFromServer' (counter - 1) queuePage)

    scheduleIndexFromServer queuePage = mainScheduleRepeat 200 $
        catchIgnoreAll $ do
            index <- clientSendGetPlaying
            set queuePage _queuePageSongIndex index

    centerQueue mpData textListView = catchIgnoreAll $ do
        files <- readAttr (mpData ^. mpSongList)
        index <- clientSendGetPlaying
        textListViewCenterAt textListView index (length files)