{- * 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 -} {-# LANGUAGE OverloadedStrings #-} module Mp.UI.PlaylistPage ( PlaylistPage (..), PlaylistPageWidget, makeUIPlaylistPage ) where import qualified Data.HashMap.Strict as Map import qualified Data.Binary as B import qualified Data.Text as T import Control.Concurrent import Control.Monad import Data.ConfigFile import Data.Maybe import Graphics.Vty.Widgets.All import Graphics.Vty hiding (Button) import System.FilePath.Posix import System.Directory import Mp.Utils.Colors import Mp.Utils.Exception import Mp.Utils.Utils import Mp.Configuration.Configuration import Mp.UI.PlaylistState import Mp.UI.QueuePage type PlaylistPageWidget = Widget (List String FormattedText) data PlaylistPage = PlaylistPage { playlistPageWidget :: PlaylistPageWidget, playlistPageFocusGroup :: Widget FocusGroup, playlistAdd :: Bool -> String -> [String] -> IO (), playlistReset :: IO () } data PlaylistState = PlaylistState { playlistNames :: ![String], playlistMap :: Map.HashMap String [String], index :: !Int } makeUIPlaylistPage :: ConfigParser -> QueuePage -> IO PlaylistPage makeUIPlaylistPage conf queuePage = do playlistState <- newMVar PlaylistState { playlistNames = [], playlistMap = Map.empty, index = -1 } fg <- newFocusGroup lst <- newList (playlistActiveAttribute conf) 1 >>= withPlaylistBgAttribute conf _ <- addToFocusGroup fg lst _ <- addToFocusGroup fg lst let keyHandler = \_ k ms -> case k of KASCII ' ' -> do maybeSel <- getSelected lst st <- readMVar playlistState when (isJust maybeSel) $ do let (idx, (value, item)) = fromJust maybeSel _ <- withPlaylistSelectedAttribute conf item if (index st == -1) then do let maybePlaylist = Map.lookup value $ playlistMap st when (isJust maybePlaylist) $ forM_ (fromJust maybePlaylist) $ \path -> do let (dir, file) = separateFilePath path queuePageAdd queuePage dir file else do let maybePlaylist = Map.lookup (playlistNames st !! index st) $ playlistMap st when (isJust maybePlaylist) $ do let (dir, file) = separateFilePath $ (fromJust maybePlaylist) !! pred idx queuePageAdd queuePage dir file setSelected lst $ succ idx return True KASCII 'd' -> do st <- readMVar playlistState maybeSel <- getSelected lst when (isJust maybeSel) $ do let (idx, (value, item)) = fromJust maybeSel if any (MCtrl == ) ms then -- remove playlist when (index st == -1) $ playlistRemoveAndDelete playlistState lst idx else do -- delete from queue list if (index st == -1) then do _ <- withPlaylistNameAttribute conf item let maybePlaylist = Map.lookup value $ playlistMap st when (isJust maybePlaylist) $ forM_ (fromJust maybePlaylist) $ \path -> do let (dir, file) = separateFilePath path queuePageRemove queuePage dir file else do _ <- withPlaylistFileAttribute conf item let maybePlaylist = Map.lookup (playlistNames st !! index st) $ playlistMap st when (isJust maybePlaylist) $ do let (dir, file) = separateFilePath $ (fromJust maybePlaylist) !! pred idx queuePageRemove queuePage dir file setSelected lst $ succ idx return True KASCII '!' -> do modifyMVar_ playlistState $ \st -> do if index st == -1 then return st else do showNames lst st setSelected lst $ index st return st { index = -1 } return True KASCII '@' -> do modifyMVar_ playlistState $ \st -> do if index st == -1 then return st else do showNames lst st setSelected lst $ index st return st { index = -1 } return True KEnter -> do maybeSel <- getSelected lst when (isJust maybeSel) $ do let (idx, (value, _)) = fromJust maybeSel if (and [value == "..", idx == 0]) then modifyMVar_ playlistState $ \st -> do showNames lst st setSelected lst $ index st return st { index = -1 } else modifyMVar_ playlistState $ \st -> do if (index st == -1) then do showFiles lst st value return st { index = idx } else return st return True _ -> return False lst `onKeyPressed` keyHandler readPlaylist playlistState lst return PlaylistPage { playlistPageWidget = lst, playlistPageFocusGroup = fg, playlistAdd = playlistAddAndSave playlistState lst, playlistReset = reset playlistState lst } where addNameTo widget name = addToList widget name =<< (plainText (T.pack name) >>= withPlaylistNameAttribute conf) addFileTo widget name = addToList widget name =<< (plainText (T.pack name) >>= withPlaylistFileAttribute conf) reset playlistState widget = do st <- readMVar playlistState maybeSel <- getSelected widget if (index st == -1) then showNames widget st else showFiles widget st (playlistNames st !! index st) when (isJust maybeSel) $ do let (sel, _) = fromJust maybeSel setSelected widget sel showNames widget st = do clearList widget forM_ (playlistNames st) $ addNameTo widget showFiles widget st name = do clearList widget addNameTo widget ".." let maybePlaylist = Map.lookup name $ playlistMap st when (isJust maybePlaylist) $ forM_ (fromJust maybePlaylist) $ \path -> do let (_, file) = separateFilePath path addFileTo widget file playlistAddState playlistState widget name list = do modifyMVar_ playlistState $ \st -> do when (index st == -1) $ addNameTo widget name return st { playlistNames = playlistNames st ++ [name], playlistMap = Map.insert name list $ playlistMap st } playlistAddAndSave playlistState widget overwrite name list = when (not $ null name) $ do when (not overwrite) $ do playlistAddState playlistState widget name list cfgDir <- configDirFilePath plsDir <- playlistDirFilePath playlistSave playlistState cfgDir plsDir name list playlistSave playlistState cfgDir plsDir name list = do st <- readMVar playlistState B.encodeFile (cfgDir "playlists.state") (NameList $ playlistNames st) B.encodeFile (plsDir name) $ SongList list playlistRemoveAndDelete playlistState widget idx = do cfgDir <- configDirFilePath plsDir <- playlistDirFilePath st <- readMVar playlistState _ <- removeFromList widget idx playlistDelete playlistState cfgDir plsDir $ playlistNames st !! idx playlistRemoveState playlistState idx playlistRemoveState playlistState idx = do modifyMVar_ playlistState $ \st -> do let name = playlistNames st !! idx return st { playlistNames = removeAt idx $ playlistNames st, playlistMap = Map.delete name $ playlistMap st } playlistDelete playlistState cfgDir plsDir name = do st <- readMVar playlistState B.encodeFile (cfgDir "playlists.state") (NameList $ playlistNames st) removeFile (plsDir name) readPlaylist playlistState widget = do cfgDir <- configDirFilePath plsDir <- playlistDirFilePath maybeNames <- try' (B.decodeFile (cfgDir "playlists.state") :: IO NameList) when (isJust maybeNames) $ do forM_ (nameListGet $ fromJust maybeNames) $ \name -> do maybePlaylist <- try' (B.decodeFile (plsDir name) :: IO SongList) when (isJust maybePlaylist) $ do playlistAddState playlistState widget name $ songListGet $ fromJust maybePlaylist