GTK: cleanup refreshView a bit

This moves some of the parsing logic where it belong, into Gtk.hs
and fixes the type to be proper 'Path Abs'.
This commit is contained in:
Julian Ospald 2016-04-03 04:13:08 +02:00
parent 0781fc690d
commit b6342068f2
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
3 changed files with 23 additions and 12 deletions

View File

@ -21,7 +21,13 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
module Main where
import Data.Maybe
(
fromJust
, fromMaybe
)
import Graphics.UI.Gtk
import qualified HPath as P
import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.MyGUI
import HSFM.GUI.Gtk.MyView
@ -45,7 +51,9 @@ main = do
myview <- createMyView mygui createTreeView
refreshView mygui myview (Just $ headDef "/" args)
let mdir = fromMaybe (fromJust $ P.parseAbs "/")
(P.parseAbs $ headDef "/" args)
refreshView mygui myview (Just $ mdir)
widgetShowAll (rootWin mygui)

View File

@ -198,11 +198,13 @@ setCallbacks mygui myview = do
-- |Go to the url given at the 'urlBar' and visualize it in the given
-- treeView.
--
-- If the url is invalid, does nothing.
urlGoTo :: MyGUI -> MyView -> IO ()
urlGoTo mygui myview = withErrorDialog $ do
fp <- entryGetText (urlBar mygui)
forM_ (P.parseAbs fp :: Maybe (Path Abs)) $ \fp' ->
refreshView mygui myview (Just $ P.fromAbs fp')
refreshView mygui myview (Just fp')
-- |Supposed to be used with 'withRows'. Opens a file or directory.

View File

@ -44,11 +44,14 @@ import Data.Foldable
import Data.Maybe
(
catMaybes
, fromJust
, fromMaybe
)
import Graphics.UI.Gtk
import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setCallbacks)
import HPath
(
Path
, Abs
)
import qualified HPath as P
import HSFM.FileSystem.FileOperations
import HSFM.FileSystem.FileType
@ -194,17 +197,15 @@ createTreeView = do
--
-- If the third argument is (Just path) it tries to read "path". If that
-- fails, it reads "/" instead.
-- TODO: maybe move the parsing logic away and use 'Path Abs' in the type
refreshView :: MyGUI
-> MyView
-> Maybe FilePath
-> Maybe (Path Abs)
-> IO ()
refreshView mygui myview mfp =
case mfp of
Just fp -> do
let mdir = fromMaybe (fromJust $ P.parseAbs "/") (P.parseAbs fp)
-- readFileWithFileInfo can just outright fail...
ecdir <- tryIOError (HSFM.FileSystem.FileType.readFileWithFileInfo mdir)
ecdir <- tryIOError (HSFM.FileSystem.FileType.readFileWithFileInfo fp)
case ecdir of
Right cdir ->
-- ...or return an `AnchordFile` with a Failed constructor,
@ -217,10 +218,10 @@ refreshView mygui myview mfp =
where
getAlternativeDir = do
ecd <- try (getCurrentDir myview) :: IO (Either SomeException
(AnchoredFile FileInfo))
(AnchoredFile FileInfo))
case ecd of
Right dir -> return (Just $ fullPathS dir)
Left _ -> return (Just "/")
Right dir -> return (Just $ fullPath dir)
Left _ -> return (P.parseAbs "/")
-- |Refreshes the View based on the given directory.
@ -342,7 +343,7 @@ constructView mygui myview = do
newi
[Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
(P.fromAbs cdirp)
(\_ -> postGUIAsync $ refreshView mygui myview (Just $ P.fromAbs cdirp))
(\_ -> postGUIAsync $ refreshView mygui myview (Just $ cdirp))
putMVar (inotify myview) newi
return ()