PlaylistPage.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 #-}
{-# LANGUAGE ViewPatterns    #-}

module Mp.UI.PlaylistPage (
    PlaylistPageClass,
    PlaylistPage,
    castToPlaylistPage,
    playlistPageNew,
    playlistPageUpdate
) where

import           Control.Lens                   (ix, makeLensesFor, (^?))
import           Control.Monad
import           Control.Monad.IO.Class
import           Data.List                      (isSuffixOf, sort)
import qualified Graphics.Vty                   as Vty
import           Simple.UI.All
import           System.Directory               (doesFileExist,
                                                 getDirectoryContents,
                                                 removeFile)
import           System.FilePath.Posix          ((</>))

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

data PlaylistView = PlaylistViewPlaylist
                  | PlaylistViewSongs
                  deriving Eq

data PlaylistPage = PlaylistPage
        { _playlistPageParent  :: Widget
        , _playlistPageContent :: Attribute [String]
        , _playlistPageState   :: Attribute PlaylistView
        }

makeLensesFor [("_playlistPageParent", "playlistPageParent")] ''PlaylistPage

class PlaylistPageClass w where
    castToPlaylistPage :: w -> PlaylistPage

    playlistPageUpdate :: w -> UIApp u ()
    playlistPageUpdate (castToPlaylistPage -> playlistPage) = do
        state <- get playlistPage _playlistPageState
        when (state == PlaylistViewPlaylist) $ do
            files <- fileList
            set playlistPage _playlistPageContent files

instance PlaylistPageClass PlaylistPage where
    castToPlaylistPage = id

instance WidgetClass PlaylistPage where
    castToWidget = _playlistPageParent

    overrideWidget = overrideWidgetHelper playlistPageParent

playlistPageNew :: UIApp MpData PlaylistPage
playlistPageNew = do
    mpData <- view appUserData
    playlistState <- attributeNew PlaylistViewPlaylist
    files <- fileList
    content <- attributeNew files
    savedPos <- attributeNew 0

    textListView <- textListViewNew $ \item index -> do
        state <- readAttr playlistState
        case state of
            PlaylistViewPlaylist -> liftUIApp mpData $ viewPlaylistsCallback content item index
            PlaylistViewSongs    -> liftUIApp mpData $ viewSongsCallback content item index

    on_ textListView textItemActivated $ \item -> do
        state <- readAttr playlistState
        case state of
            PlaylistViewPlaylist -> viewSongs textListView item content playlistState savedPos

            PlaylistViewSongs -> viewPlaylist textListView content playlistState savedPos

    on_ textListView keyPressed $ \key modifiers -> do
        state <- readAttr playlistState
        index <- textListViewGetPos textListView
        case key of
            Vty.KChar '!' ->
                when (state == PlaylistViewSongs) $
                    viewPlaylist textListView content playlistState savedPos

            Vty.KChar '@' ->
                when (state == PlaylistViewSongs) $
                    viewPlaylist textListView content playlistState savedPos

            Vty.KChar ' ' -> do
                _files <- readAttr content
                let file = _files !! index
                case state of
                    PlaylistViewPlaylist -> liftUIApp mpData $ playlistPageAddPlaylist file
                    PlaylistViewSongs    -> liftUIApp mpData $ playlistPageAddSong file
                textListViewGoDown textListView

            Vty.KChar 'd' | Vty.MCtrl `elem` modifiers ->
                when (state == PlaylistViewPlaylist) $ do
                    _files <- readAttr content
                    dir <- liftIO playlistDirFilePath

                    liftIO $ removeFile (dir </> (_files !! index))
                    writeAttr content $ removeAt index _files

            Vty.KChar 'd' -> do
                _files <- readAttr content
                let file = _files !! index
                case state of
                    PlaylistViewPlaylist -> liftUIApp mpData $ playlistPageRemovePlaylist file
                    PlaylistViewSongs    -> liftUIApp mpData $ playlistPageRemoveSong file
                textListViewGoDown textListView

            _ ->
                return ()

    let playlist = overrideWidget
                      PlaylistPage { _playlistPageParent = castToWidget textListView
                                   , _playlistPageContent = content
                                   , _playlistPageState = playlistState
                                   }
                      $ virtualWidgetName .= "playlistpage"

    set playlist colorForeground $ mpData ^. mpColors . playlistForeground
    set playlist colorBackground $ mpData ^. mpColors . playlistBackground
    set playlist colorBackgroundSelected $ mpData ^. mpColors . playlistActiveBackground

    return playlist
  where
    playlistPageAddPlaylist file = do
        dir <- liftIO playlistDirFilePath
        playlist <- songListRead (dir </> file)
        forM_ playlist playlistPageAddSong

    playlistPageRemovePlaylist file = do
        dir <- liftIO playlistDirFilePath
        playlist <- songListRead (dir </> file)
        forM_ playlist playlistPageRemoveSong

    playlistPageAddSong file =
        unless ("/.." `isSuffixOf` file) $ do
            mpSongAdd file
            clientSendAddFile file

    playlistPageRemoveSong file =
        unless ("/.." `isSuffixOf` file) $ do
            songInList <- mpSongExists file
            when songInList $ do
                listIndex <- mpSongRemove file
                clientSendRemove listIndex

fileList :: MonadIO m => m [String]
fileList = liftIO $ do
    dir <- playlistDirFilePath
    content <- getDirectoryContents dir
    sort <$> filterM (isFile dir) content

isFile :: String -> String -> IO Bool
isFile dir file = doesFileExist $ dir </> file

viewPlaylistsCallback :: Attribute [String] -> TextItem String -> Int -> UIApp MpData ()
viewPlaylistsCallback content item index = do
    mpData <- view appUserData
    files <- readAttr content
    case files ^? ix index of
        Just file -> do
            set item text $ Just file
            set item itemData Nothing
            set item colorStyle DrawStyleBold
            set item colorForeground $ mpData ^. mpColors . playlistForeground
        Nothing -> do
            set item text Nothing
            set item itemData Nothing

viewSongsCallback :: Attribute [String] -> TextItem String -> Int -> UIApp MpData ()
viewSongsCallback content item index = do
    mpData <- view appUserData
    files <- readAttr content
    case files ^? ix index of
        Just file -> do
            let (_, s) = separateFilePath file
            set item text $ Just s
            set item itemData $ Just file
            if "/.." `isSuffixOf` file
                then do
                    set item colorStyle DrawStyleBold
                    set item colorForeground $ mpData ^. mpColors . playlistForeground
                else do
                    set item colorStyle DrawStyleNormal
                    songExists <- mpSongExists file
                    if songExists
                        then set item colorForeground $ mpData ^. mpColors . playlistSelectedForeground
                        else set item colorForeground $ mpData ^. mpColors . playlistFileForeground

        Nothing -> do
            set item text Nothing
            set item itemData Nothing

viewSongs :: TextListView String -> TextItem String -> Attribute [String] -> Attribute PlaylistView -> Attribute Int -> UIApp' ()
viewSongs textListView item content playlistState savedPos = do
    writeAttr playlistState PlaylistViewSongs
    pos <- textListViewGetPos textListView
    writeAttr savedPos pos

    dir <- liftIO playlistDirFilePath
    file <- get item text
    c <- case file of
        Just f  -> songListRead (dir </> f)
        Nothing -> return []
    writeAttr content ((dir </> "..") : c)
    textListViewReset textListView

viewPlaylist :: TextListView String -> Attribute [String] -> Attribute PlaylistView -> Attribute Int -> UIApp' ()
viewPlaylist textListView content playlistState savedPos = do
    writeAttr playlistState PlaylistViewPlaylist
    f <- fileList
    writeAttr content f
    pos <- readAttr savedPos
    textListViewCenterAt textListView pos (length f)