{- * 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)