added an alert after a file transfer

5 files changed, 46 insertions, 38 deletions

diff --git a/Assistant/Alert.hs b/Assistant/Alert.hs
index a5b0d41e7..9ebc89aab 100644
--- a/Assistant/Alert.hs
+++ b/Assistant/Alert.hs
@@ -12,6 +12,7 @@ module Assistant.Alert where
 import Common.Annex
 import qualified Remote
 import Utility.Tense
+import Logs.Transfer
 
 import qualified Data.Text as T
 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
  - alerts. -}
-data AlertName = AddFileAlert | DownloadFailedAlert | SanityCheckFixAlert
+data AlertName = FileAlert TenseChunk | DownloadFailedAlert | SanityCheckFixAlert
 	deriving (Eq)
 
 {- 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 = 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,
- - or, if the input alert has an alertCombine that combines it with
- - old filler, the old filler is replaced with the result, and the
- - input alert is removed.
+ - Any old filler that looks the same as the alert is removed.
+ -
+ - Or, if the alert has an alertCombiner that combines it with
+ - 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.
  -}
-convertToFiller :: AlertId -> Bool -> AlertMap -> AlertMap
-convertToFiller i success m = case M.lookup i m of
-	Nothing -> m
- 	Just al ->
-		let al' = makeAlertFiller success al
-		in case alertCombiner al' of
-			Nothing -> updatePrune al'
-			Just combiner -> updateCombine combiner al'
+mergeAlert :: AlertId -> Alert -> AlertMap -> AlertMap
+mergeAlert i al m = maybe updatePrune updateCombine (alertCombiner al)
 	where
-		pruneSame ref k al = k == i || not (effectivelySameAlert ref al)
+		pruneSame k al' = k == i || not (effectivelySameAlert al al')
 		pruneBloat m'
 			| bloat > 0 = M.fromList $ pruneold $ M.toList m'
 			| otherwise = m'
 			where
 				bloat = M.size m' - maxAlerts
 				pruneold l =
-			 		let (f, rest) = partition (\(_, al) -> isFiller al) l
+			 		let (f, rest) = partition (\(_, a) -> isFiller a) l
 					in drop bloat f ++ rest
-		updatePrune al = pruneBloat $ M.filterWithKey (pruneSame al) $
+		updatePrune = pruneBloat $ M.filterWithKey pruneSame $
 			M.insertWith' const i al m
-		updateCombine combiner al = 
+		updateCombine combiner = 
 			let combined = M.mapMaybe (combiner al) m
 			in if M.null combined
-				then updatePrune al
+				then updatePrune
 				else M.delete i $ M.union combined m
 
 baseActivityAlert :: Alert
@@ -210,15 +206,11 @@ pushRetryAlert rs = activityAlert
 	(Just $ tenseWords [Tensed "Retrying" "Retried", "sync"])
 	(["with", showRemotes rs])
 
-syncMountAlert :: FilePath -> [Remote] -> Alert
-syncMountAlert dir rs = baseActivityAlert
+syncAlert :: [Remote] -> Alert
+syncAlert rs = baseActivityAlert
 	{ alertHeader = Just $ tenseWords
-		[Tensed "Syncing" "Sync", "with", showRemotes rs]
-	, alertData = map UnTensed
-		["You plugged in"
-		, T.pack dir
-		, " -- let's get it in sync!"
-		]
+		[Tensed "Syncing" "Synced", "with", showRemotes rs]
+	, alertData = []
 	, alertBlockDisplay = True
 	, alertPriority = Low
         }
@@ -261,17 +253,26 @@ sanityCheckFixAlert msg = Alert
 		alerthead = "The daily sanity check found and fixed a problem:"
 		alertfoot = "If these problems persist, consider filing a bug report."
 
-addFileAlert :: FilePath -> Alert
-addFileAlert file = (activityAlert Nothing [f])
-	{ alertName = Just AddFileAlert
+fileAlert :: TenseChunk -> FilePath -> Alert
+fileAlert msg file = (activityAlert Nothing [f])
+	{ alertName = Just $ FileAlert msg
 	, alertMessageRender = render
 	, alertCombiner = Just $ dataCombiner combiner
 	}
 	where
 		f = fromString $ shortFile $ takeFileName file
-		render fs = tenseWords $ Tensed "Adding" "Added" : fs
+		render fs = tenseWords $ msg : fs
 		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 combiner new old
 	| alertClass new /= alertClass old = Nothing
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index 13828d3ee..230d2ed37 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -37,7 +37,7 @@ data DaemonStatus = DaemonStatus
 	, currentTransfers :: TransferMap
 	-- Messages to display to the user.
 	, alertMap :: AlertMap
-	, alertMax :: AlertId
+	, lastAlertId :: AlertId
 	-- Ordered list of remotes to talk to.
 	, knownRemotes :: [Remote]
 	-- Broadcasts notifications about all changes to the DaemonStatus
@@ -215,10 +215,10 @@ notifyAlert dstatus = sendNotification
 addAlert :: DaemonStatusHandle -> Alert -> IO AlertId
 addAlert dstatus alert = notifyAlert dstatus `after` modifyDaemonStatus dstatus go
 	where
-		go s = (s { alertMax = i, alertMap = m }, i)
+		go s = (s { lastAlertId = i, alertMap = m }, i)
 			where
-				i = nextAlertId $ alertMax s
-				m = M.insertWith' const i alert (alertMap s)
+				i = nextAlertId $ lastAlertId s
+				m = mergeAlert i alert (alertMap s)
 
 removeAlert :: DaemonStatusHandle -> AlertId -> IO ()
 removeAlert dstatus i = updateAlert dstatus i (const Nothing)
@@ -245,5 +245,5 @@ alertWhile' dstatus alert a = do
 	let alert' = alert { alertClass = Activity }
 	i <- addAlert dstatus alert'
 	(ok, r) <- bracket_ noop noop a
-	updateAlertMap dstatus $ convertToFiller i ok
+	updateAlertMap dstatus $ mergeAlert i $ makeAlertFiller ok alert'
 	return r
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index 095c8feac..5aadcc02a 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -198,6 +198,8 @@ safeToAdd st changes = runThreadState st $
 			openfiles <- S.fromList . map fst3 . filter openwrite <$>
 				liftIO (Lsof.queryDir tmpdir)
 
+			-- TODO this is here for debugging a problem on
+			-- OSX, and is pretty expensive, so remove later
 			liftIO $ debug thisThread
 				[ "checking changes:"
 				, show changes
diff --git a/Assistant/Threads/MountWatcher.hs b/Assistant/Threads/MountWatcher.hs
index 18dfca42c..83f582a91 100644
--- a/Assistant/Threads/MountWatcher.hs
+++ b/Assistant/Threads/MountWatcher.hs
@@ -163,7 +163,7 @@ handleMount st dstatus scanremotes dir = do
 	unless (null rs) $ do
 		let nonspecial = filter (Git.repoIsLocal . Remote.repo) rs
 		unless (null nonspecial) $ do
-			void $ alertWhile dstatus (syncMountAlert dir nonspecial) $ do
+			void $ alertWhile dstatus (syncAlert nonspecial) $ do
 				debug thisThread ["syncing with", show rs]
 				sync nonspecial =<< runThreadState st (inRepo Git.Branch.current)
 			addScanRemotes scanremotes nonspecial
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 956e0fc9d..67fdcd2a7 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -12,6 +12,7 @@ import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.TransferQueue
 import Assistant.TransferSlots
+import Assistant.Alert
 import Logs.Transfer
 import Logs.Presence
 import Logs.Location
@@ -94,7 +95,8 @@ transferThread st dstatus slots t info = case (transferRemote info, associatedFi
 				, transferTid = Just tid
 				}
 	where
-		isdownload = transferDirection t == Download
+		direction = transferDirection t
+		isdownload = direction == Download
 		tofrom
 			| isdownload = "from"
 			| otherwise = "to"
@@ -113,3 +115,6 @@ transferThread st dstatus slots t info = case (transferRemote info, associatedFi
 							Remote.logStatus remote key InfoPresent
 						return ok
 			showEndResult ok
+			liftIO $ addAlert dstatus $
+				makeAlertFiller ok $ 
+					transferFileAlert direction file