{- * 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 -} module Mp.UI.BrowserPage ( BrowserPage (..), BrowserPageWidget, makeUIBrowserPage ) where import Graphics.Vty.Widgets.All import Graphics.Vty hiding (Button) import qualified Data.HashMap.Strict as Map import qualified Data.Text as T import Data.ConfigFile import Data.List import Data.Maybe import Data.Functor import System.Directory import System.FilePath.Posix import Control.Monad import Control.Concurrent import Mp.Utils.Colors import Mp.Utils.Exception import Mp.Utils.Utils import Mp.Configuration.Configuration import Mp.UI.QueuePage type BrowserPageWidget = Widget (List String FormattedText) data BrowserPage = BrowserPage { browserPageWidget :: BrowserPageWidget, browserPageFocusGroup :: Widget FocusGroup, browserPageReset :: IO () } data BrowserState = BrowserState { topDir :: !String, dirCache :: Map.HashMap String String } makeUIBrowserPage :: ConfigParser -> QueuePage -> IO BrowserPage makeUIBrowserPage conf queuePage = do fg <- newFocusGroup lst <- newList (browserActiveAttribute conf ) 1 >>= withBrowserBgAttribute conf let musicDir = getMusicDirectory conf setCurrentDirectory musicDir browserState <- newMVar BrowserState { topDir = musicDir, dirCache = Map.empty } addAllFilesToList lst musicDir _ <- addToFocusGroup fg lst _ <- addToFocusGroup fg lst let keyHandler = \_ k _ -> case k of KEnter -> do maybeSel <- getSelected lst let (_, (value, _)) = fromJust maybeSel modifyMVar_ browserState $ changeDirectory lst value return True KASCII '!' -> do modifyMVar_ browserState $ changeDirectory lst musicDir return True KASCII '@' -> do modifyMVar_ browserState $ changeDirectory lst ".." return True KASCII ' ' -> do selectCurrentFile lst return True KASCII 'd' -> do removeCurrentFile lst return True _ -> return False lst `onKeyPressed` keyHandler return BrowserPage { browserPageWidget = lst, browserPageFocusGroup = fg, browserPageReset = resetBrowser lst browserState } where addFileToList list text = addToList list text =<< (plainText (T.pack text) >>= withBrowserFileAttribute conf) addDirToList list text = addToList list text =<< (plainText (T.pack text) >>= withBrowserDirectoryAttribute conf) addAllFilesToList list dir = do clearList list files <- sort <$> getDirectoryContents dir forM_ files $ \file -> do exists <- doesDirectoryExist $ dir file when (and [exists, file /= "."]) $ addDirToList list file forM_ files $ \file -> do exists <- doesFileExist $ dir file when exists $ addFileToList list file changeDirectory list dir st = do let oldDir = topDir st ok <- try' $ setCurrentDirectory $ oldDir dir if (isJust ok) then do newDir <- getCurrentDirectory let newSt = if dir == ".." then st { topDir = newDir } else st { topDir = newDir, dirCache = Map.insert oldDir dir $ dirCache st } addAllFilesToList list newDir when (dir == "..") $ do let maybeVal = Map.lookup newDir $ dirCache newSt when (isJust maybeVal) $ do maybeIndex <- listFindFirst list $ fromJust maybeVal case maybeIndex of Just index -> setSelected list index Nothing -> return () return newSt else return st selectCurrentFile list = do maybeSel <- getSelected list when (isJust maybeSel) $ do let (index, (file, item)) = fromJust maybeSel currDir <- getCurrentDirectory when (currDir /= "..") $ do _ <- withBrowserSelectedAttribute conf item setSelected list $ succ index addAllFiles currDir file return () addAllFiles dir file | file == "." = return () | file == ".." = return () | otherwise = do exists <- doesDirectoryExist $ dir file if exists then do let newDir = dir file files <- try' (sort <$> getDirectoryContents newDir) when (isJust files) $ do forM_ (fromJust files) $ \f -> do addAllFiles newDir f else queuePageAdd queuePage dir file removeCurrentFile list = do maybeSel <- getSelected list when (isJust maybeSel) $ do let (index, (file, item)) = fromJust maybeSel currDir <- getCurrentDirectory when (currDir /= "..") $ do whenM (doesDirectoryExist $ currDir file) $ do _ <- withBrowserDirectoryAttribute conf item return () whenM (doesFileExist $ currDir file) $ do _ <- withBrowserFileAttribute conf item return () setSelected list $ succ index removeAllFiles currDir file return () removeAllFiles dir file | file == "." = return () | file == ".." = return () | otherwise = do exists <- doesDirectoryExist $ dir file if exists then do let newDir = dir file files <- try' (sort <$> getDirectoryContents newDir) when (isJust files) $ do forM_ (fromJust files) $ \f -> do removeAllFiles newDir f else queuePageRemove queuePage dir file resetBrowser widget browserState = do st <- readMVar browserState maybeSel <- getSelected widget addAllFilesToList widget $ topDir st when (isJust maybeSel) $ do let (sel, _) = fromJust maybeSel setSelected widget sel