wire up scan and transfer to newly added removable drive

remote setup still todo

2 files changed, 13 insertions, 15 deletions

diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs
index 4baef1d11..9a3396285 100644
--- a/Assistant/Threads/MountWatcher.hs
+++ b/Assistant/Threads/MountWatcher.hs
@@ -154,13 +154,14 @@ pollingThread st dstatus scanremotes = go =<< currentMountPoints
 			go nowmounted
 
 handleMounts :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> MountPoints -> MountPoints -> IO ()
-handleMounts st dstatus scanremotes wasmounted nowmounted = mapM_ (handleMount st dstatus scanremotes) $
-	S.toList $ newMountPoints wasmounted nowmounted
+handleMounts st dstatus scanremotes wasmounted nowmounted =
+	mapM_ (handleMount st dstatus scanremotes . mnt_dir) $
+		S.toList $ newMountPoints wasmounted nowmounted
 
-handleMount :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> Mntent -> IO ()
-handleMount st dstatus scanremotes mntent = do
+handleMount :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> FilePath -> IO ()
+handleMount st dstatus scanremotes dir = do
 	debug thisThread ["detected mount of", dir]
-	rs <- remotesUnder st dstatus mntent
+	rs <- remotesUnder st dstatus dir
 	unless (null rs) $ do
 		branch <- runThreadState st $ Command.Sync.currentBranch
 		let nonspecial = filter (Git.repoIsLocal . Remote.repo) rs
@@ -171,8 +172,6 @@ handleMount st dstatus scanremotes mntent = do
 				now <- getCurrentTime	
 				pushToRemotes thisThread now st Nothing nonspecial
 		addScanRemotes scanremotes rs
-	where
-		dir = mnt_dir mntent
 
 {- Finds remotes located underneath the mount point.
  -
@@ -182,8 +181,8 @@ handleMount st dstatus scanremotes mntent = do
  - at startup time, or may have changed (it could even be a different
  - repository at the same remote location..)
  -}
-remotesUnder :: ThreadState -> DaemonStatusHandle -> Mntent -> IO [Remote]
-remotesUnder st dstatus mntent = runThreadState st $ do
+remotesUnder :: ThreadState -> DaemonStatusHandle -> FilePath -> IO [Remote]
+remotesUnder st dstatus dir = runThreadState st $ do
 	repotop <- fromRepo Git.repoPath
 	rs <- remoteList
 	pairs <- mapM (checkremote repotop) rs
@@ -194,7 +193,7 @@ remotesUnder st dstatus mntent = runThreadState st $ do
 	return $ map snd $ filter fst pairs
 	where
 		checkremote repotop r = case Remote.path r of
-			Just p | under mntent (absPathFrom repotop p) ->
+			Just p | dirContains dir (absPathFrom repotop p) ->
 				(,) <$> pure True <*> updateremote r
 			_ -> return (False, r)
 		updateremote r = do
@@ -214,7 +213,3 @@ currentMountPoints = S.fromList <$> getMounts
 
 newMountPoints :: MountPoints -> MountPoints -> MountPoints
 newMountPoints old new = S.difference new old
-
-{- Checks if a mount point contains a path. The path must be absolute. -}
-under :: Mntent -> FilePath -> Bool
-under = dirContains . mnt_dir
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 7ea7314e0..7343c39fe 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -19,6 +19,7 @@ import Assistant.WebApp.Configurators
 import Assistant.WebApp.Documentation
 import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
+import Assistant.ScanRemotes
 import Assistant.TransferQueue
 import Utility.WebApp
 import Utility.FileMode
@@ -40,14 +41,16 @@ type Url = String
 webAppThread 
 	:: (Maybe ThreadState) 
 	-> DaemonStatusHandle
+	-> ScanRemoteMap
 	-> TransferQueue
 	-> Maybe (IO String)
 	-> Maybe (Url -> FilePath -> IO ())
 	-> IO ()
-webAppThread mst dstatus transferqueue postfirstrun onstartup = do
+webAppThread mst dstatus scanremotes transferqueue postfirstrun onstartup = do
 	webapp <- WebApp
 		<$> pure mst
 		<*> pure dstatus
+		<*> pure scanremotes
 		<*> pure transferqueue
 		<*> (pack <$> genRandomToken)
 		<*> getreldir mst