summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-29 18:07:45 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-29 18:09:24 -0400
commitd52c93242450c0bd01e7d3c1fdae375806aa6e1f (patch)
treeea3ae0b9db0f7c859b8d260a70f54b41d9a4bd3c /Assistant
parentb2dc8fdb06068276869df682b439348aa96e57f5 (diff)
moved all alert messages into one file
Makes it easier to edit for consistent voice etc.
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Alert.hs52
-rw-r--r--Assistant/Threads/MountWatcher.hs11
-rw-r--r--Assistant/Threads/Pusher.hs10
-rw-r--r--Assistant/Threads/SanityChecker.hs17
-rw-r--r--Assistant/Threads/TransferScanner.hs11
-rw-r--r--Assistant/Threads/Watcher.hs5
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