mp-0.1.3: src/Mp/UI/PlaylistPage.hs
{-
* 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