From 89b231a2c9dae54ea05651cb725bd08a86f4c219 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Wed, 1 Jun 2016 23:24:00 +0200
Subject: [PATCH] GTK: fix various glitches when opening tabs

---
 src/HSFM/FileSystem/FileType.hs | 11 +++++++++++
 src/HSFM/GUI/Gtk.hs             | 14 +++++++++++---
 src/HSFM/GUI/Gtk/Callbacks.hs   |  2 +-
 src/HSFM/GUI/Gtk/MyView.hs      | 25 +++++++++++++++++++++----
 4 files changed, 44 insertions(+), 8 deletions(-)

diff --git a/src/HSFM/FileSystem/FileType.hs b/src/HSFM/FileSystem/FileType.hs
index a1ea387..1937b5c 100644
--- a/src/HSFM/FileSystem/FileType.hs
+++ b/src/HSFM/FileSystem/FileType.hs
@@ -502,6 +502,17 @@ handleDT p
   = handleIOError $ \e -> return $ Failed p e
 
 
+-- |Carries out the action. If the action returns a file
+-- with a failed constructor, rethrows the IOError within.
+-- Otherwise, returns the file unchanged.
+rethrowFailed :: IO (File a) -> IO (File a)
+rethrowFailed a = do
+  file <- a
+  case file of
+       (Failed _ e) -> ioError e
+       _            -> return file
+
+
 
 ---- SYMLINK HELPERS: ----
 
diff --git a/src/HSFM/GUI/Gtk.hs b/src/HSFM/GUI/Gtk.hs
index 6f429a7..0692176 100644
--- a/src/HSFM/GUI/Gtk.hs
+++ b/src/HSFM/GUI/Gtk.hs
@@ -29,27 +29,35 @@ import Data.Maybe
   )
 import Graphics.UI.Gtk
 import qualified HPath as P
+import HSFM.FileSystem.FileType
 import HSFM.GUI.Gtk.Callbacks
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.MyGUI
 import HSFM.GUI.Gtk.MyView
+import Prelude hiding(readFile)
 import Safe
   (
     headDef
   )
+import System.IO.Error
+  (
+    catchIOError
+  )
 import qualified System.Posix.Env.ByteString as SPE
 
 
 main :: IO ()
 main = do
-  _ <- initGUI
-
   args <- SPE.getArgs
   let mdir = fromMaybe (fromJust $ P.parseAbs "/")
                        (P.parseAbs . headDef "/" $ args)
 
+  file <- catchIOError (rethrowFailed $ readFile getFileInfo mdir) $
+    \_ -> readFile getFileInfo  . fromJust $ P.parseAbs "/"
+
+  _ <- initGUI
   mygui <- createMyGUI
-  _ <- newTab mygui createTreeView mdir
+  _ <- newTab mygui createTreeView file
 
   setGUICallbacks mygui
 
diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs
index 26d15ef..afb3108 100644
--- a/src/HSFM/GUI/Gtk/Callbacks.hs
+++ b/src/HSFM/GUI/Gtk/Callbacks.hs
@@ -350,7 +350,7 @@ closeTab mygui myview = do
 
 newTabHere :: MyGUI -> Item -> IO ()
 newTabHere mygui item@(DirOrSym _) =
-  void $ newTab mygui createTreeView (path item)
+  void $ withErrorDialog $ newTab mygui createTreeView item
 newTabHere _ _ = return ()
 
 
diff --git a/src/HSFM/GUI/Gtk/MyView.hs b/src/HSFM/GUI/Gtk/MyView.hs
index cb7d2e9..3116d1c 100644
--- a/src/HSFM/GUI/Gtk/MyView.hs
+++ b/src/HSFM/GUI/Gtk/MyView.hs
@@ -51,6 +51,10 @@ import Data.Maybe
     catMaybes
   , fromJust
   )
+import Data.String
+  (
+    fromString
+  )
 import HPath.IO.Errors
   (
     canOpenDirectory
@@ -81,6 +85,11 @@ import System.INotify
   , killINotify
   , EventVariety(..)
   )
+import System.IO.Error
+  (
+    catchIOError
+  , ioError
+  )
 import System.Posix.FilePath
   (
     pathSeparator
@@ -90,16 +99,21 @@ import System.Posix.FilePath
 
 
 -- |Creates a new tab with its own view and refreshes the view.
-newTab :: MyGUI -> IO FMView -> Path Abs -> IO MyView
-newTab mygui iofmv path = do
+newTab :: MyGUI -> IO FMView -> Item -> IO MyView
+newTab mygui iofmv item = do
   myview <- createMyView mygui iofmv
   i <- notebookAppendPage (notebook mygui) (viewBox myview)
-       (maybe (P.fromAbs path) P.fromRel $ P.basename path)
+    (maybe (P.fromAbs $ path item) P.fromRel $ P.basename $ path item)
   mpage <- notebookGetNthPage (notebook mygui) i
   forM_ mpage $ \page -> notebookSetTabReorderable (notebook mygui)
                                                    page
                                                    True
-  refreshView mygui myview (Just path)
+  catchIOError (refreshView' mygui myview item) $ \e -> do
+    forM_ mpage $ \page -> do
+      refreshView mygui myview (P.parseAbs $ fromString "/")
+      notebookSetTabLabelText (notebook mygui) page "/"
+    ioError e
+
   return myview
 
 
@@ -324,6 +338,9 @@ refreshView mygui myview mfp =
 --
 -- If the directory is not a Dir or a Symlink pointing to a Dir, then
 -- calls `refreshView` with the 3rd argument being Nothing.
+--
+-- Does not do fallbacks if the directory cannot be read, but
+-- throws an error.
 refreshView' :: MyGUI
              -> MyView
              -> Item