From 05a62cb382f832427f90bc5811861384a1575266 Mon Sep 17 00:00:00 2001
From: Julian Ospald <hasufell@posteo.de>
Date: Sat, 4 Jun 2016 17:28:15 +0200
Subject: [PATCH] GTK: use new History module

---
 src/HSFM/GUI/Gtk/Callbacks.hs       | 54 ++++++++++++++---------------
 src/HSFM/GUI/Gtk/Callbacks/Utils.hs | 23 +++++++-----
 src/HSFM/GUI/Gtk/Data.hs            |  8 ++---
 src/HSFM/GUI/Gtk/MyView.hs          | 10 +++++-
 src/HSFM/GUI/Gtk/Utils.hs           | 12 -------
 5 files changed, 53 insertions(+), 54 deletions(-)

diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs
index 6b6419b..fe7afd6 100644
--- a/src/HSFM/GUI/Gtk/Callbacks.hs
+++ b/src/HSFM/GUI/Gtk/Callbacks.hs
@@ -72,6 +72,7 @@ import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Dialogs
 import HSFM.GUI.Gtk.MyView
 import HSFM.GUI.Gtk.Utils
+import HSFM.History
 import HSFM.Utils.IO
 import Prelude hiding(readFile)
 import System.Glib.UTFString
@@ -87,6 +88,11 @@ import System.Posix.Types
   (
     ProcessID
   )
+import Control.Concurrent.MVar
+  (
+    putMVar
+  , tryTakeMVar
+  )
 
 
 
@@ -202,11 +208,11 @@ setViewCallbacks mygui myview = do
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
         [Alt] <- eventModifier
         "Left"  <- fmap glibToString eventKeyName
-        liftIO $ goHistoryPrev mygui myview
+        liftIO $ goHistoryBack mygui myview
       _ <- viewBox myview `on` keyPressEvent $ tryEvent $ do
         [Alt] <- eventModifier
         "Right"  <- fmap glibToString eventKeyName
-        liftIO $ goHistoryNext mygui myview
+        liftIO $ goHistoryForward mygui myview
       _ <- view `on` keyPressEvent $ tryEvent $ do
         "Delete"  <- fmap glibToString eventKeyName
         liftIO $ withItems mygui myview del
@@ -277,10 +283,10 @@ setViewCallbacks mygui myview = do
               Nothing -> return False
 
           OtherButton 8 -> do
-            liftIO $ goHistoryPrev mygui myview
+            liftIO $ goHistoryBack mygui myview
             return False
           OtherButton 9 -> do
-            liftIO $ goHistoryNext mygui myview
+            liftIO $ goHistoryForward mygui myview
             return False
           -- not right-click, so pass on the signal
           _ -> return False
@@ -535,29 +541,23 @@ upDir mygui myview = withErrorDialog $ do
 
 
 -- |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))
-      goDir False mygui myview nv
+goHistoryBack :: MyGUI -> MyView -> IO ()
+goHistoryBack mygui myview = do
+  mhs <- tryTakeMVar (history myview)
+  for_ mhs $ \hs -> do
+    let nhs = goBack hs
+    putMVar (history myview) nhs
+    nv <- readFile getFileInfo $ currentDir nhs
+    goDir False 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))
-      goDir False mygui myview nv
+-- |Go "forward" in the history.
+goHistoryForward :: MyGUI -> MyView -> IO ()
+goHistoryForward mygui myview = do
+  mhs <- tryTakeMVar (history myview)
+  for_ mhs $ \hs -> do
+    let nhs = goForward hs
+    putMVar (history myview) nhs
+    nv <- readFile getFileInfo $ currentDir nhs
+    goDir False mygui myview nv
 
diff --git a/src/HSFM/GUI/Gtk/Callbacks/Utils.hs b/src/HSFM/GUI/Gtk/Callbacks/Utils.hs
index 6c44c92..c35dd4d 100644
--- a/src/HSFM/GUI/Gtk/Callbacks/Utils.hs
+++ b/src/HSFM/GUI/Gtk/Callbacks/Utils.hs
@@ -29,6 +29,10 @@ import Control.Monad
     forM_
   , when
   )
+import Data.Foldable
+  (
+    for_
+  )
 import Data.Maybe
   (
     fromJust
@@ -46,12 +50,13 @@ import HSFM.FileSystem.UtilTypes
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Dialogs
 import HSFM.GUI.Gtk.MyView
-import HSFM.GUI.Gtk.Utils
-import HSFM.Utils.IO
-  (
-    modifyTVarIO
-  )
+import HSFM.History
 import Prelude hiding(readFile)
+import Control.Concurrent.MVar
+  (
+    putMVar
+  , tryTakeMVar
+  )
 
 
 
@@ -103,9 +108,11 @@ goDir :: Bool    -- ^ whether to update the history
       -> Item
       -> IO ()
 goDir bhis mygui myview item = do
-  cdir <- getCurrentDir myview
-  when bhis $ modifyTVarIO (history myview)
-    (\(p, _) -> (path cdir `addHistory` p, []))
+  when bhis $ do
+    mhs <- tryTakeMVar (history myview)
+    for_ mhs $ \hs -> do
+      let nhs = goNewPath (path item) hs
+      putMVar (history myview) nhs
   refreshView mygui myview item
 
   -- set notebook tab label
diff --git a/src/HSFM/GUI/Gtk/Data.hs b/src/HSFM/GUI/Gtk/Data.hs
index 989e7e1..4ffa3b7 100644
--- a/src/HSFM/GUI/Gtk/Data.hs
+++ b/src/HSFM/GUI/Gtk/Data.hs
@@ -30,13 +30,9 @@ import Control.Concurrent.STM
     TVar
   )
 import Graphics.UI.Gtk hiding (MenuBar)
-import HPath
-  (
-    Abs
-  , Path
-  )
 import HSFM.FileSystem.FileType
 import HSFM.FileSystem.UtilTypes
+import HSFM.History
 import System.INotify
   (
     INotify
@@ -83,7 +79,7 @@ data MyView = MkMyView {
 
   -- 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]))
+  , history         :: !(MVar BrowsingHistory)
 
   -- sub-widgets
   , scroll       :: !ScrolledWindow
diff --git a/src/HSFM/GUI/Gtk/MyView.hs b/src/HSFM/GUI/Gtk/MyView.hs
index 504422a..21b147f 100644
--- a/src/HSFM/GUI/Gtk/MyView.hs
+++ b/src/HSFM/GUI/Gtk/MyView.hs
@@ -64,6 +64,7 @@ import HSFM.GUI.Glib.GlibString()
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Icons
 import HSFM.GUI.Gtk.Utils
+import HSFM.History
 import HSFM.Utils.IO
 import Paths_hsfm
   (
@@ -93,6 +94,8 @@ import System.Posix.FilePath
 -- |Creates a new tab with its own view and refreshes the view.
 newTab :: MyGUI -> IO FMView -> Item -> Int -> IO MyView
 newTab mygui iofmv item pos = do
+
+
   -- create eventbox with label
   label <- labelNewWithMnemonic
     (maybe (P.fromAbs $ path item) P.fromRel $ P.basename $ path item)
@@ -105,6 +108,11 @@ newTab mygui iofmv item pos = do
   _ <- notebookInsertPageMenu (notebook mygui) (viewBox myview)
     ebox ebox pos
 
+  -- set initial history
+  let historySize = 5
+  putMVar (history myview)
+          (BrowsingHistory [] (path item) [] historySize)
+
   notebookSetTabReorderable (notebook mygui) (viewBox myview) True
 
   catchIOError (refreshView mygui myview item) $ \e -> do
@@ -134,7 +142,7 @@ createMyView :: MyGUI
              -> IO MyView
 createMyView mygui iofmv = do
   inotify <- newEmptyMVar
-  history <- newTVarIO ([],[])
+  history <- newEmptyMVar
 
   builder <- builderNew
   builderAddFromFile builder =<< getDataFileName "data/Gtk/builder.xml"
diff --git a/src/HSFM/GUI/Gtk/Utils.hs b/src/HSFM/GUI/Gtk/Utils.hs
index e64b3c0..7cee258 100644
--- a/src/HSFM/GUI/Gtk/Utils.hs
+++ b/src/HSFM/GUI/Gtk/Utils.hs
@@ -152,15 +152,3 @@ 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 :: Eq a => a -> [a] -> [a]
-addHistory i [] = [i]
-addHistory i xs@(x:_)
-  | i == x                 = xs
-  | length xs == maxLength = i : take (maxLength - 1) xs
-  | otherwise              = i : xs
-  where
-    maxLength = 10
-