From 680a75f5bea86a5db8361996b312a386b744ad47 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Wed, 20 Apr 2016 00:38:22 +0200
Subject: [PATCH] GTK: implement rudimentary history support wrt #21

5 items back and forth only. Implemented via a simple
TVar ([], []). Might be improved in the future.
---
 src/HSFM/GUI/Gtk/Callbacks.hs | 59 +++++++++++++++++++++++++++++++++--
 src/HSFM/GUI/Gtk/Data.hs      | 13 +++++++-
 src/HSFM/GUI/Gtk/MyView.hs    | 31 +++++++++---------
 src/HSFM/GUI/Gtk/Utils.hs     | 10 ++++++
 4 files changed, 93 insertions(+), 20 deletions(-)

diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs
index 60fdead..ac70ff3 100644
--- a/src/HSFM/GUI/Gtk/Callbacks.hs
+++ b/src/HSFM/GUI/Gtk/Callbacks.hs
@@ -189,6 +189,14 @@ setCallbacks mygui myview = do
         [Alt] <- eventModifier
         "Up"  <- fmap glibToString eventKeyName
         liftIO $ upDir mygui myview
+      _ <- view `on` keyPressEvent $ tryEvent $ do
+        [Alt] <- eventModifier
+        "Left"  <- fmap glibToString eventKeyName
+        liftIO $ goHistoryPrev mygui myview
+      _ <- view `on` keyPressEvent $ tryEvent $ do
+        [Alt] <- eventModifier
+        "Right"  <- fmap glibToString eventKeyName
+        liftIO $ goHistoryNext mygui myview
       _ <- view `on` keyPressEvent $ tryEvent $ do
         "Delete"  <- fmap glibToString eventKeyName
         liftIO $ withItems mygui myview del
@@ -231,6 +239,12 @@ setCallbacks mygui myview = do
                   return $ elem tp selectedTps
                 -- no item under the cursor, pass on the signal
                 Nothing -> return False
+          OtherButton 8 -> do
+            liftIO $ goHistoryPrev mygui myview
+            return False
+          OtherButton 9 -> do
+            liftIO $ goHistoryNext mygui myview
+            return False
           -- not right-click, so pass on the signal
           _ -> return False
       _ <- (rcFileOpen . rcmenu) mygui `on` menuItemActivated $
@@ -273,7 +287,8 @@ 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 fp')
+      whenM (canOpenDirectory fp')
+            (goDir mygui myview =<< (readFile getFileInfo $ fp'))
 
 
 goHome :: MyGUI -> MyView -> IO ()
@@ -288,7 +303,7 @@ open [item] mygui myview = withErrorDialog $
   case item of
     DirOrSym r -> do
       nv <- readFile getFileInfo $ path r
-      refreshView' mygui myview nv
+      goDir mygui myview nv
     r ->
       void $ openFile r
 -- this throws on the first error that occurs
@@ -388,7 +403,7 @@ upDir :: MyGUI -> MyView -> IO ()
 upDir mygui myview = withErrorDialog $ do
   cdir <- getCurrentDir myview
   nv <- goUp cdir
-  refreshView' mygui myview nv
+  goDir mygui myview nv
 
 
 -- |Create a new file.
@@ -425,3 +440,41 @@ renameF [item] _ _ = withErrorDialog $ do
 renameF _ _ _ = withErrorDialog
                   . throw $ InvalidOperation
                             "Operation not supported on multiple files"
+
+
+-- |Helper that is invoked for any directory change operations.
+goDir :: MyGUI -> MyView -> Item -> IO ()
+goDir mygui myview item = do
+  cdir <- getCurrentDir myview
+  modifyTVarIO (history myview)
+    (\(p, n) -> (path cdir `addHistory` p, n))
+  refreshView' mygui myview item
+
+
+-- |Go "back" in the history.
+goHistoryPrev :: MyGUI -> MyView -> IO ()
+goHistoryPrev mygui myview = do
+  hs <- readTVarIO (history myview)
+  case hs of
+    ([], _) -> return ()
+    (x:xs, _) -> do
+      cdir <- getCurrentDir myview
+      nv <- readFile getFileInfo $ x
+      modifyTVarIO (history myview)
+        (\(_, n) -> (xs, path cdir `addHistory` n))
+      refreshView' mygui myview nv
+
+
+-- |Go "forth" in the history.
+goHistoryNext :: MyGUI -> MyView -> IO ()
+goHistoryNext mygui myview = do
+  hs <- readTVarIO (history myview)
+  case hs of
+    (_, []) -> return ()
+    (_, x:xs) -> do
+      cdir <- getCurrentDir myview
+      nv <- readFile getFileInfo $ x
+      modifyTVarIO (history myview)
+        (\(p, _) -> (path cdir `addHistory` p, xs))
+      refreshView' mygui myview nv
+
diff --git a/src/HSFM/GUI/Gtk/Data.hs b/src/HSFM/GUI/Gtk/Data.hs
index bf40243..aaea544 100644
--- a/src/HSFM/GUI/Gtk/Data.hs
+++ b/src/HSFM/GUI/Gtk/Data.hs
@@ -31,6 +31,11 @@ import Control.Concurrent.STM
   )
 import Graphics.UI.Gtk
 import Graphics.UI.Gtk hiding (MenuBar)
+import HPath
+  (
+    Abs
+  , Path
+  )
 import HSFM.FileSystem.FileOperations
 import HSFM.FileSystem.FileType
 import System.INotify.ByteString
@@ -60,7 +65,6 @@ data MyGUI = MkMyGUI {
   , urlBar :: Entry
   , statusBar :: Statusbar
   , clearStatusBar :: Button
-  , settings :: TVar FMSettings
   , scroll :: ScrolledWindow
 
   , fprop :: FilePropertyGrid
@@ -68,6 +72,9 @@ data MyGUI = MkMyGUI {
   -- sub-widgets
   , menubar :: MenuBar
   , rcmenu :: RightClickMenu
+
+  -- other
+  , settings :: TVar FMSettings
 }
 
 data MenuBar = MkMenuBar {
@@ -132,6 +139,10 @@ data MyView = MkMyView {
   , filteredModel   :: TVar (TypedTreeModelFilter Item)
   , operationBuffer :: TVar FileOperation
   , inotify         :: MVar INotify
+
+  -- the first part of the tuple represents the "go back"
+  -- the second part the "go forth" in the history
+  , history         :: TVar ([Path Abs], [Path Abs])
 }
 
 
diff --git a/src/HSFM/GUI/Gtk/MyView.hs b/src/HSFM/GUI/Gtk/MyView.hs
index 71d0b8a..5ae1592 100644
--- a/src/HSFM/GUI/Gtk/MyView.hs
+++ b/src/HSFM/GUI/Gtk/MyView.hs
@@ -39,6 +39,10 @@ import Control.Exception
     try
   , SomeException
   )
+import Control.Monad
+  (
+    void
+  )
 import Data.Foldable
   (
     for_
@@ -48,6 +52,10 @@ import Data.Maybe
     catMaybes
   , fromJust
   )
+import HSFM.FileSystem.Errors
+  (
+    canOpenDirectory
+  )
 import Graphics.UI.Gtk
 import {-# SOURCE #-} HSFM.GUI.Gtk.Callbacks (setCallbacks)
 import HPath
@@ -71,10 +79,6 @@ import System.INotify.ByteString
   , killINotify
   , EventVariety(..)
   )
-import System.IO.Error
-  (
-    tryIOError
-  )
 
 
 
@@ -88,6 +92,7 @@ createMyView mygui iofmv = do
   operationBuffer <- newTVarIO None
 
   inotify <- newEmptyMVar
+  history <- newTVarIO ([],[])
 
   -- create dummy models, so we don't have to use MVar
   rawModel <- newTVarIO =<< listStoreNew []
@@ -130,7 +135,7 @@ switchView mygui myview iofmv = do
   containerAdd (scroll mygui) nview
   widgetShow nview
 
-  refreshView mygui myview Nothing
+  void $ refreshView mygui myview Nothing
 
 
 -- |Createss an IconView.
@@ -219,16 +224,10 @@ refreshView :: MyGUI
 refreshView mygui myview mfp =
   case mfp of
     Just fp  -> do
-      -- readFileWithFileInfo can just outright fail...
-      ecdir <- tryIOError (readFile getFileInfo fp)
-      case ecdir of
-        Right cdir ->
-          -- ...or return an `AnchordFile` with a Failed constructor,
-          -- both of which need to be handled here
-          if (failed cdir)
-            then refreshView mygui myview =<< getAlternativeDir
-            else refreshView' mygui myview cdir
-        Left _ -> refreshView mygui myview =<< getAlternativeDir
+      canopen <- canOpenDirectory fp
+      if canopen
+         then refreshView' mygui myview =<< readFile getFileInfo fp
+         else refreshView mygui myview =<< getAlternativeDir
     Nothing  -> refreshView mygui myview =<< getAlternativeDir
     where
       getAlternativeDir = do
@@ -361,7 +360,7 @@ constructView mygui myview = do
          newi
          [Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
          (P.fromAbs cdirp)
-         (\_ -> postGUIAsync $ refreshView mygui myview (Just $ cdirp))
+         (\_ -> postGUIAsync $ void $refreshView mygui myview (Just $ cdirp))
   putMVar (inotify myview) newi
 
   return ()
diff --git a/src/HSFM/GUI/Gtk/Utils.hs b/src/HSFM/GUI/Gtk/Utils.hs
index 45e7687..a18a845 100644
--- a/src/HSFM/GUI/Gtk/Utils.hs
+++ b/src/HSFM/GUI/Gtk/Utils.hs
@@ -149,3 +149,13 @@ rawPathToItem myview tp = do
   miter     <- rawPathToIter myview tp
   forM miter $ \iter -> treeModelGetRow rawModel' iter
 
+
+-- |Makes sure the list is max 5. This is probably not very efficient
+-- but we don't care, since it's a small list anyway.
+addHistory :: a -> [a] -> [a]
+addHistory i xs
+  | length xs == maxLength = i : take (maxLength - 1) xs
+  | otherwise              = i : xs
+  where
+    maxLength = 5
+