added an alert after a file transfer

This commit is contained in:
Joey Hess 2012-08-06 17:09:23 -04:00
parent 05ed196ce5
commit 8f1a9ef8b5
5 changed files with 46 additions and 38 deletions

View file

@ -12,6 +12,7 @@ module Assistant.Alert where
import Common.Annex import Common.Annex
import qualified Remote import qualified Remote
import Utility.Tense import Utility.Tense
import Logs.Transfer
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Map as M import qualified Data.Map as M
@ -26,7 +27,7 @@ data AlertPriority = Filler | Low | Medium | High | Pinned
{- An alert can have an name, which is used to combine it with other similar {- An alert can have an name, which is used to combine it with other similar
- alerts. -} - alerts. -}
data AlertName = AddFileAlert | DownloadFailedAlert | SanityCheckFixAlert data AlertName = FileAlert TenseChunk | DownloadFailedAlert | SanityCheckFixAlert
deriving (Eq) deriving (Eq)
{- The first alert is the new alert, the second is an old alert. {- The first alert is the new alert, the second is an old alert.
@ -135,39 +136,34 @@ makeAlertFiller success alert
isFiller :: Alert -> Bool isFiller :: Alert -> Bool
isFiller alert = alertPriority alert == Filler isFiller alert = alertPriority alert == Filler
{- Converts a given alert into filler, manipulating it in the AlertMap. {- Updates the Alertmap, adding or updating an alert.
- -
- Any old filler that looks the same as the reference alert is removed, - Any old filler that looks the same as the alert is removed.
- or, if the input alert has an alertCombine that combines it with -
- old filler, the old filler is replaced with the result, and the - Or, if the alert has an alertCombiner that combines it with
- input alert is removed. - an old alert, the old alert is replaced with the result, and the
- alert is removed.
- -
- Old filler alerts are pruned once maxAlerts is reached. - Old filler alerts are pruned once maxAlerts is reached.
-} -}
convertToFiller :: AlertId -> Bool -> AlertMap -> AlertMap mergeAlert :: AlertId -> Alert -> AlertMap -> AlertMap
convertToFiller i success m = case M.lookup i m of mergeAlert i al m = maybe updatePrune updateCombine (alertCombiner al)
Nothing -> m
Just al ->
let al' = makeAlertFiller success al
in case alertCombiner al' of
Nothing -> updatePrune al'
Just combiner -> updateCombine combiner al'
where where
pruneSame ref k al = k == i || not (effectivelySameAlert ref al) pruneSame k al' = k == i || not (effectivelySameAlert al al')
pruneBloat m' pruneBloat m'
| bloat > 0 = M.fromList $ pruneold $ M.toList m' | bloat > 0 = M.fromList $ pruneold $ M.toList m'
| otherwise = m' | otherwise = m'
where where
bloat = M.size m' - maxAlerts bloat = M.size m' - maxAlerts
pruneold l = pruneold l =
let (f, rest) = partition (\(_, al) -> isFiller al) l let (f, rest) = partition (\(_, a) -> isFiller a) l
in drop bloat f ++ rest in drop bloat f ++ rest
updatePrune al = pruneBloat $ M.filterWithKey (pruneSame al) $ updatePrune = pruneBloat $ M.filterWithKey pruneSame $
M.insertWith' const i al m M.insertWith' const i al m
updateCombine combiner al = updateCombine combiner =
let combined = M.mapMaybe (combiner al) m let combined = M.mapMaybe (combiner al) m
in if M.null combined in if M.null combined
then updatePrune al then updatePrune
else M.delete i $ M.union combined m else M.delete i $ M.union combined m
baseActivityAlert :: Alert baseActivityAlert :: Alert
@ -210,15 +206,11 @@ pushRetryAlert rs = activityAlert
(Just $ tenseWords [Tensed "Retrying" "Retried", "sync"]) (Just $ tenseWords [Tensed "Retrying" "Retried", "sync"])
(["with", showRemotes rs]) (["with", showRemotes rs])
syncMountAlert :: FilePath -> [Remote] -> Alert syncAlert :: [Remote] -> Alert
syncMountAlert dir rs = baseActivityAlert syncAlert rs = baseActivityAlert
{ alertHeader = Just $ tenseWords { alertHeader = Just $ tenseWords
[Tensed "Syncing" "Sync", "with", showRemotes rs] [Tensed "Syncing" "Synced", "with", showRemotes rs]
, alertData = map UnTensed , alertData = []
["You plugged in"
, T.pack dir
, " -- let's get it in sync!"
]
, alertBlockDisplay = True , alertBlockDisplay = True
, alertPriority = Low , alertPriority = Low
} }
@ -261,17 +253,26 @@ sanityCheckFixAlert msg = Alert
alerthead = "The daily sanity check found and fixed a problem:" alerthead = "The daily sanity check found and fixed a problem:"
alertfoot = "If these problems persist, consider filing a bug report." alertfoot = "If these problems persist, consider filing a bug report."
addFileAlert :: FilePath -> Alert fileAlert :: TenseChunk -> FilePath -> Alert
addFileAlert file = (activityAlert Nothing [f]) fileAlert msg file = (activityAlert Nothing [f])
{ alertName = Just AddFileAlert { alertName = Just $ FileAlert msg
, alertMessageRender = render , alertMessageRender = render
, alertCombiner = Just $ dataCombiner combiner , alertCombiner = Just $ dataCombiner combiner
} }
where where
f = fromString $ shortFile $ takeFileName file f = fromString $ shortFile $ takeFileName file
render fs = tenseWords $ Tensed "Adding" "Added" : fs render fs = tenseWords $ msg : fs
combiner new old = take 10 $ new ++ old combiner new old = take 10 $ new ++ old
addFileAlert :: FilePath -> Alert
addFileAlert = fileAlert (Tensed "Adding" "Added")
{- This is only used as a success alert after a transfer, not during it. -}
transferFileAlert :: Direction -> FilePath -> Alert
transferFileAlert direction
| direction == Upload = fileAlert "Uploaded"
| otherwise = fileAlert "Downloaded"
dataCombiner :: ([TenseChunk] -> [TenseChunk] -> [TenseChunk]) -> AlertCombiner dataCombiner :: ([TenseChunk] -> [TenseChunk] -> [TenseChunk]) -> AlertCombiner
dataCombiner combiner new old dataCombiner combiner new old
| alertClass new /= alertClass old = Nothing | alertClass new /= alertClass old = Nothing

View file

@ -37,7 +37,7 @@ data DaemonStatus = DaemonStatus
, currentTransfers :: TransferMap , currentTransfers :: TransferMap
-- Messages to display to the user. -- Messages to display to the user.
, alertMap :: AlertMap , alertMap :: AlertMap
, alertMax :: AlertId , lastAlertId :: AlertId
-- Ordered list of remotes to talk to. -- Ordered list of remotes to talk to.
, knownRemotes :: [Remote] , knownRemotes :: [Remote]
-- Broadcasts notifications about all changes to the DaemonStatus -- Broadcasts notifications about all changes to the DaemonStatus
@ -215,10 +215,10 @@ notifyAlert dstatus = sendNotification
addAlert :: DaemonStatusHandle -> Alert -> IO AlertId addAlert :: DaemonStatusHandle -> Alert -> IO AlertId
addAlert dstatus alert = notifyAlert dstatus `after` modifyDaemonStatus dstatus go addAlert dstatus alert = notifyAlert dstatus `after` modifyDaemonStatus dstatus go
where where
go s = (s { alertMax = i, alertMap = m }, i) go s = (s { lastAlertId = i, alertMap = m }, i)
where where
i = nextAlertId $ alertMax s i = nextAlertId $ lastAlertId s
m = M.insertWith' const i alert (alertMap s) m = mergeAlert i alert (alertMap s)
removeAlert :: DaemonStatusHandle -> AlertId -> IO () removeAlert :: DaemonStatusHandle -> AlertId -> IO ()
removeAlert dstatus i = updateAlert dstatus i (const Nothing) removeAlert dstatus i = updateAlert dstatus i (const Nothing)
@ -245,5 +245,5 @@ alertWhile' dstatus alert a = do
let alert' = alert { alertClass = Activity } let alert' = alert { alertClass = Activity }
i <- addAlert dstatus alert' i <- addAlert dstatus alert'
(ok, r) <- bracket_ noop noop a (ok, r) <- bracket_ noop noop a
updateAlertMap dstatus $ convertToFiller i ok updateAlertMap dstatus $ mergeAlert i $ makeAlertFiller ok alert'
return r return r

View file

@ -198,6 +198,8 @@ safeToAdd st changes = runThreadState st $
openfiles <- S.fromList . map fst3 . filter openwrite <$> openfiles <- S.fromList . map fst3 . filter openwrite <$>
liftIO (Lsof.queryDir tmpdir) liftIO (Lsof.queryDir tmpdir)
-- TODO this is here for debugging a problem on
-- OSX, and is pretty expensive, so remove later
liftIO $ debug thisThread liftIO $ debug thisThread
[ "checking changes:" [ "checking changes:"
, show changes , show changes

View file

@ -163,7 +163,7 @@ handleMount st dstatus scanremotes dir = do
unless (null rs) $ do unless (null rs) $ do
let nonspecial = filter (Git.repoIsLocal . Remote.repo) rs let nonspecial = filter (Git.repoIsLocal . Remote.repo) rs
unless (null nonspecial) $ do unless (null nonspecial) $ do
void $ alertWhile dstatus (syncMountAlert dir nonspecial) $ do void $ alertWhile dstatus (syncAlert nonspecial) $ do
debug thisThread ["syncing with", show rs] debug thisThread ["syncing with", show rs]
sync nonspecial =<< runThreadState st (inRepo Git.Branch.current) sync nonspecial =<< runThreadState st (inRepo Git.Branch.current)
addScanRemotes scanremotes nonspecial addScanRemotes scanremotes nonspecial

View file

@ -12,6 +12,7 @@ import Assistant.ThreadedMonad
import Assistant.DaemonStatus import Assistant.DaemonStatus
import Assistant.TransferQueue import Assistant.TransferQueue
import Assistant.TransferSlots import Assistant.TransferSlots
import Assistant.Alert
import Logs.Transfer import Logs.Transfer
import Logs.Presence import Logs.Presence
import Logs.Location import Logs.Location
@ -94,7 +95,8 @@ transferThread st dstatus slots t info = case (transferRemote info, associatedFi
, transferTid = Just tid , transferTid = Just tid
} }
where where
isdownload = transferDirection t == Download direction = transferDirection t
isdownload = direction == Download
tofrom tofrom
| isdownload = "from" | isdownload = "from"
| otherwise = "to" | otherwise = "to"
@ -113,3 +115,6 @@ transferThread st dstatus slots t info = case (transferRemote info, associatedFi
Remote.logStatus remote key InfoPresent Remote.logStatus remote key InfoPresent
return ok return ok
showEndResult ok showEndResult ok
liftIO $ addAlert dstatus $
makeAlertFiller ok $
transferFileAlert direction file