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:
parent
0781fc690d
commit
b6342068f2
@ -21,7 +21,13 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
|
|
||||||
|
import Data.Maybe
|
||||||
|
(
|
||||||
|
fromJust
|
||||||
|
, fromMaybe
|
||||||
|
)
|
||||||
import Graphics.UI.Gtk
|
import Graphics.UI.Gtk
|
||||||
|
import qualified HPath as P
|
||||||
import HSFM.GUI.Gtk.Data
|
import HSFM.GUI.Gtk.Data
|
||||||
import HSFM.GUI.Gtk.MyGUI
|
import HSFM.GUI.Gtk.MyGUI
|
||||||
import HSFM.GUI.Gtk.MyView
|
import HSFM.GUI.Gtk.MyView
|
||||||
@ -45,7 +51,9 @@ main = do
|
|||||||
|
|
||||||
myview <- createMyView mygui createTreeView
|
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)
|
widgetShowAll (rootWin mygui)
|
||||||
|
|
||||||
|
@ -198,11 +198,13 @@ setCallbacks mygui myview = do
|
|||||||
|
|
||||||
-- |Go to the url given at the 'urlBar' and visualize it in the given
|
-- |Go to the url given at the 'urlBar' and visualize it in the given
|
||||||
-- treeView.
|
-- treeView.
|
||||||
|
--
|
||||||
|
-- If the url is invalid, does nothing.
|
||||||
urlGoTo :: MyGUI -> MyView -> IO ()
|
urlGoTo :: MyGUI -> MyView -> IO ()
|
||||||
urlGoTo mygui myview = withErrorDialog $ do
|
urlGoTo mygui myview = withErrorDialog $ do
|
||||||
fp <- entryGetText (urlBar mygui)
|
fp <- entryGetText (urlBar mygui)
|
||||||
forM_ (P.parseAbs fp :: Maybe (Path Abs)) $ \fp' ->
|
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.
|
-- |Supposed to be used with 'withRows'. Opens a file or directory.
|
||||||
|
@ -44,11 +44,14 @@ import Data.Foldable
|
|||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
(
|
(
|
||||||
catMaybes
|
catMaybes
|
||||||
, fromJust
|
|
||||||
, fromMaybe
|
|
||||||
)
|
)
|
||||||
import Graphics.UI.Gtk
|
import Graphics.UI.Gtk
|
||||||
import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setCallbacks)
|
import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setCallbacks)
|
||||||
|
import HPath
|
||||||
|
(
|
||||||
|
Path
|
||||||
|
, Abs
|
||||||
|
)
|
||||||
import qualified HPath as P
|
import qualified HPath as P
|
||||||
import HSFM.FileSystem.FileOperations
|
import HSFM.FileSystem.FileOperations
|
||||||
import HSFM.FileSystem.FileType
|
import HSFM.FileSystem.FileType
|
||||||
@ -194,17 +197,15 @@ createTreeView = do
|
|||||||
--
|
--
|
||||||
-- If the third argument is (Just path) it tries to read "path". If that
|
-- If the third argument is (Just path) it tries to read "path". If that
|
||||||
-- fails, it reads "/" instead.
|
-- fails, it reads "/" instead.
|
||||||
-- TODO: maybe move the parsing logic away and use 'Path Abs' in the type
|
|
||||||
refreshView :: MyGUI
|
refreshView :: MyGUI
|
||||||
-> MyView
|
-> MyView
|
||||||
-> Maybe FilePath
|
-> Maybe (Path Abs)
|
||||||
-> IO ()
|
-> IO ()
|
||||||
refreshView mygui myview mfp =
|
refreshView mygui myview mfp =
|
||||||
case mfp of
|
case mfp of
|
||||||
Just fp -> do
|
Just fp -> do
|
||||||
let mdir = fromMaybe (fromJust $ P.parseAbs "/") (P.parseAbs fp)
|
|
||||||
-- readFileWithFileInfo can just outright fail...
|
-- readFileWithFileInfo can just outright fail...
|
||||||
ecdir <- tryIOError (HSFM.FileSystem.FileType.readFileWithFileInfo mdir)
|
ecdir <- tryIOError (HSFM.FileSystem.FileType.readFileWithFileInfo fp)
|
||||||
case ecdir of
|
case ecdir of
|
||||||
Right cdir ->
|
Right cdir ->
|
||||||
-- ...or return an `AnchordFile` with a Failed constructor,
|
-- ...or return an `AnchordFile` with a Failed constructor,
|
||||||
@ -219,8 +220,8 @@ refreshView mygui myview mfp =
|
|||||||
ecd <- try (getCurrentDir myview) :: IO (Either SomeException
|
ecd <- try (getCurrentDir myview) :: IO (Either SomeException
|
||||||
(AnchoredFile FileInfo))
|
(AnchoredFile FileInfo))
|
||||||
case ecd of
|
case ecd of
|
||||||
Right dir -> return (Just $ fullPathS dir)
|
Right dir -> return (Just $ fullPath dir)
|
||||||
Left _ -> return (Just "/")
|
Left _ -> return (P.parseAbs "/")
|
||||||
|
|
||||||
|
|
||||||
-- |Refreshes the View based on the given directory.
|
-- |Refreshes the View based on the given directory.
|
||||||
@ -342,7 +343,7 @@ constructView mygui myview = do
|
|||||||
newi
|
newi
|
||||||
[Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
|
[Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
|
||||||
(P.fromAbs cdirp)
|
(P.fromAbs cdirp)
|
||||||
(\_ -> postGUIAsync $ refreshView mygui myview (Just $ P.fromAbs cdirp))
|
(\_ -> postGUIAsync $ refreshView mygui myview (Just $ cdirp))
|
||||||
putMVar (inotify myview) newi
|
putMVar (inotify myview) newi
|
||||||
|
|
||||||
return ()
|
return ()
|
||||||
|
Loading…
Reference in New Issue
Block a user