GTK: add inotify based file/dir watcher

This automatically updates the treeView if the folder/file changes.

hsfm.cabal

@@ -33,6 +33,7 @@ library
                        containers,
                        directory >= 1.1.0.0 && < 1.2.3.0,
                        filepath >= 1.3.0.0,
+                       hinotify,
                        mtl >= 2.2,
                        old-locale >= 1,
                        process,
@@ -70,6 +71,7 @@ executable hsfm-gtk
                        bifunctors >= 5,
                        directory >= 1.1.0.0 && < 1.2.3.0,
                        filepath >= 1.3.0.0,
+                       hinotify,
                        mtl >= 2.2,
                        old-locale >= 1,
                        process,

src/GUI/Gtk.hs

@@ -29,6 +29,10 @@ import Control.Concurrent
   (
     forkIO
   )
+import Control.Concurrent.MVar
+  (
+    newEmptyMVar
+  )
 import Control.Concurrent.STM
   (
     TVar
@@ -148,6 +152,8 @@ startMainWindow startdir = do
 
   settings <- newTVarIO (MkFMSettings False True)
 
+  inotify  <- newEmptyMVar
+
   -- get the icons
   iT        <- iconThemeGetDefault
   folderPix <- getIcon IFolder 24

src/GUI/Gtk/Callbacks.hs

@@ -206,7 +206,7 @@ del :: Row -> MyGUI -> MyView -> IO ()
 del row mygui myview = withErrorDialog $ do
   let cmsg  = "Really delete \"" ++ fullPath row ++ "\"?"
   withConfirmationDialog cmsg
-    $ easyDelete row >> refreshTreeView mygui myview Nothing
+    $ easyDelete row
 
 
 -- |Initializes a file move operation.
@@ -243,16 +243,14 @@ operationFinal mygui myview = withErrorDialog $ do
       let cmsg = "Really move \"" ++ fullPath s
                   ++ "\"" ++ " to \"" ++ fullPath cdir ++ "\"?"
       withConfirmationDialog cmsg
-        (runFileOp (FMove . MC s $ cdir)
+        $ void $ runFileOp (FMove . MC s $ cdir)
-         >> refreshTreeView mygui myview Nothing)
       return ()
     FCopy (CP1 s) -> do
       let cmsg = "Really copy \"" ++ fullPath s
                  ++ "\"" ++ " to \"" ++ fullPath cdir ++ "\"?"
       cm <- showCopyModeChooserDialog
       withConfirmationDialog cmsg
-        (runFileOp (FCopy . CC s cdir $ cm)
+        $ void $ runFileOp (FCopy . CC s cdir $ cm)
-         >> refreshTreeView mygui myview Nothing)
       return ()
     _ -> return ()
 
@@ -279,7 +277,6 @@ newFile mygui myview = withErrorDialog $ do
   for_ mfn $ \fn -> do
     cdir  <- getCurrentDir myview
     createFile cdir fn
-    refreshTreeView' mygui myview cdir
 
 
 renameF :: Row -> MyGUI -> MyView -> IO ()
@@ -289,5 +286,3 @@ renameF row mygui myview = withErrorDialog $ do
     let cmsg = "Really rename \"" ++ fullPath row
                ++ "\"" ++ " to \"" ++ anchor row </> fn ++ "\"?"
     withConfirmationDialog cmsg $ IO.File.renameFile row fn
-    cdir  <- getCurrentDir myview
-    refreshTreeView' mygui myview cdir

src/GUI/Gtk/Data.hs

@@ -21,6 +21,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 module GUI.Gtk.Data where
 
 
+import Control.Concurrent.MVar
+  (
+    MVar
+  )
 import Control.Concurrent.STM
   (
     TVar
@@ -28,7 +32,10 @@ import Control.Concurrent.STM
 import Data.DirTree
 import Graphics.UI.Gtk
 import IO.File
-
+import System.INotify
+  (
+    INotify
+  )
 
 
 
@@ -97,5 +104,6 @@ data MyView = MkMyView {
   , sortedModel :: TVar (TypedTreeModelSort Row)
   , filteredModel :: TVar (TypedTreeModelFilter Row)
   , operationBuffer :: TVar FileOperation
+  , inotify :: MVar INotify
 }
 

src/GUI/Gtk/Utils.hs

@@ -25,6 +25,11 @@ import Control.Applicative
   (
     (<$>)
   )
+import Control.Concurrent.MVar
+  (
+    putMVar
+  , tryTakeMVar
+  )
 import Control.Concurrent.STM
   (
     TVar
@@ -54,6 +59,14 @@ import GUI.Gtk.Data
 import IO.Error
 import IO.Utils
 import MyPrelude
+import System.INotify
+  (
+    addWatch
+  , initINotify
+  , killINotify
+  , EventVariety(..)
+  , Event(..)
+  )
 
 
 
@@ -149,14 +162,22 @@ refreshTreeView mygui myview mfp = do
   mcdir <- getFirstRow myview
   let fp  = fromMaybe (anchor mcdir) mfp
 
+  -- get selected rows
+  tvs   <- treeViewGetSelection (treeView mygui)
+  srows <- treeSelectionGetSelectedRows tvs
+
   -- TODO catch exceptions
   dirSanityThrow fp
 
   newFsState  <- Data.DirTree.readFile fp
   newRawModel <- fileListStore newFsState myview
   writeTVarIO (rawModel myview) newRawModel
+
   constructTreeView mygui myview
 
+  -- reselect selected rows
+  mapM_ (treeSelectionSelectPath tvs) srows
+
 
 -- |Refreshes the TreeView based on the given directory.
 --
@@ -170,8 +191,16 @@ refreshTreeView' :: MyGUI
 refreshTreeView' mygui myview dt = do
   newRawModel  <- fileListStore dt myview
   writeTVarIO (rawModel myview) newRawModel
+
+  -- get selected rows
+  tvs   <- treeViewGetSelection (treeView mygui)
+  srows <- treeSelectionGetSelectedRows tvs
+
   constructTreeView mygui myview
 
+  -- reselect selected rows
+  mapM_ (treeSelectionSelectPath tvs) srows
+
 
 -- TODO: make this function more slim so only the most necessary parts are
 -- called
@@ -193,10 +222,10 @@ constructTreeView mygui myview = do
       cMD'      = cMD mygui
       render'   = renderTxt mygui
 
-  mcdir <- getFirstRow myview
+  cdirp <- anchor <$> getFirstRow myview
 
   -- update urlBar
-  entrySetText (urlBar mygui) (anchor mcdir)
+  entrySetText (urlBar mygui) cdirp
 
   rawModel' <- readTVarIO $ rawModel myview
 
@@ -234,6 +263,17 @@ constructTreeView mygui myview = do
   -- update treeview model
   treeViewSetModel treeView' sortedModel'
 
+  -- add watcher
+  mi <- tryTakeMVar (inotify myview)
+  for_ mi $ \i -> killINotify i
+  newi <- initINotify
+  w <- addWatch
+         newi
+         [Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
+         cdirp
+         (\_ -> postGUIAsync $ refreshTreeView mygui myview (Just cdirp))
+  putMVar (inotify myview) newi
+
   return ()
   where
     dirtreePix (Dir {})     = folderPix mygui