From b6342068f235ac35d655ca2fe8d8905daaa363a0 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sun, 3 Apr 2016 04:13:08 +0200
Subject: [PATCH] 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'.
---
 src/HSFM/GUI/Gtk.hs           | 10 +++++++++-
 src/HSFM/GUI/Gtk/Callbacks.hs |  4 +++-
 src/HSFM/GUI/Gtk/MyView.hs    | 21 +++++++++++----------
 3 files changed, 23 insertions(+), 12 deletions(-)

diff --git a/src/HSFM/GUI/Gtk.hs b/src/HSFM/GUI/Gtk.hs
index 50dab99..3b502cb 100644
--- a/src/HSFM/GUI/Gtk.hs
+++ b/src/HSFM/GUI/Gtk.hs
@@ -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)
 
diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs
index 4290bdd..0068434 100644
--- a/src/HSFM/GUI/Gtk/Callbacks.hs
+++ b/src/HSFM/GUI/Gtk/Callbacks.hs
@@ -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.
diff --git a/src/HSFM/GUI/Gtk/MyView.hs b/src/HSFM/GUI/Gtk/MyView.hs
index f5d0baf..0d002be 100644
--- a/src/HSFM/GUI/Gtk/MyView.hs
+++ b/src/HSFM/GUI/Gtk/MyView.hs
@@ -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 ()