GTK: refactor refreshView a bit

This commit is contained in:
Julian Ospald 2016-06-01 23:58:34 +02:00
parent 89b231a2c9
commit 244a58d8c2
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
3 changed files with 22 additions and 75 deletions

View File

@ -185,7 +185,7 @@ setViewCallbacks mygui myview = do
goHome mygui myview
_ <- refreshViewB myview `on` buttonActivated $ do
cdir <- liftIO $ getCurrentDir myview
refreshView' mygui myview cdir
refreshView mygui myview cdir
-- key events
_ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
@ -194,7 +194,7 @@ setViewCallbacks mygui myview = do
cdir <- liftIO $ getCurrentDir myview
liftIO $ modifyTVarIO (settings mygui)
(\x -> x { showHidden = not . showHidden $ x})
>> refreshView' mygui myview cdir
>> refreshView mygui myview cdir
_ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
[Alt] <- eventModifier
"Up" <- fmap glibToString eventKeyName

View File

@ -26,14 +26,9 @@ module HSFM.GUI.Gtk.Callbacks.Utils where
import Control.Monad
(
forM
, forM_
forM_
, when
)
import Control.Monad.IO.Class
(
liftIO
)
import Data.Maybe
(
fromJust
@ -57,10 +52,6 @@ import HSFM.Utils.IO
modifyTVarIO
)
import Prelude hiding(readFile)
import Control.Concurrent.STM.TVar
(
readTVarIO
)
@ -115,7 +106,7 @@ goDir bhis mygui myview item = do
cdir <- getCurrentDir myview
when bhis $ modifyTVarIO (history myview)
(\(p, _) -> (path cdir `addHistory` p, []))
refreshView' mygui myview item
refreshView mygui myview item
-- set notebook tab label
page <- notebookGetCurrentPage (notebook mygui)

View File

@ -32,16 +32,11 @@ import Control.Concurrent.STM
newTVarIO
, readTVarIO
)
import Control.Exception
(
try
, SomeException
)
import Control.Monad
(
forM_
, unless
)
import qualified Data.ByteString as BS
import Data.Foldable
(
for_
@ -55,17 +50,8 @@ import Data.String
(
fromString
)
import HPath.IO.Errors
(
canOpenDirectory
)
import Graphics.UI.Gtk
import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setViewCallbacks)
import HPath
(
Path
, Abs
)
import qualified HPath as P
import HSFM.FileSystem.FileType
import HSFM.GUI.Glib.GlibString()
@ -89,11 +75,11 @@ import System.IO.Error
(
catchIOError
, ioError
, isUserError
)
import System.Posix.FilePath
(
pathSeparator
, hiddenFile
hiddenFile
)
@ -108,11 +94,12 @@ newTab mygui iofmv item = do
forM_ mpage $ \page -> notebookSetTabReorderable (notebook mygui)
page
True
catchIOError (refreshView' mygui myview item) $ \e -> do
catchIOError (refreshView mygui myview item) $ \e -> do
forM_ mpage $ \page -> do
refreshView mygui myview (P.parseAbs $ fromString "/")
file <- readFile getFileInfo . fromJust . P.parseAbs . fromString $ "/"
refreshView mygui myview file
notebookSetTabLabelText (notebook mygui) page "/"
ioError e
unless (isUserError e) (ioError e)
return myview
@ -208,7 +195,7 @@ switchView mygui myview iofmv = do
$ P.basename . path $ cwd) oldpage
notebookSetCurrentPage (notebook mygui) newpage
refreshView' mygui nview cwd
refreshView mygui nview cwd
-- |Destroys the current view by disconnecting the watcher
@ -305,49 +292,18 @@ createTreeView = do
return $ FMTreeView treeView
-- |Re-reads the current directory or the given one and updates the View.
-- This is more or less a wrapper around `refreshView'`
--
-- If the third argument is Nothing, it tries to re-read the current directory.
-- If that fails, it reads "/" instead.
--
-- If the third argument is (Just path) it tries to read "path". If that
-- fails, it reads "/" instead.
refreshView :: MyGUI
-> MyView
-> Maybe (Path Abs)
-> IO ()
refreshView mygui myview mfp =
case mfp of
Just fp -> do
canopen <- canOpenDirectory fp
if canopen
then refreshView' mygui myview =<< readFile getFileInfo fp
else refreshView mygui myview =<< getAlternativeDir
Nothing -> refreshView mygui myview =<< getAlternativeDir
where
getAlternativeDir = do
ecd <- try (getCurrentDir myview) :: IO (Either SomeException
Item)
case ecd of
Right dir -> return (Just $ path dir)
Left _ -> return (P.parseAbs $ BS.singleton pathSeparator)
-- |Refreshes the View based on the given directory.
--
-- If the directory is not a Dir or a Symlink pointing to a Dir, then
-- calls `refreshView` with the 3rd argument being Nothing.
-- Throws:
--
-- Does not do fallbacks if the directory cannot be read, but
-- throws an error.
refreshView' :: MyGUI
-- - `userError` on inappropriate type
refreshView :: MyGUI
-> MyView
-> Item
-> IO ()
refreshView' mygui myview SymLink { sdest = d@Dir{} } =
refreshView' mygui myview d
refreshView' mygui myview item@Dir{} = do
refreshView mygui myview SymLink { sdest = d@Dir{} } =
refreshView mygui myview d
refreshView mygui myview item@Dir{} = do
newRawModel <- fileListStore item myview
writeTVarIO (rawModel myview) newRawModel
@ -370,8 +326,7 @@ refreshView' mygui myview item@Dir{} = do
ntps <- mapM treeRowReferenceGetPath trs
mapM_ (treeSelectionSelectPath tvs) ntps
_ -> return ()
refreshView' mygui myview Failed{} = refreshView mygui myview Nothing
refreshView' _ _ _ = return ()
refreshView _ _ _ = ioError $ userError "Inappropriate type!"
-- |Constructs the visible View with the current underlying mutable models,
@ -403,7 +358,8 @@ constructView mygui myview = do
view' <- readTVarIO $ view myview
cdirp <- path <$> getCurrentDir myview
cdir <- getCurrentDir myview
let cdirp = path cdir
-- update urlBar
entrySetText (urlBar myview) (P.fromAbs cdirp)
@ -461,7 +417,7 @@ constructView mygui myview = do
newi
[Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
(P.fromAbs cdirp)
(\_ -> postGUIAsync $ refreshView mygui myview (Just $ cdirp))
(\_ -> postGUIAsync $ refreshView mygui myview cdir)
putMVar (inotify myview) newi
return ()