diff options
author | 2012-07-29 18:07:45 -0400 | |
---|---|---|
committer | 2012-07-29 18:09:24 -0400 | |
commit | d52c93242450c0bd01e7d3c1fdae375806aa6e1f (patch) | |
tree | ea3ae0b9db0f7c859b8d260a70f54b41d9a4bd3c | |
parent | b2dc8fdb06068276869df682b439348aa96e57f5 (diff) |
moved all alert messages into one file
Makes it easier to edit for consistent voice etc.
-rw-r--r-- | Assistant/Alert.hs | 52 | ||||
-rw-r--r-- | Assistant/Threads/MountWatcher.hs | 11 | ||||
-rw-r--r-- | Assistant/Threads/Pusher.hs | 10 | ||||
-rw-r--r-- | Assistant/Threads/SanityChecker.hs | 17 | ||||
-rw-r--r-- | Assistant/Threads/TransferScanner.hs | 11 | ||||
-rw-r--r-- | Assistant/Threads/Watcher.hs | 5 |
6 files changed, 60 insertions, 46 deletions
diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs index f4220eea9..6b0804fd8 100644 --- a/Assistant/Alert.hs +++ b/Assistant/Alert.hs @@ -9,6 +9,9 @@ module Assistant.Alert where +import Common.Annex +import qualified Remote + import Yesod type Widget = forall sub master. GWidget sub master () @@ -34,3 +37,52 @@ activityAlert header message = Alert , alertMessage = StringAlert message , alertBlockDisplay = False } + +startupScanAlert :: Alert +startupScanAlert = activityAlert Nothing "Performing startup scan" + +pushAlert :: [Remote] -> Alert +pushAlert rs = activityAlert Nothing $ + "Syncing with " ++ unwords (map Remote.name rs) + +pushRetryAlert :: [Remote] -> Alert +pushRetryAlert rs = activityAlert (Just "Retrying sync") $ + "with " ++ unwords (map Remote.name rs) ++ ", which failed earlier." + +syncMountAlert :: FilePath -> [Remote] -> Alert +syncMountAlert dir 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 + } + +scanAlert :: Remote -> Alert +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 + } + +sanityCheckAlert :: Alert +sanityCheckAlert = activityAlert (Just "Running daily sanity check") + "to make sure I've not missed anything." + +sanityCheckFixAlert :: String -> Alert +sanityCheckFixAlert msg = Alert + { alertClass = Warning + , alertHeader = Just "Fixed a problem" + , alertMessage = StringAlert $ unwords + [ "The daily sanity check found and fixed a problem:" + , msg + , "If these problems persist, consider filing a bug report." + ] + , alertBlockDisplay = True + } diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs index 7d0ef5ae4..20862dac1 100644 --- a/Assistant/Threads/MountWatcher.hs +++ b/Assistant/Threads/MountWatcher.hs @@ -165,7 +165,7 @@ handleMount st dstatus scanremotes mntent = do branch <- runThreadState st $ Command.Sync.currentBranch let nonspecial = filter (Git.repoIsLocal . Remote.repo) rs unless (null nonspecial) $ - alertWhile dstatus (syncalert nonspecial) $ do + alertWhile dstatus (syncMountAlert dir nonspecial) $ do debug thisThread ["syncing with", show nonspecial] runThreadState st $ manualPull branch nonspecial now <- getCurrentTime @@ -173,15 +173,6 @@ handleMount st dstatus scanremotes mntent = do 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. - diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index 27e95a734..1b0420b9b 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -17,7 +17,6 @@ import Assistant.DaemonStatus import qualified Command.Sync import Utility.ThreadScheduler import Utility.Parallel -import qualified Remote import Data.Time.Clock import qualified Data.Map as M @@ -38,12 +37,10 @@ pushRetryThread st dstatus pushmap = runEvery (Seconds halfhour) $ do , "failed pushes" ] now <- getCurrentTime - alertWhile dstatus (alert topush) $ + alertWhile dstatus (pushRetryAlert topush) $ pushToRemotes thisThread now st (Just pushmap) topush where halfhour = 1800 - alert rs = activityAlert (Just "Retrying sync") $ - "with " ++ unwords (map Remote.name rs) ++ ", which failed earlier." {- This thread pushes git commits out to remotes soon after they are made. -} pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> IO () @@ -57,7 +54,7 @@ pushThread st dstatus commitchan pushmap = do if shouldPush now commits then do remotes <- knownRemotes <$> getDaemonStatus dstatus - alertWhile dstatus (syncalert remotes) $ + alertWhile dstatus (pushAlert remotes) $ pushToRemotes thisThread now st (Just pushmap) remotes else do debug thisThread @@ -66,9 +63,6 @@ pushThread st dstatus commitchan pushmap = do , "commits" ] refillCommits commitchan commits - where - syncalert rs = activityAlert Nothing $ - "Syncing with " ++ unwords (map Remote.name rs) {- Decide if now is a good time to push to remotes. - diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 69610c2a7..cd5dc0644 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -31,7 +31,7 @@ sanityCheckerThread st dstatus transferqueue changechan = forever $ do debug thisThread ["starting sanity check"] - alertWhile dstatus alert go + alertWhile dstatus sanityCheckAlert go debug thisThread ["sanity check complete"] where @@ -47,8 +47,6 @@ sanityCheckerThread st dstatus transferqueue changechan = forever $ do { sanityCheckRunning = False , lastSanityCheck = Just now } - alert = activityAlert (Just "Running daily sanity check") - "to make sure I've not missed anything." {- Only run one check per day, from the time of the last check. -} waitForNextCheck :: DaemonStatusHandle -> IO () @@ -87,18 +85,9 @@ check st dstatus transferqueue changechan = do slop = fromIntegral tenMinutes insanity msg = do runThreadState st $ warning msg - void $ addAlert dstatus $ Alert - { alertClass = Warning - , alertHeader = Just "Fixed a problem" - , alertMessage = StringAlert $ unwords - [ "The daily sanity check found and fixed a problem:" - , msg - , "If these problems persist, consider filing a bug report." - ] - , alertBlockDisplay = True - } + void $ addAlert dstatus $ sanityCheckFixAlert msg addsymlink file s = do - insanity $ "found unstaged symlink: " ++ file Watcher.runHandler thisThread st dstatus transferqueue changechan Watcher.onAddSymlink file s + insanity $ "found unstaged symlink: " ++ file diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 1bf8b062f..1d91a65d4 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -32,18 +32,9 @@ transferScannerThread st dstatus scanremotes transferqueue = do runEvery (Seconds 2) $ do r <- getScanRemote scanremotes liftIO $ debug thisThread ["starting scan of", show r] - alertWhile dstatus (scanalert 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. - diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index ade26be19..1c8d122d5 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -75,7 +75,7 @@ watchThread st dstatus transferqueue changechan = do startupScan :: ThreadState -> DaemonStatusHandle -> IO a -> IO a startupScan st dstatus scanner = do runThreadState st $ showAction "scanning" - r <- alertWhile dstatus alert scanner + r <- alertWhile dstatus startupScanAlert scanner modifyDaemonStatus_ dstatus $ \s -> s { scanComplete = True } -- Notice any files that were deleted before watching was started. @@ -84,9 +84,6 @@ startupScan st dstatus scanner = do showAction "started" return r - - where - alert = activityAlert Nothing "Performing startup scan" ignored :: FilePath -> Bool ignored = ig . takeFileName |