add some alerts

This commit is contained in:
Joey Hess 2012-07-29 13:22:08 -04:00
parent 2dc5697a0a
commit 09e77a0cf0
3 changed files with 34 additions and 10 deletions

View file

@ -15,6 +15,7 @@ import Assistant.ThreadedMonad
import Assistant.DaemonStatus
import Assistant.ScanRemotes
import Assistant.Threads.Pusher (pushToRemotes)
import Assistant.Alert
import qualified Annex
import qualified Git
import Utility.ThreadScheduler
@ -158,17 +159,29 @@ handleMounts st dstatus scanremotes wasmounted nowmounted = mapM_ (handleMount s
handleMount :: ThreadState -> DaemonStatusHandle -> ScanRemoteMap -> Mntent -> IO ()
handleMount st dstatus scanremotes mntent = do
debug thisThread ["detected mount of", mnt_dir mntent]
debug thisThread ["detected mount of", dir]
rs <- remotesUnder st dstatus mntent
unless (null rs) $ do
branch <- runThreadState st $ Command.Sync.currentBranch
let nonspecial = filter (Git.repoIsLocal . Remote.repo) rs
unless (null nonspecial) $ do
debug thisThread ["pulling from", show nonspecial]
runThreadState st $ manualPull branch nonspecial
now <- getCurrentTime
pushToRemotes thisThread now st Nothing nonspecial
unless (null nonspecial) $
alertWhile dstatus (syncalert nonspecial) $ do
debug thisThread ["syncing with", show nonspecial]
runThreadState st $ manualPull branch nonspecial
now <- getCurrentTime
pushToRemotes thisThread now st Nothing nonspecial
addScanRemotes scanremotes rs
where
dir = mnt_dir mntent
syncalert rs = Alert
{ alertClass = Activity
, alertHeader = Just $ "Syncing with " ++ unwords (map Remote.name rs)
, alertMessage = StringAlert $ unwords
["I noticed you plugged in", dir,
" -- let's get it in sync!"]
, alertBlockDisplay = True
}
{- Finds remotes located underneath the mount point.
-

View file

@ -12,6 +12,7 @@ import Assistant.ScanRemotes
import Assistant.TransferQueue
import Assistant.ThreadedMonad
import Assistant.DaemonStatus
import Assistant.Alert
import Logs.Transfer
import Logs.Location
import qualified Remote
@ -31,9 +32,18 @@ transferScannerThread st dstatus scanremotes transferqueue = do
runEvery (Seconds 2) $ do
r <- getScanRemote scanremotes
liftIO $ debug thisThread ["starting scan of", show r]
scan st dstatus transferqueue r
alertWhile dstatus (scanalert r) $
scan st dstatus transferqueue r
liftIO $ debug thisThread ["finished scan of", show r]
where
scanalert r = Alert
{ alertClass = Activity
, alertHeader = Just $ "Scanning " ++ Remote.name r
, alertMessage = StringAlert $ unwords
[ "Ensuring that ", Remote.name r
, "is fully in sync." ]
, alertBlockDisplay = True
}
{- This is a naive scan through the git work tree.
-

View file

@ -74,9 +74,7 @@ watchThread st dstatus transferqueue changechan = do
{- Initial scartup scan. The action should return once the scan is complete. -}
startupScan :: ThreadState -> DaemonStatusHandle -> IO a -> IO a
startupScan st dstatus scanner = do
runThreadState st $
showAction "scanning"
let alert = activityAlert Nothing "Performing startup scan"
runThreadState st $ showAction "scanning"
r <- alertWhile dstatus alert scanner
modifyDaemonStatus_ dstatus $ \s -> s { scanComplete = True }
@ -86,6 +84,9 @@ startupScan st dstatus scanner = do
showAction "started"
return r
where
alert = activityAlert Nothing "Performing startup scan"
ignored :: FilePath -> Bool
ignored = ig . takeFileName