added an alert after a file transfer
This commit is contained in:
parent
05ed196ce5
commit
8f1a9ef8b5
5 changed files with 46 additions and 38 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue