moved all alert messages into one file
Makes it easier to edit for consistent voice etc.
This commit is contained in:
parent
b2dc8fdb06
commit
d52c932424
6 changed files with 60 additions and 46 deletions
|
@ -9,6 +9,9 @@
|
||||||
|
|
||||||
module Assistant.Alert where
|
module Assistant.Alert where
|
||||||
|
|
||||||
|
import Common.Annex
|
||||||
|
import qualified Remote
|
||||||
|
|
||||||
import Yesod
|
import Yesod
|
||||||
|
|
||||||
type Widget = forall sub master. GWidget sub master ()
|
type Widget = forall sub master. GWidget sub master ()
|
||||||
|
@ -34,3 +37,52 @@ activityAlert header message = Alert
|
||||||
, alertMessage = StringAlert message
|
, alertMessage = StringAlert message
|
||||||
, alertBlockDisplay = False
|
, 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
|
||||||
|
}
|
||||||
|
|
|
@ -165,7 +165,7 @@ handleMount st dstatus scanremotes mntent = do
|
||||||
branch <- runThreadState st $ Command.Sync.currentBranch
|
branch <- runThreadState st $ Command.Sync.currentBranch
|
||||||
let nonspecial = filter (Git.repoIsLocal . Remote.repo) rs
|
let nonspecial = filter (Git.repoIsLocal . Remote.repo) rs
|
||||||
unless (null nonspecial) $
|
unless (null nonspecial) $
|
||||||
alertWhile dstatus (syncalert nonspecial) $ do
|
alertWhile dstatus (syncMountAlert dir nonspecial) $ do
|
||||||
debug thisThread ["syncing with", show nonspecial]
|
debug thisThread ["syncing with", show nonspecial]
|
||||||
runThreadState st $ manualPull branch nonspecial
|
runThreadState st $ manualPull branch nonspecial
|
||||||
now <- getCurrentTime
|
now <- getCurrentTime
|
||||||
|
@ -173,15 +173,6 @@ handleMount st dstatus scanremotes mntent = do
|
||||||
addScanRemotes scanremotes rs
|
addScanRemotes scanremotes rs
|
||||||
where
|
where
|
||||||
dir = mnt_dir mntent
|
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.
|
{- Finds remotes located underneath the mount point.
|
||||||
-
|
-
|
||||||
|
|
|
@ -17,7 +17,6 @@ import Assistant.DaemonStatus
|
||||||
import qualified Command.Sync
|
import qualified Command.Sync
|
||||||
import Utility.ThreadScheduler
|
import Utility.ThreadScheduler
|
||||||
import Utility.Parallel
|
import Utility.Parallel
|
||||||
import qualified Remote
|
|
||||||
|
|
||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
@ -38,12 +37,10 @@ pushRetryThread st dstatus pushmap = runEvery (Seconds halfhour) $ do
|
||||||
, "failed pushes"
|
, "failed pushes"
|
||||||
]
|
]
|
||||||
now <- getCurrentTime
|
now <- getCurrentTime
|
||||||
alertWhile dstatus (alert topush) $
|
alertWhile dstatus (pushRetryAlert topush) $
|
||||||
pushToRemotes thisThread now st (Just pushmap) topush
|
pushToRemotes thisThread now st (Just pushmap) topush
|
||||||
where
|
where
|
||||||
halfhour = 1800
|
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. -}
|
{- This thread pushes git commits out to remotes soon after they are made. -}
|
||||||
pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> IO ()
|
pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> IO ()
|
||||||
|
@ -57,7 +54,7 @@ pushThread st dstatus commitchan pushmap = do
|
||||||
if shouldPush now commits
|
if shouldPush now commits
|
||||||
then do
|
then do
|
||||||
remotes <- knownRemotes <$> getDaemonStatus dstatus
|
remotes <- knownRemotes <$> getDaemonStatus dstatus
|
||||||
alertWhile dstatus (syncalert remotes) $
|
alertWhile dstatus (pushAlert remotes) $
|
||||||
pushToRemotes thisThread now st (Just pushmap) remotes
|
pushToRemotes thisThread now st (Just pushmap) remotes
|
||||||
else do
|
else do
|
||||||
debug thisThread
|
debug thisThread
|
||||||
|
@ -66,9 +63,6 @@ pushThread st dstatus commitchan pushmap = do
|
||||||
, "commits"
|
, "commits"
|
||||||
]
|
]
|
||||||
refillCommits commitchan 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.
|
{- Decide if now is a good time to push to remotes.
|
||||||
-
|
-
|
||||||
|
|
|
@ -31,7 +31,7 @@ sanityCheckerThread st dstatus transferqueue changechan = forever $ do
|
||||||
|
|
||||||
debug thisThread ["starting sanity check"]
|
debug thisThread ["starting sanity check"]
|
||||||
|
|
||||||
alertWhile dstatus alert go
|
alertWhile dstatus sanityCheckAlert go
|
||||||
|
|
||||||
debug thisThread ["sanity check complete"]
|
debug thisThread ["sanity check complete"]
|
||||||
where
|
where
|
||||||
|
@ -47,8 +47,6 @@ sanityCheckerThread st dstatus transferqueue changechan = forever $ do
|
||||||
{ sanityCheckRunning = False
|
{ sanityCheckRunning = False
|
||||||
, lastSanityCheck = Just now
|
, 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. -}
|
{- Only run one check per day, from the time of the last check. -}
|
||||||
waitForNextCheck :: DaemonStatusHandle -> IO ()
|
waitForNextCheck :: DaemonStatusHandle -> IO ()
|
||||||
|
@ -87,18 +85,9 @@ check st dstatus transferqueue changechan = do
|
||||||
slop = fromIntegral tenMinutes
|
slop = fromIntegral tenMinutes
|
||||||
insanity msg = do
|
insanity msg = do
|
||||||
runThreadState st $ warning msg
|
runThreadState st $ warning msg
|
||||||
void $ addAlert dstatus $ Alert
|
void $ addAlert dstatus $ sanityCheckFixAlert msg
|
||||||
{ 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
|
|
||||||
}
|
|
||||||
addsymlink file s = do
|
addsymlink file s = do
|
||||||
insanity $ "found unstaged symlink: " ++ file
|
|
||||||
Watcher.runHandler thisThread st dstatus
|
Watcher.runHandler thisThread st dstatus
|
||||||
transferqueue changechan
|
transferqueue changechan
|
||||||
Watcher.onAddSymlink file s
|
Watcher.onAddSymlink file s
|
||||||
|
insanity $ "found unstaged symlink: " ++ file
|
||||||
|
|
|
@ -32,18 +32,9 @@ transferScannerThread st dstatus scanremotes transferqueue = do
|
||||||
runEvery (Seconds 2) $ do
|
runEvery (Seconds 2) $ do
|
||||||
r <- getScanRemote scanremotes
|
r <- getScanRemote scanremotes
|
||||||
liftIO $ debug thisThread ["starting scan of", show r]
|
liftIO $ debug thisThread ["starting scan of", show r]
|
||||||
alertWhile dstatus (scanalert r) $
|
alertWhile dstatus (scanAlert r) $
|
||||||
scan st dstatus transferqueue r
|
scan st dstatus transferqueue r
|
||||||
liftIO $ debug thisThread ["finished scan of", show 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.
|
{- This is a naive scan through the git work tree.
|
||||||
-
|
-
|
||||||
|
|
|
@ -75,7 +75,7 @@ watchThread st dstatus transferqueue changechan = do
|
||||||
startupScan :: ThreadState -> DaemonStatusHandle -> IO a -> IO a
|
startupScan :: ThreadState -> DaemonStatusHandle -> IO a -> IO a
|
||||||
startupScan st dstatus scanner = do
|
startupScan st dstatus scanner = do
|
||||||
runThreadState st $ showAction "scanning"
|
runThreadState st $ showAction "scanning"
|
||||||
r <- alertWhile dstatus alert scanner
|
r <- alertWhile dstatus startupScanAlert scanner
|
||||||
modifyDaemonStatus_ dstatus $ \s -> s { scanComplete = True }
|
modifyDaemonStatus_ dstatus $ \s -> s { scanComplete = True }
|
||||||
|
|
||||||
-- Notice any files that were deleted before watching was started.
|
-- Notice any files that were deleted before watching was started.
|
||||||
|
@ -84,9 +84,6 @@ startupScan st dstatus scanner = do
|
||||||
showAction "started"
|
showAction "started"
|
||||||
|
|
||||||
return r
|
return r
|
||||||
|
|
||||||
where
|
|
||||||
alert = activityAlert Nothing "Performing startup scan"
|
|
||||||
|
|
||||||
ignored :: FilePath -> Bool
|
ignored :: FilePath -> Bool
|
||||||
ignored = ig . takeFileName
|
ignored = ig . takeFileName
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue