GTK: refactor updateTreeView

Move it to 'constructTreeView' and use 'refreshTreeView' instead
for updating the TreeView.
This commit is contained in:
Julian Ospald 2015-12-17 16:59:08 +01:00
parent 725744514b
commit 4227921402
No known key found for this signature in database
GPG Key ID: 220CD1C5BDEED020

View File

@ -48,6 +48,7 @@ import Data.Maybe
( (
fromJust fromJust
, catMaybes , catMaybes
, fromMaybe
) )
import Graphics.UI.Gtk import Graphics.UI.Gtk
import Graphics.UI.Gtk.Abstract.Box import Graphics.UI.Gtk.Abstract.Box
@ -156,7 +157,7 @@ setBindings mygui myview = do
"h" <- fmap glibToString eventKeyName "h" <- fmap glibToString eventKeyName
liftIO $ modifyTVarIO (settings mygui) liftIO $ modifyTVarIO (settings mygui)
(\x -> x { showHidden = not . showHidden $ x}) (\x -> x { showHidden = not . showHidden $ x})
>> updateTreeView mygui myview >> (refreshTreeView' mygui myview =<< readTVarIO (fsState myview))
_ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do _ <- rootWin mygui `on` keyPressEvent $ tryEvent $ do
[Alt] <- eventModifier [Alt] <- eventModifier
"Up" <- fmap glibToString eventKeyName "Up" <- fmap glibToString eventKeyName
@ -180,11 +181,7 @@ urlGoTo mygui myview = do
let abs = isAbsolute fp let abs = isAbsolute fp
exists <- (||) <$> doesDirectoryExist fp <*> doesFileExist fp exists <- (||) <$> doesDirectoryExist fp <*> doesFileExist fp
-- TODO: more explicit error handling? -- TODO: more explicit error handling?
when (abs && exists) $ do refreshTreeView mygui myview (Just fp)
newFsState <- readPath' fp
newRawModel <- fileListStore newFsState myview
writeTVarIO (rawModel myview) newRawModel
updateTreeView mygui myview
-- |Callback for file operations on a row, e.g. open, delete, etc. -- |Callback for file operations on a row, e.g. open, delete, etc.
@ -210,11 +207,8 @@ onRow fo mygui myview = do
_ -> return () _ -> return ()
where where
open row = case row of open row = case row of
(Dir {}, _) -> do (Dir {}, _) ->
newRawModel <- fileListStore row myview refreshTreeView' mygui myview row
rm <- readTVarIO (rawModel myview)
writeTVarIO (rawModel myview) newRawModel
updateTreeView mygui myview
dz@(File {}, _) -> dz@(File {}, _) ->
withErrorDialog $ openFile (getFullPath dz) withErrorDialog $ openFile (getFullPath dz)
_ -> return () _ -> return ()
@ -232,16 +226,12 @@ onRow fo mygui myview = do
-- |Go up one directory and visualize it in the treeView. -- |Go up one directory and visualize it in the treeView.
--
-- This will update the TVar `rawModel`.
upDir :: MyGUI -> MyView -> IO () upDir :: MyGUI -> MyView -> IO ()
upDir mygui myview = do upDir mygui myview = do
rawModel' <- readTVarIO $ rawModel myview rawModel' <- readTVarIO $ rawModel myview
sortedModel' <- readTVarIO $ sortedModel myview sortedModel' <- readTVarIO $ sortedModel myview
fS <- readTVarIO $ fsState myview fS <- readTVarIO $ fsState myview
newRawModel <- fileListStore (goUp fS) myview refreshTreeView' mygui myview (goUp fS)
writeTVarIO (rawModel myview) newRawModel
updateTreeView mygui myview
-- |Create the `ListStore` of files/directories from the current directory. -- |Create the `ListStore` of files/directories from the current directory.
@ -257,16 +247,56 @@ fileListStore dtz myview = do
listStoreNew (goAllDown dtz) listStoreNew (goAllDown dtz)
-- |Re-reads the current directory or the given one and updates the TreeView.
-- This means that the DTZipper is re-initialized.
-- If you can operate on the raw DTZipper directly, use `refreshTreeView'`
-- instead.
--
-- This also updates the TVar `rawModel`.
--
-- This throws exceptions via `dirSanityThrow` if the given/current
-- directory path does not exist.
refreshTreeView :: MyGUI
-> MyView
-> Maybe FilePath
-> IO ()
refreshTreeView mygui myview mfp = do
fsState <- readTVarIO $ fsState myview
let cfp = getFullPath fsState
fp = fromMaybe cfp mfp
-- TODO catch exceptions
dirSanityThrow fp
newFsState <- readPath' fp
newRawModel <- fileListStore newFsState myview
writeTVarIO (rawModel myview) newRawModel
constructTreeView mygui myview
-- |Refreshes the TreeView based on the given Zipper.
--
-- This also updates the TVar `rawModel`.
refreshTreeView' :: MyGUI
-> MyView
-> DTZipper DirTreeInfo DirTreeInfo
-> IO ()
refreshTreeView' mygui myview dtz = do
newRawModel <- fileListStore dtz myview
writeTVarIO (rawModel myview) newRawModel
constructTreeView mygui myview
-- TODO: make this function more slim so only the most necessary parts are -- TODO: make this function more slim so only the most necessary parts are
-- called -- called
-- |Updates the visible TreeView with the current underlying mutable models, -- |Constructs the visible TreeView with the current underlying mutable models,
-- which are retrieved from `MyGUI`. -- which are retrieved from `MyGUI`.
-- --
-- This also updates the TVars `filteredModel` and `sortedModel` in the process. -- This also updates the TVars `filteredModel` and `sortedModel` in the process.
updateTreeView :: MyGUI constructTreeView :: MyGUI
-> MyView -> MyView
-> IO () -> IO ()
updateTreeView mygui myview = do constructTreeView mygui myview = do
let treeView' = treeView mygui let treeView' = treeView mygui
cF' = cF mygui cF' = cF mygui
cMD' = cMD mygui cMD' = cMD mygui
@ -468,7 +498,7 @@ startMainWindow = do
let myview = MkMyView {..} let myview = MkMyView {..}
-- create the tree model with its contents -- create the tree model with its contents
updateTreeView mygui myview constructTreeView mygui myview
-- set the bindings -- set the bindings
setBindings mygui myview setBindings mygui myview